<?xml version="1.0" encoding="UTF-8"?>
<rss xmlns:content="http://purl.org/rss/1.0/modules/content/" xmlns:dc="http://purl.org/dc/elements/1.1/" xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#" xmlns:taxo="http://purl.org/rss/1.0/modules/taxonomy/" version="2.0">
  <channel>
    <title>topic Re: Constrain all components in assembly in Inventor Programming - iLogic, Macros, AddIns &amp; Apprentice</title>
    <link>https://forums.autodesk.com/t5/inventor-programming-ilogic/constrain-all-components-in-assembly/m-p/7218907#M73417</link>
    <description>&lt;P&gt;Worked for me now in the combination if these codes:&lt;BR /&gt;&lt;BR /&gt;&lt;/P&gt;&lt;PRE&gt;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 &amp;lt; 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&lt;/PRE&gt;&lt;PRE&gt;' 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&lt;/PRE&gt;&lt;PRE&gt;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&lt;/PRE&gt;</description>
    <pubDate>Tue, 11 Jul 2017 09:49:54 GMT</pubDate>
    <dc:creator>Anonymous</dc:creator>
    <dc:date>2017-07-11T09:49:54Z</dc:date>
    <item>
      <title>Constrain all components in assembly</title>
      <link>https://forums.autodesk.com/t5/inventor-programming-ilogic/constrain-all-components-in-assembly/m-p/7218500#M73407</link>
      <description>&lt;P&gt;Hello,&lt;BR /&gt;I found the following code in a forum.&lt;BR /&gt;What I need is a code, that constrains all components in an assembly without selecting them.&lt;BR /&gt;"For each..." But my programming skills are only basics. And I cant get it to work.&lt;BR /&gt;Anyone have a code or can edit the existing one?&lt;BR /&gt;&lt;BR /&gt;I need constrains. I found grounding of components already. But sometimes I need to move a part or subassembly a bit away from ground. With constrains it is easyer for me.&lt;BR /&gt;&lt;BR /&gt;&lt;/P&gt;&lt;PRE&gt;Public Sub bewegeKomponenteZumUrsprung()
Dim oDoc As Document
Dim oAsmCompDef As AssemblyComponentDefinition
Dim oAsmWorkPlane(1 To 3) As WorkPlane
Dim oOcc2 As ComponentOccurrence
Dim oPartPlane2 As WorkPlane
Dim oAsmPlane2 As WorkPlaneProxy
Dim oSelectSet As SelectSet
Dim i As Long
 
  Set oDoc = ThisApplication.ActiveDocument
  If oDoc.DocumentType &amp;lt;&amp;gt; kAssemblyDocumentObject Then
    MsgBox "Dieses Makro funktioniert nur in einer Baugruppe! Dieses Makro fixiert eine Bauteil/Baugruppe im Ursprung der aktuellen Baugruppe.", vbCritical
    Exit Sub
  End If
 
  Set oSelectSet = ThisApplication.ActiveDocument.SelectSet
   
  ' Validate the correct data is in the select set.
  If oSelectSet.Count &amp;lt;&amp;gt; 1 Then
    MsgBox "Es darf nur ein einzelnes Element ausgewählt sein!", vbCritical
    Exit Sub
  End If
 
  'Debug.Print oSelectSet.Item(1).Type
  If oSelectSet.Item(1).Type = 67113776 Then
    ' Die Nummer ist "hart verdrahtet", weil ich sonst keine andere Möglichkeit/Konstante gefunden habe.
    Set oAsmCompDef = ThisApplication.ActiveDocument.ComponentDefinition
    Set oOcc2 = oAsmCompDef.Occurrences.ItemByName(oSelectSet.Item(1).Name)
 
    For i = 1 To 3
      ' Arbeitsebenen der Baugruppe auslesen
      Set oAsmWorkPlane(i) = ThisApplication.ActiveDocument.ComponentDefinition.WorkPlanes.Item(i)
      'Arbeitsebene des Bauteils/Baugruppe auslesen
      Set oPartPlane2 = oOcc2.Definition.WorkPlanes.Item(i)
      ' Proxy Berechnung (Bauteil-Koords -&amp;gt; Baugruppen-Koords)
      Call oOcc2.CreateGeometryProxy(oPartPlane2, oAsmPlane2)
      ' fluchtende Abhängigkeit vergeben
      Call oAsmCompDef.Constraints.AddFlushConstraint(oAsmWorkPlane(i), oAsmPlane2, 0)
    Next i
  Else
    MsgBox "Es muß ein Bauteil oder eine Baugruppe ausgewählt sein!", vbCritical
  End If
End Sub&lt;/PRE&gt;&lt;P&gt;&lt;A href="http://ww3.cad.de/foren/ubb/Forum258/HTML/000379.shtml" target="_blank"&gt;http://ww3.cad.de/foren/ubb/Forum258/HTML/000379.shtml&lt;/A&gt;&lt;/P&gt;&lt;P&gt;&amp;nbsp;&lt;/P&gt;</description>
      <pubDate>Tue, 11 Jul 2017 05:52:06 GMT</pubDate>
      <guid>https://forums.autodesk.com/t5/inventor-programming-ilogic/constrain-all-components-in-assembly/m-p/7218500#M73407</guid>
      <dc:creator>Anonymous</dc:creator>
      <dc:date>2017-07-11T05:52:06Z</dc:date>
    </item>
    <item>
      <title>Re: Constrain all components in assembly</title>
      <link>https://forums.autodesk.com/t5/inventor-programming-ilogic/constrain-all-components-in-assembly/m-p/7218907#M73417</link>
      <description>&lt;P&gt;Worked for me now in the combination if these codes:&lt;BR /&gt;&lt;BR /&gt;&lt;/P&gt;&lt;PRE&gt;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 &amp;lt; 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&lt;/PRE&gt;&lt;PRE&gt;' 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&lt;/PRE&gt;&lt;PRE&gt;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&lt;/PRE&gt;</description>
      <pubDate>Tue, 11 Jul 2017 09:49:54 GMT</pubDate>
      <guid>https://forums.autodesk.com/t5/inventor-programming-ilogic/constrain-all-components-in-assembly/m-p/7218907#M73417</guid>
      <dc:creator>Anonymous</dc:creator>
      <dc:date>2017-07-11T09:49:54Z</dc:date>
    </item>
  </channel>
</rss>

