By Adam Nagy
You may have UCS's (UserCoordinateSystem object) defined in your assembly and its subcomponents that you want to constrain together.
You can try to find out if they are already constrained, and if not you would add the missing constraints.
Unfortunately, the constraints are not directly between the UCS object of the assembly and the subcomponents, but between their WorkPlanes - this just means a bit more work.
We can find the XY, XZ and YZ planes of the UCS object and see if they are constrained using FlushCostraint to a WorkPlane inside each subcomponent. If they are, we can remove them from our collection that contains all assembly occurrences.
The remaining occurrences will get a FlushConstraint for the WorkPlane of their custom UserCoordinateSystem object.
Here is a VBA code that demonstrates this:
Function GetAllOccurrences(cd As AssemblyComponentDefinition) _ As ObjectCollection Dim coll As ObjectCollection Set coll = ThisApplication.TransientObjects.CreateObjectCollection Dim occ As ComponentOccurrence For Each occ In cd.Occurrences Call coll.Add(occ) Next Set GetAllOccurrences = coll End Function Sub CreateFlushConstraints(wp As WorkPlane, plane As Integer) Dim acd As AssemblyComponentDefinition Set acd = wp.Parent Dim coll As ObjectCollection Set coll = GetAllOccurrences(acd) Dim obj As Object For Each obj In wp.Dependents If TypeOf obj Is FlushConstraint Then Dim f As FlushConstraint Set f = obj ' Get other entity Dim other As Object If f.EntityOne Is wp Then Set other = f.EntityTwo Else Set other = f.EntityOne End If ' If it's a WorkPlane proxy ' then it's from an occurrence If TypeOf other Is WorkPlaneProxy Then Dim wpp As WorkPlaneProxy Set wpp = other Call coll.RemoveByObject(wpp.ContainingOccurrence) End If End If Next ' Create Flush Constraint for the remaining occurrences Dim occ As ComponentOccurrence For Each occ In coll Dim ucs As UserCoordinateSystem Set ucs = occ.Definition.UserCoordinateSystems("UCS1") Dim occWp As WorkPlane Select Case plane Case 0 Set occWp = ucs.XYPlane Case 1 Set occWp = ucs.XZPlane Case 2 Set occWp = ucs.YZPlane End Select Call occ.CreateGeometryProxy(occWp, wpp) Call acd.Constraints.AddFlushConstraint(wp, wpp, 0) Next End Sub Sub CheckUcsConstraints() ' Check if occurrences have a UCS1 and if it's constrained already Dim asm As AssemblyDocument Set asm = ThisApplication.ActiveDocument ' Using error handling in case ' not all components have a UCS1 On Error Resume Next Dim asmUcs1 As UserCoordinateSystem Set asmUcs1 = _ asm.ComponentDefinition.UserCoordinateSystems("UCS1") ' Each WorkPlane of the UCS must be constrained Call CreateFlushConstraints(asmUcs1.XYPlane, 0) Call CreateFlushConstraints(asmUcs1.XZPlane, 1) Call CreateFlushConstraints(asmUcs1.YZPlane, 2) On Error GoTo 0 End Sub
This is what we start with:
And this is what we get: