Positioning Assembly Occurrences

Public Sub AlignOccurrencesWithConstraints()
    Dim assemblydoc As AssemblyDocument
    Set assemblydoc = ThisApplication.ActiveDocument

    ' Get the occurrences in the select set.
    Dim occurrenceList As New Collection
    Dim entity As Object
    For Each entity In assemblydoc.SelectSet
        If TypeOf entity Is ComponentOccurrence Then
            occurrenceList.Add entity
        End If
    Next

    If occurrenceList.Count < 2 Then
        MsgBox "At least two occurrences must be selected."
        Exit Sub
    End If

    ' This assumes the first selected occurrence is the "base"
    ' and will constrain the base workplanes of all the other parts
    ' to the base workplanes of the first part. If there are
    ' constraints on the other they end up being over constrained.

    ' Get the planes from the base part and create proxies for them.
    Dim baseOccurrence As ComponentOccurrence
    Set baseOccurrence = occurrenceList.Item(1)

    Dim BaseXY As WorkPlane
    Dim BaseYZ As WorkPlane
    Dim BaseXZ As WorkPlane
    Call GetPlanes(baseOccurrence, BaseXY, BaseYZ, BaseXZ)

    Dim constraints As AssemblyConstraints
    Set constraints = assemblydoc.ComponentDefinition.constraints

    ' Iterate through the other occurrences
    Dim i As Integer
    For i = 2 To occurrenceList.Count
        Dim thisOcc As ComponentOccurrence
        Set thisOcc = occurrenceList.Item(i)

        ' Move it to the base occurrence so that if the base is
        ' not fully constrained it shouldn't move when the flush
        ' constraints are added.
        thisOcc.Transformation = baseOccurrence.Transformation

        ' Get the planes from the occurrence
        Dim occPlaneXY As WorkPlane
        Dim occPlaneYZ As WorkPlane
        Dim occPlaneXZ As WorkPlane
        Call GetPlanes(thisOcc, occPlaneXY, occPlaneYZ, occPlaneXZ)

        ' Add the flush constraints.
        Call constraints.AddFlushConstraint(BaseXY, occPlaneXY, 0)
        Call constraints.AddFlushConstraint(BaseYZ, occPlaneYZ, 0)
        Call constraints.AddFlushConstraint(BaseXZ, occPlaneXZ, 0)
    Next
End Sub

' Utility function used by the AlignOccurrencesWithConstraints macro.
' Given an occurrence it returns the base work planes that are in
' the part or assembly the occurrence references.  It gets the
' proxies for the planes since it needs the work planes in the
' context of the assembly and not in the part or assembly document
' where they actually exist.
Private Sub GetPlanes(ByVal Occurrence As ComponentOccurrence, _ 
                      ByRef BaseXY As WorkPlane, _ 
                      ByRef BaseYZ As WorkPlane, _ 
                      ByRef BaseXZ As WorkPlane)
    ' Get the work planes from the definition of the occurrence.
    ' These will be in the context of the part or subassembly, not 
    ' the top-level assembly, which is what we need to return.
    Set BaseXY = Occurrence.Definition.WorkPlanes.Item(3)
    Set BaseYZ = Occurrence.Definition.WorkPlanes.Item(1)
    Set BaseXZ = Occurrence.Definition.WorkPlanes.Item(2)

    ' Create proxies for these planes.  This will act as the work
    ' plane in the context of the top-level assembly.
    Call Occurrence.CreateGeometryProxy(BaseXY, BaseXY)
    Call Occurrence.CreateGeometryProxy(BaseYZ, BaseYZ)
    Call Occurrence.CreateGeometryProxy(BaseXZ, BaseXZ)
End Sub

Public Sub AlignOccurrencesWithGround()
    Dim assemblydoc As AssemblyDocument
    Set assemblydoc = ThisApplication.ActiveDocument

    ' Get the occurrences in the select set.  The first occurrence
    ' selected will be the "base" where all of the other occurrences
    ' will be positioned relative to it.
    Dim baseOccurrence As ComponentOccurrence
    Dim baseTransform As Matrix
    Dim transObjects As TransientObjects
    Set transObjects = ThisApplication.TransientObjects
    Dim occList As ObjectCollection
    Set occList = transObjects.CreateObjectCollection
    Dim transformList As ObjectCollection
    Set transformList = transObjects.CreateObjectCollection
    Dim entity As Object
    For Each entity In assemblydoc.SelectSet
        ' Check that the selected entity is an occurrence.
        If TypeOf entity Is ComponentOccurrence Then
            ' Check if the base occurrence has been assigned.
            ' If not then this is the first occurrence found and
            ' use it as the base occurrence.
            If baseOccurrence Is Nothing Then
                Set baseOccurrence = entity
                Set baseTransform = baseOccurrence.Transformation
            Else
                ' This is another selected occurrence so just
                ' add it to the list.
                occList.Add entity
                transformList.Add baseTransform
            End If
        End If
    Next 

    ' Check that at least a base occurrence and one other occurrence
    ' was selected.
    If occList.Count < 1 Then
        MsgBox "At least two occurrences must be selected."
        Exit Sub
    End If

    ' Reposition all of the occurrences.  The TransformOccurrences
    ' method was new in Inventor 2009.
    Dim assemblyDef As AssemblyComponentDefinition
    Set assemblyDef = assemblydoc.ComponentDefinition
    Call assemblyDef.TransformOccurrences( occList, _
                                           transformList)

    ' Iterate through the occurrences and ground them.
    Dim i As Integer
    For i = 1 To occList.Count
        Dim thisOccurrence As ComponentOccurrence
        Set thisOccurrence = occList.Item(i)
        thisOccurrence.Grounded = True
    Next
End Sub

Public Sub AlignOccurrencesWithOrigin()
    Dim assemblyDoc As AssemblyDocument
    Set assemblyDoc = ThisApplication.ActiveDocument
    Dim assemblyDef As AssemblyComponentDefinition
    Set assemblyDef = assemblyDoc.ComponentDefinition

    ' Create a matrix.  It is initialized as an identity matrix
    ' which means it defines a position as the origin and aligned
    ' with the global x, y, and z axes.
    Dim transGeom As TransientGeometry
    Set transGeom = ThisApplication.TransientGeometry
    Dim baseTransform As Matrix
    Set baseTransform = transGeom.CreateMatrix

    ' Create collections to load the occurrences into.
    Dim transObjects As TransientObjects
    Set transObjects = ThisApplication.TransientObjects
    Dim occList As ObjectCollection
    Set occList = transObjects.CreateObjectCollection
    Dim transformList As ObjectCollection
    Set transformList = transObjects.CreateObjectCollection

    ' Iterate through all of the occurrences.
    Dim occurrence As ComponentOccurrence
    For Each occurrence In assemblyDef.Occurrences
        ' Add each occurrence to the list.
        occList.Add occurrence

        ' Add the transform to the list.
        transformList.Add baseTransform

        ' Ground each occurrence.  This is ok to do here
        ' because the move will ignore the ground condition.
        occurrence.Grounded = True
    Next

    ' Reposition all of the occurrences.  The TransformOccurrences
    ' method was new in Inventor 2009. 
    Set assemblyDef = assemblydoc.ComponentDefinition
    Call assemblyDef.TransformOccurrences(occList, _
                                           transformList)
End Sub