Worked for me now in the combination if these codes:
Public Sub AlignOccurrencesWithConstraints()
Dim oAsmDoc As AssemblyDocument
Set oAsmDoc = ThisApplication.ActiveDocument
' Get the assembly component definition.
Dim oAsmDef As AssemblyComponentDefinition
Set oAsmDef = oAsmDoc.ComponentDefinition
' Get all of the leaf occurrences of the assembly.
Dim oLeafOccs As ComponentOccurrencesEnumerator
Set oLeafOccs = oAsmDef.Occurrences.AllLeafOccurrences
' Get the occurrences in the select set.
Dim occurrenceList As New Collection
'Dim entity As Object
' Iterate through the occurrences and print the name.
Dim oOcc As ComponentOccurrence
'Dim occurrenceList As New Collection
Dim oAssyDoc As Inventor.AssemblyDocument
Set oAddyDoc = ThisApplication.ActiveDocument
Dim oConstraints As AssemblyConstraints
Set oConstraints = oAsmDef.constraints
Dim oConstraint As AssemblyConstraint
If MsgBox("Achtung, dies löscht alle Abhängigkeiten! Wirklich ALLE Abhänigkeiten löschen?", vbYesNo + vbQuestion) = vbYes Then
Aufheben
For Each oConstraint In oConstraints
'MsgBox ("HELLO")
oConstraint.Delete
Next
For Each oOcc In oLeafOccs
occurrenceList.Add oOcc
'MsgBox ("HELLO")
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 = oAsmDoc.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
GroundAndFix
End If
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 GroundAndFix()
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