Create UCS constraints

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: