Auto constrain in current position with Origin Planes flush or mate
I’ve created or copy pasted this Ilogic rule . It measures the distance of the origin planes of each occurrence to the origin planes of the active assembly. Then it creates a constraint of these two planes with the measured value.
With this rule we want to change existing assemblies to avoid sick constraints after model changes somewhere in the assembly structure and maybe have a better performance (not yet tested) of big assemblies after every Occurrence has only 3 Constrains to the Origin Plane.
Most of the Occurrences in our assemblies have somehow parallel origin planes to the top level origin planes.
So the rule works but its quite slow.
Questions:
How can I make the decision if the constraint has to be flush/ mate and posive/negative value for the constraints quicker. Now the codes creates each constraint flush, mate, positive, negative and deletes if the constraint is sick.-->this is only a bad workaround I think. I have tried something with Eulerian angles to get the orientation of the occurrence but I don’t know yet how this angle can make the decision flush/ mate and posive/negative value?
How can I create constraints of Occurrences with unequal 90° to the origin? Without angle constraints.
Deleting the existing Constraints is very brutal. How could I make this more smart. Maybe a new LOD with the new Constraints and the old ones just suppressed.
Maybe somebody has use of my code
Sub Main Dim oAsm As AssemblyDocument= ThisApplication.ActiveDocument On Error Resume Next 'get the active assembly Dim oAsmComp As AssemblyComponentDefinition= ThisApplication.ActiveDocument.ComponentDefinition For Each oConstraint In oAsmComp.Constraints oConstraint.Delete Next 'set the Master LOD active Dim oLODRep As LevelOfDetailRepresentation oLODRep = oAsmComp.RepresentationsManager.LevelOfDetailRepresentations.Item("Master") oLODRep.Activate 'Iterate through all of the top level occurrences Dim oOccurrence As ComponentOccurrence For Each oOccurrence In oAsmComp.Occurrences 'Try ' 'ground everything in the top level oOccurrence.Grounded = True 'Catch ' end try Next Dim oUM As UnitsOfMeasure = oAsm.UnitsOfMeasure Dim oOcc As ComponentOccurrence For Each oOcc In oAsm.ComponentDefinition.Occurrences 'Create a proxy for Face0 (The face in the context of the assembly) Dim Zähler As Integer = 1 'cycle each Origin plane in the top assembly For Zähler = 1 To 3 Dim curAsmorPlane As WorkPlane = oAsmComp.WorkPlanes.Item(Zähler) 'Dim oComp1 As ComponentOccurrence = oADef.Occurrences.Item(1) Dim oCompAsmDef As AssemblyComponentDefinition Dim oCompPtDef As PartComponentDefinition 'cycle each Origin plane in the first level Occurence in the assembly For Zähler2 = 1 To 3 If oOcc.DefinitionDocumentType = DocumentTypeEnum.kAssemblyDocumentObject Then oCompAsmDef = oOcc.Definition oOcc.CreateGeometryProxy(oCompAsmDef.WorkPlanes.Item(Zähler2),curCompOriPlane) ElseIf oOcc.DefinitionDocumentType = DocumentTypeEnum.kPartDocumentObject Then oCompPtDef = oOcc.Definition oOcc.CreateGeometryProxy(oCompPtDef.WorkPlanes.Item(Zähler2),curCompOriPlane) End If 'Measure distance Dim oNV As NameValueMap ' Dim Distance As Double ' Try 'Dim angle As Double = ThisApplication.MeasureTools. Dim angle As Double = ThisApplication.MeasureTools.GetAngle(curAsmorPlane, curCompOriPlane) 'Angle in deg ' MsgBox(angle) angle = (angle * 180) / PI If angle=0 Then ' 'Convert distance from database units to default units of the document Dim Distance1 As Double = ThisApplication.MeasureTools.GetMinimumDistance(curAsmorPlane, curCompOriPlane) Dim Distance As Double Dim oConstraint As AssemblyConstraint Distance = oUM.ConvertUnits(Distance1, UnitsTypeEnum.kDatabaseLengthUnits, oUM.LengthUnits) 'Return the value in a messagebox just to control that it's right Distance= Round(Distance,3) ' MsgBox(Distance) oConstraint=oAsmComp.Constraints.AddMateConstraint(curAsmorPlane, curCompOriPlane, Distance1) If oConstraint.HealthStatus = oConstraint.HealthStatus.kInconsistentHealth Then oConstraint.Delete oConstraint = oAsmComp.Constraints.AddMateConstraint(curAsmorPlane, curCompOriPlane, -Distance1) End If If oConstraint.HealthStatus = oConstraint.HealthStatus.kInconsistentHealth Then oConstraint.Delete oConstraint = oAsmComp.Constraints.AddFlushConstraint(curAsmorPlane, curCompOriPlane, Distance1) End If If oConstraint.HealthStatus = oConstraint.HealthStatus.kInconsistentHealth Then oConstraint.Delete oConstraint = oAsmComp.Constraints.AddFlushConstraint(curAsmorPlane, curCompOriPlane, -Distance1) End If If oConstraint.HealthStatus = oConstraint.HealthStatus.kInconsistentHealth Then oConstraint.Delete End If End If ' Catch ' End Try Next Next 'Try oOcc.Grounded = False ' Catch ' End try Next End Sub
second code for the Occurence eulerian angle adapted from her:
Sub Main() Dim oDoc As AssemblyDocument oDoc = ThisApplication.ActiveDocument Dim oOcc As ComponentOccurrence oOcc = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kAssemblyOccurrenceFilter, "Select a oOcc plate") Dim oMat As Matrix oMat = oOcc.Transformation Dim aRotAngles(2) As Double Call CalculateRotationAngles(oMat, aRotAngles) ' Print results ' Dim i As Integer ' For i = 0 To 2 msgbox(aRotAngles(0) & vbCrLf & aRotAngles(1) & vbCrLf & aRotAngles(2)) ' Next i Beep End Sub Sub CalculateRotationAngles(ByVal oMatrix As Inventor.Matrix,ByRef aRotAngles() As Double) Const PI = 3.14159265358979 Const TODEGREES As Double = 180 / PI Dim dB As Double Dim dC As Double Dim dNumer As Double Dim dDenom As Double Dim dAcosValue As Double Dim oRotate As Inventor.Matrix Dim oAxis As Inventor.Vector Dim oCenter As Inventor.Point oRotate = ThisApplication.TransientGeometry.CreateMatrix oAxis = ThisApplication.TransientGeometry.CreateVector oCenter = ThisApplication.TransientGeometry.CreatePoint oCenter.X = 0 oCenter.Y = 0 oCenter.Z = 0 ' Choose aRotAngles[0] about x which transforms axes[2] onto the x-z plane ' dB = oMatrix.Cell(2, 3) dC = oMatrix.Cell(3, 3) dNumer = dC dDenom = Sqrt(dB * dB + dC * dC) ' Make sure we can do the division. If not, then axes[2] is already in the x-z plane If (Abs(dDenom) <= 0.000001) Then aRotAngles(0) = 0# Else If (dNumer / dDenom >= 1#) Then dAcosValue = 0# Else If (dNumer / dDenom <= -1#) Then dAcosValue = PI Else dAcosValue = Acos(dNumer / dDenom) End If End If aRotAngles(0) = Sign(dB) * dAcosValue oAxis.X = 1 oAxis.Y = 0 oAxis.Z = 0 Call oRotate.SetToRotation(aRotAngles(0), oAxis, oCenter) Call oMatrix.PreMultiplyBy(oRotate) End If ' ' Choose aRotAngles[1] about y which transforms axes[3] onto the z axis ' If (oMatrix.Cell(3, 3) >= 1#) Then dAcosValue = 0# Else If (oMatrix.Cell(3, 3) <= -1#) Then dAcosValue = PI Else dAcosValue = Acos(oMatrix.Cell(3, 3)) End If End If aRotAngles(1) = Math.Sign(-oMatrix.Cell(1, 3)) * dAcosValue oAxis.X = 0 oAxis.Y = 1 oAxis.Z = 0 Call oRotate.SetToRotation(aRotAngles(1), oAxis, oCenter) Call oMatrix.PreMultiplyBy(oRotate) ' ' Choose aRotAngles[2] about z which transforms axes[0] onto the x axis ' If (oMatrix.Cell(1, 1) >= 1#) Then dAcosValue = 0# Else If (oMatrix.Cell(1, 1) <= -1#) Then dAcosValue = PI Else dAcosValue = Acos(oMatrix.Cell(1, 1)) End If End If aRotAngles(2) = Math.Sign(-oMatrix.Cell(2, 1)) * dAcosValue 'if you want to get the result in degrees aRotAngles(0) = Round(aRotAngles(0) * TODEGREES,4) aRotAngles(1) = Round(aRotAngles(1) * TODEGREES,4) aRotAngles(2) = Round(aRotAngles(2) * TODEGREES,4) End Sub Public Function Acos(value) As Double Acos = Math.Atan(-value / Math.Sqrt(-value * value + 1)) + 2 * Math.Atan(1) End Function
Solved! Go to Solution.
Solved by WCrihfield. Go to Solution.
Solved by SevInventor. Go to Solution.
got the solution,
Sub Main Dim oAsm As AssemblyDocument= ThisApplication.ActiveDocument On Error Resume Next 'get the active assembly Dim oAsmComp As AssemblyComponentDefinition= ThisApplication.ActiveDocument.ComponentDefinition For Each öConstraint In oAsmComp.Constraints öConstraint.Delete Next 'set the Master LOD active Dim oLODRep As LevelOfDetailRepresentation oLODRep = oAsmComp.RepresentationsManager.LevelOfDetailRepresentations.Item("Master") oLODRep.Activate 'Iterate through all of the top level occurrences Dim oOccurrence As ComponentOccurrence For Each oOccurrence In oAsmComp.Occurrences ' 'ground everything in the top level oOccurrence.Grounded = True Next Dim oUM As UnitsOfMeasure = oAsm.UnitsOfMeasure Dim oOcc As ComponentOccurrence For Each oOcc In oAsm.ComponentDefinition.Occurrences Dim oTransform As Matrix oTransform = oOcc.Transformation Dim oOriginLocation As Vector oOriginLocation = oTransform.Translation Dim AbstandvonEbene(0 To 3) As Double AbstandvonEbene(1) = oOriginLocation.X AbstandvonEbene(2) = oOriginLocation.Y AbstandvonEbene(3) = oOriginLocation.Z 'Create a proxy for Face0 (The face in the context of the assembly) Dim Zähler As Integer = 1 'cycle each Origin plane in the top assembly For Zähler = 1 To 3 Dim curAsmOrPlane As WorkPlane = oAsmComp.WorkPlanes.Item(Zähler) 'oOcc.CreateGeometryProxy(curAsmOrPlane1, curAsmOrPlane) 'Dim oComp1 As ComponentOccurrence = oADef.Occurrences.Item(1) Dim oCompAsmDef As AssemblyComponentDefinition Dim oCompPtDef As PartComponentDefinition 'cycle each Origin plane in the first level Occurence in the assembly For Zähler2 = 1 To 3 If oOcc.DefinitionDocumentType = DocumentTypeEnum.kAssemblyDocumentObject Then oCompAsmDef = oOcc.Definition oOcc.CreateGeometryProxy(oCompAsmDef.WorkPlanes.Item(Zähler2),curCompOriPlane) ElseIf oOcc.DefinitionDocumentType = DocumentTypeEnum.kPartDocumentObject Then oCompPtDef = oOcc.Definition oOcc.CreateGeometryProxy(oCompPtDef.WorkPlanes.Item(Zähler2), curCompOriPlane) End If Dim oParalell As Boolean= curAsmOrPlane.Plane.IsParallelTo(curCompOriPlane.Plane, 0.00001) Dim oSameDirection As Boolean= curAsmOrPlane.Plane.Normal.IsEqualTo(curCompOriPlane.Plane.Normal) Dim oNV As NameValueMap If oParalell=True Then ' If oSameDirection=True Then oConstraint=oAsmComp.Constraints.AddFlushConstraint(curAsmOrPlane, curCompOriPlane, AbstandvonEbene(Zähler)) End If If oSameDirection=False Then oConstraint=oAsmComp.Constraints.AddMateConstraint(curAsmOrPlane, curCompOriPlane, AbstandvonEbene(Zähler)) End If End If Next Next oOcc.Grounded = False Next End Sub
First of all thank you very much for this solution. It is truly a very useful job!
I would need help with a small modification. Basically I would like to know how to modify the code to constrain the origin planes of the parts with an origin planes of an "Alpha" part instead of the origin of the parent assembly. It would be very convenient to be able to reposition parts in assemblies that are not centered at the origin
Yes, there is some code here:
https://modthemachine.typepad.com/my_weblog/2009/04/positioning-assembly-occurrences.html
ive adapted it to work in ilogic. This one doesn't decide if flush or mate and does not measure the actual distance between occurences. Maybe you can use the code above.and this one to get what you want.
Sub main() Dim assemblydoc As AssemblyDocument 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 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 constraints = assemblydoc.ComponentDefinition.Constraints ' Iterate through the other occurrences Dim i As Integer For i = 2 To occurrenceList.Count Dim thisOcc As ComponentOccurrence 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. BaseXY = Occurrence.Definition.WorkPlanes.Item(3) BaseYZ = Occurrence.Definition.WorkPlanes.Item(1) 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
I try to set a selected occurence as base for constrain the other but i don't know why he didn't work :/
Any idea?
Sub Main Dim oAsm As AssemblyDocument= ThisApplication.ActiveDocument On Error Resume Next 'get the active assembly Dim oAsmComp As AssemblyComponentDefinition= ThisApplication.ActiveDocument.ComponentDefinition For Each �Constraint In oAsmComp.Constraints �Constraint.Delete Next 'set the Master LOD active Dim oLODRep As LevelOfDetailRepresentation oLODRep = oAsmComp.RepresentationsManager.LevelOfDetailRepresentations.Item("Master") oLODRep.Activate 'Iterate through all of the top level occurrences Dim oOccurrence As ComponentOccurrence For Each oOccurrence In oAsmComp.Occurrences ' 'ground everything in the top level oOccurrence.Grounded = True Next ''''''''''''''''''''''''''''''''''''''''''''''' ' Get the occurrences in the select set. Dim occurrenceList As New Collection Dim entity As Object entity = oAsm.Select Dim baseOccurrence As ComponentOccurrence baseOccurrence = entity ''''''''''''''''''''''''''''''''''''''''''''''' Dim oUM As UnitsOfMeasure = oAsm.UnitsOfMeasure Dim oOcc As ComponentOccurrence For Each oOcc In oAsm.ComponentDefinition.Occurrences Dim oTransform As Matrix oTransform = oOcc.Transformation Dim oOriginLocation As Vector oOriginLocation = oTransform.Translation Dim AbstandvonEbene(0 To 3) As Double AbstandvonEbene(1) = oOriginLocation.X AbstandvonEbene(2) = oOriginLocation.Y AbstandvonEbene(3) = oOriginLocation.Z 'Create a proxy for Face0 (The face in the context of the assembly) Dim Z�hler As Integer = 1 'cycle each Origin plane in the top assembly For Z�hler = 1 To 3 Dim curAsmOrPlane As WorkPlane = baseOccurrence.WorkPlanes.Item(Z�hler) Dim oCompAsmDef As AssemblyComponentDefinition Dim oCompPtDef As PartComponentDefinition 'cycle each Origin plane in the first level Occurence in the assembly For Z�hler2 = 1 To 3 If oOcc.DefinitionDocumentType = DocumentTypeEnum.kAssemblyDocumentObject Then oCompAsmDef = oOcc.Definition oOcc.CreateGeometryProxy(oCompAsmDef.WorkPlanes.Item(Z�hler2),curCompOriPlane) ElseIf oOcc.DefinitionDocumentType = DocumentTypeEnum.kPartDocumentObject Then oCompPtDef = oOcc.Definition oOcc.CreateGeometryProxy(oCompPtDef.WorkPlanes.Item(Z�hler2), curCompOriPlane) End If Dim oParalell As Boolean= curAsmOrPlane.Plane.IsParallelTo(curCompOriPlane.Plane, 0.00001) Dim oSameDirection As Boolean= curAsmOrPlane.Plane.Normal.IsEqualTo(curCompOriPlane.Plane.Normal) Dim oNV As NameValueMap If oParalell=True Then If oSameDirection=True Then oConstraint=oAsmComp.Constraints.AddFlushConstraint(curAsmOrPlane, curCompOriPlane, AbstandvonEbene(Z�hler)) End If If oSameDirection=False Then oConstraint=oAsmComp.Constraints.AddMateConstraint(curAsmOrPlane, curCompOriPlane, AbstandvonEbene(Z�hler)) End If End If Next Next oOcc.Grounded = False Next End Sub 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. BaseXY = Occurrence.Definition.WorkPlanes.Item(3) BaseYZ = Occurrence.Definition.WorkPlanes.Item(1) 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
Hi @ts2.cad3. I'm not 100% sure what your goal was there, but I'm pretty sure you want a way to specify a stationary component, then constrain one (or more) other components to that stationary component, by the proxies of their origin planes, while deleting any existing constraints that may have already been on the component that you want to move. If that sounds accurate, then this rule should work for that task fairly well. I chose not to label the WorkPlanes, because I often rename my origin WorkPlanes anyways to more useful useful names, and some folks may have their UCS & ViewCube system set-up differently than standard. The code below is not currently set-up with a loop, but I believe it could be, if needed/wanted. I placed a couple comments in key places that would likely be good places for beginning/ending a loop, if you were to use one. Or it could be converted to get rid of the second Pick function, and just loop all other top level components (other than the stationary one).
Sub Main
Dim oBaseComponent As ComponentOccurrence = PickComponent("Pick Base Component.")
If IsNothing(oBaseComponent) Then Exit Sub
Dim oADef As AssemblyComponentDefinition = oBaseComponent.Parent
Dim oConsts As AssemblyConstraints = oADef.Constraints
oTrans = ThisApplication.TransactionManager.StartTransaction(oADef.Document, "Constrain Components (API)")
Dim oBaseWPPs As List(Of WorkPlaneProxy) = GetComponentOriginPlaneProxies(oBaseComponent)
If IsNothing(oBaseWPPs) OrElse (Not oBaseWPPs.Count = 3) Then
MsgBox("Failed to get 3 WorkPlaneProxy objects from Base component. Exiting.", vbCritical, "")
oTrans.Abort
Exit Sub
End If
Dim oBaseTrans As Matrix = oBaseComponent.Transformation
'<<<< Good Point For Loop Of Remaining Code >>>>
Dim oCompToMove As ComponentOccurrence = PickComponent("Pick Component To Move.")
If IsNothing(oCompToMove) Then oTrans.Abort : Exit Sub
Dim oCompToMoveWPPs As List(Of WorkPlaneProxy) = GetComponentOriginPlaneProxies(oCompToMove)
If IsNothing(oCompToMoveWPPs) OrElse (Not oCompToMoveWPPs.Count = 3) Then
MsgBox("Failed to get 3 WorkPlaneProxy objects from component to move. Exiting.", vbCritical, "")
oTrans.Abort
Exit Sub
End If
DeleteConstraints(oCompToMove)
oCompToMove.Transformation = oBaseTrans
For i As Integer = 0 To 2
oConst = oConsts.AddFlushConstraint(oBaseWPPs.Item(i), oCompToMoveWPPs.Item(i), 0)
Next
'<<<< End Loop Here, If Using One >>>>
oTrans.End
End Sub
Function PickComponent(oPrompt As String) As ComponentOccurrence
oObj = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kAssemblyOccurrenceFilter, oPrompt)
If IsNothing(oObj) OrElse (TypeOf oObj Is ComponentOccurrence = False) Then Return Nothing
Dim oOcc As ComponentOccurrence = oObj
Return oOcc
End Function
Function GetComponentOriginPlaneProxies(oComp As ComponentOccurrence) As List(Of WorkPlaneProxy)
If IsNothing(oComp) Then Return Nothing
Dim oWPs As WorkPlanes = Nothing
Dim oWPPs As New List(Of WorkPlaneProxy)
If TypeOf oComp.Definition Is PartComponentDefinition Or _
TypeOf oComp.Definition Is AssemblyComponentDefinition Then
oWPs = oComp.Definition.WorkPlanes
Else
Return Nothing
End If
For i As Integer = 1 To 3
Dim oWPP As WorkPlaneProxy = Nothing
oWP = oWPs.Item(i)
oComp.CreateGeometryProxy(oWP, oWPP)
oWPPs.Add(oWPP)
Next
Return oWPPs
End Function
Sub DeleteConstraints(oComp As ComponentOccurrence)
If IsNothing(oComp) Then Exit Sub
If oComp.Constraints.Count = 0 Then Exit Sub
For Each oConst As AssemblyConstraint In oComp.Constraints
oConst.Delete
Next
End Sub
If this solved your problem, or answered your question, please click ACCEPT SOLUTION.
Or, if this helped you, please click (LIKE or KUDOS) 👍.
If you want and have time, I would appreciate your Vote(s) for My IDEAS :bulb: or you can Explore My CONTRIBUTIONS
Wesley Crihfield
(Not an Autodesk Employee)
Hi WCrihfield, thank for you for your reply.
My goal is to constrain the origin planes of one or more parts of an assembly to the origin planes of a base component but to the relative distance / position in which they are at the moment of the execution of the rule.
The code you posted works fine, I should find a way to measure relative distances before placing the constraint.
to check if the workplanes are parallel and facing the same direction something like this is missing. Also the loop has to go trough all base Workplanes and all target Workplanes. because each of them could be parallel
Dim oParalell As Boolean= curAsmOrPlane.Plane.IsParallelTo(curCompOriPlane.Plane, 0.00001) Dim oSameDirection As Boolean= curAsmOrPlane.Plane.Normal.IsEqualTo(curCompOriPlane.Plane.Normal) If oParalell=True Then ' If oSameDirection=True Then oConstraint=oAsmComp.Constraints.AddFlushConstraint(curAsmOrPlane, curCompOriPlane, AbstandvonEbene(Zähler)) End If If oSameDirection=False Then oConstraint=oAsmComp.Constraints.AddMateConstraint(curAsmOrPlane, curCompOriPlane, AbstandvonEbene(Zähler)) End If End If Next Next
the distance between base Occurence and the the target Occurence could be calculated through component transformation. But i don't know exactly how.
Dim oBaseTrans As Matrix = oBaseComponent.Transformation
Ok this seems to work (sometimes):
Sub Main Dim oBaseComponent As ComponentOccurrence = PickComponent("Pick Base Component.") If IsNothing(oBaseComponent) Then Exit Sub Dim oADef As AssemblyComponentDefinition = oBaseComponent.Parent Dim oConsts As AssemblyConstraints = oADef.Constraints oTrans = ThisApplication.TransactionManager.StartTransaction(oADef.Document, "Constrain Components (API)") Dim oBaseWPPs As List(Of WorkPlaneProxy) = GetComponentOriginPlaneProxies(oBaseComponent) If IsNothing(oBaseWPPs) OrElse (Not oBaseWPPs.Count = 3) Then MsgBox("Failed to get 3 WorkPlaneProxy objects from Base component. Exiting.", vbCritical, "") oTrans.Abort Exit Sub End If Dim oBaseTrans As Matrix = oBaseComponent.Transformation ''' Dim oAsmComp As AssemblyComponentDefinition= ThisApplication.ActiveDocument.ComponentDefinition For Each oOccurrence In oAsmComp.Occurrences ' 'ground everything in the top level oOccurrence.Grounded = True Next ''' '<<<< Good Point For Loop Of Remaining Code >>>> ''' Dim oCompToMove As ComponentOccurrence = PickComponent("Pick Component To Move.")''' If IsNothing(oCompToMove) Then oTrans.Abort : Exit Sub''' Dim oCompToMoveWPPs As List(Of WorkPlaneProxy) = GetComponentOriginPlaneProxies(oCompToMove)''' If IsNothing(oCompToMoveWPPs) OrElse (Not oCompToMoveWPPs.Count = 3) Then''' MsgBox("Failed to get 3 WorkPlaneProxy objects from component to move. Exiting.", vbCritical, "")''' oTrans.Abort''' Exit Sub''' End If ''' DeleteConstraints(oCompToMove)''' oCompToMove.Transformation = oBaseTrans''' ''' For i As Integer = 0 To 2''' oConst = oConsts.AddFlushConstraint(oBaseWPPs.Item(i), oCompToMoveWPPs.Item(i), 0)''' Next Dim oAsm As AssemblyDocument= ThisApplication.ActiveDocument Dim oUM As UnitsOfMeasure = oAsm.UnitsOfMeasure Dim oOcc As ComponentOccurrence For Each oOcc In oAsm.ComponentDefinition.Occurrences Dim oTransform As Matrix oTransform = oOcc.Transformation Dim oOriginLocation As Vector oOriginLocation = oTransform.Translation Dim AbstandvonEbene(0 To 3) As Double AbstandvonEbene(1) = oOriginLocation.X AbstandvonEbene(2) = oOriginLocation.Y AbstandvonEbene(3) = oOriginLocation.Z 'Create a proxy for Face0 (The face in the context of the assembly) Dim Z�hler As Integer = 1 'cycle each Origin plane in the top assembly For Z�hler = 1 To 3 Dim oBaseWPPstOrPlane As WorkPlane = oBaseWPPs(Z�hler) Dim oCompAsmDef As AssemblyComponentDefinition Dim oCompPtDef As PartComponentDefinition 'cycle each Origin plane of base component in the first level Occurence in the assembly For Z�hler2 = 1 To 3 If oOcc.DefinitionDocumentType = DocumentTypeEnum.kAssemblyDocumentObject Then oCompAsmDef = oOcc.Definition oOcc.CreateGeometryProxy(oCompAsmDef.WorkPlanes.Item(Z�hler2),curCompOriPlane) ElseIf oOcc.DefinitionDocumentType = DocumentTypeEnum.kPartDocumentObject Then oCompPtDef = oOcc.Definition oOcc.CreateGeometryProxy(oCompPtDef.WorkPlanes.Item(Z�hler2), curCompOriPlane) End If Dim oParalell As Boolean= oBaseWPPstOrPlane.Plane.IsParallelTo(curCompOriPlane.Plane, 0.00001) Dim oSameDirection As Boolean= oBaseWPPstOrPlane.Plane.Normal.IsEqualTo(curCompOriPlane.Plane.Normal) Dim oNV As NameValueMap If oParalell=True Then If oSameDirection=True Then oConstraint=oAsmComp.Constraints.AddFlushConstraint(curAsmOrPlane, curCompOriPlane, AbstandvonEbene(Z�hler)) End If If oSameDirection=False Then oConstraint=oAsmComp.Constraints.AddMateConstraint(curAsmOrPlane, curCompOriPlane, AbstandvonEbene(Z�hler)) End If End If Next Next Next ''' '<<<< End Loop Here, If Using One >>>> oTrans.End End Sub Function PickComponent(oPrompt As String) As ComponentOccurrence oObj = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kAssemblyOccurrenceFilter, oPrompt) If IsNothing(oObj) OrElse (TypeOf oObj Is ComponentOccurrence = False) Then Return Nothing Dim oOcc As ComponentOccurrence = oObj Return oOcc End Function Function GetComponentOriginPlaneProxies(oComp As ComponentOccurrence) As List(Of WorkPlaneProxy) If IsNothing(oComp) Then Return Nothing Dim oWPs As WorkPlanes = Nothing Dim oWPPs As New List(Of WorkPlaneProxy) If TypeOf oComp.Definition Is PartComponentDefinition Or _ TypeOf oComp.Definition Is AssemblyComponentDefinition Then oWPs = oComp.Definition.WorkPlanes Else Return Nothing End If For i As Integer = 1 To 3 Dim oWPP As WorkPlaneProxy = Nothing oWP = oWPs.Item(i) oComp.CreateGeometryProxy(oWP, oWPP) oWPPs.Add(oWPP) Next Return oWPPs End Function Sub DeleteConstraints(oComp As ComponentOccurrence) If IsNothing(oComp) Then Exit Sub If oComp.Constraints.Count = 0 Then Exit Sub For Each oConst As AssemblyConstraint In oComp.Constraints oConst.Delete Next End Sub
This is state so far:
Sub Main Dim oBaseComponent As ComponentOccurrence = PickComponent("Pick Base Component.") If IsNothing(oBaseComponent) Then Exit Sub oBaseComponent.Grounded = True Dim oADef As AssemblyComponentDefinition = oBaseComponent.Parent Dim oConsts As AssemblyConstraints = oADef.Constraints oTrans = ThisApplication.TransactionManager.StartTransaction(oADef.Document, "Constrain Components (API)") Dim oBaseWPPs As List(Of WorkPlaneProxy) = GetComponentOriginPlaneProxies(oBaseComponent) If IsNothing(oBaseWPPs) OrElse (Not oBaseWPPs.Count = 3) Then MsgBox("Failed to get 3 WorkPlaneProxy objects from Base component. Exiting.", vbCritical, "") oTrans.Abort Exit Sub End If Dim oBaseTrans As Matrix = oBaseComponent.Transformation '<<<< Good Point For Loop Of Remaining Code >>>> Dim oCompToMove As ComponentOccurrence = PickComponent("Pick Component To Move.") If IsNothing(oCompToMove) Then oTrans.Abort : Exit Sub oCompToMove.Grounded = True Dim oCompToMoveWPPs As List(Of WorkPlaneProxy) = GetComponentOriginPlaneProxies(oCompToMove) If IsNothing(oCompToMoveWPPs) OrElse (Not oCompToMoveWPPs.Count = 3) Then MsgBox("Failed to get 3 WorkPlaneProxy objects from component to move. Exiting.", vbCritical, "") oTrans.Abort Exit Sub End If DeleteConstraints(oCompToMove) Dim oCompToMoveTrans As Matrix = oCompToMove.Transformation Dim oLocationBase As Vector oLocationBase = oBaseTrans.Translation Dim oOriginLocation As Vector oOriginLocation = oCompToMoveTrans.Translation Dim Calcdistance(0 To 2) As Double Calcdistance(0) = (oLocationBase.X-oOriginLocation.X)*(-1) Calcdistance(1) = (oLocationBase.Y-oOriginLocation.Y)*(-1) Calcdistance(2) = (oLocationBase.Z-oOriginLocation.Z)*(-1) For i As Integer = 0 To 2 For i2 As Integer = 0 To 2 Dim oParallel As Boolean = oBaseWPPs.Item(i).Plane.IsParallelTo(oCompToMoveWPPs.Item(i2).Plane, 0.00001) Dim oSameDirection As Boolean=False oSameDirection= oBaseWPPs.Item(i).Plane.Normal.IsEqualTo(oCompToMoveWPPs.Item(i2).Plane.Normal) If oParallel=True Then ' If oSameDirection=True Then oConstraint=oConsts.AddFlushConstraint(oBaseWPPs.Item(i), oCompToMoveWPPs.Item(i2), Calcdistance(i)) End If If oSameDirection=False Then oConstraint=oConsts.AddMateConstraint(oBaseWPPs.Item(i), oCompToMoveWPPs.Item(i2), Calcdistance(i)) End If End If Next ' oConst = oConsts.AddFlushConstraint(oBaseWPPs.Item(i), oCompToMoveWPPs.Item(i), 0) MsgBox(Calcdistance(i)) Next '<<<< End Loop Here, If Using One >>>> oTrans.End End Sub Function PickComponent(oPrompt As String) As ComponentOccurrence oObj = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kAssemblyOccurrenceFilter, oPrompt) If IsNothing(oObj) OrElse (TypeOf oObj Is ComponentOccurrence = False) Then Return Nothing Dim oOcc As ComponentOccurrence = oObj Return oOcc End Function Function GetComponentOriginPlaneProxies(oComp As ComponentOccurrence) As List(Of WorkPlaneProxy) If IsNothing(oComp) Then Return Nothing Dim oWPs As WorkPlanes = Nothing Dim oWPPs As New List(Of WorkPlaneProxy) If TypeOf oComp.Definition Is PartComponentDefinition Or _ TypeOf oComp.Definition Is AssemblyComponentDefinition Then oWPs = oComp.Definition.WorkPlanes Else Return Nothing End If For i As Integer = 1 To 3 Dim oWPP As WorkPlaneProxy = Nothing oWP = oWPs.Item(i) oComp.CreateGeometryProxy(oWP, oWPP) oWPPs.Add(oWPP) Next Return oWPPs End Function Sub DeleteConstraints(oComp As ComponentOccurrence) If IsNothing(oComp) Then Exit Sub If oComp.Constraints.Count = 0 Then Exit Sub For Each oConst As AssemblyConstraint In oComp.Constraints oConst.Delete Next End Sub
The Calcdistance(i) is not in the right sequence because the originplanes are not like the originplanes of the top level assembly
Ok i just made some little modification to your last code to reiterate in all the component of the assembly.
Thank you very much whitout your help it would have been impossible for me !!!
Sub Main() Dim _invApp As Inventor.Application Dim _started As Boolean = False Dim oTrans As Transaction Dim oConst As FlushConstraint Dim kDefaultDisplayLengthUnits As Object Dim asmDoc As AssemblyDocument = ThisApplication.ActiveDocument Dim oAsmComp As AssemblyComponentDefinition= ThisApplication.ActiveDocument.ComponentDefinition If asmDoc.SelectSet.Count = 0 Then MsgBox("Need to select a Part or Sub Assembly") Return End If If asmDoc.SelectSet.Count = 0 Then MsgBox("Need to select a Part or Sub Assembly") Return End If Try AlignOccurrencesWithConstraints() ''' Dim oOccurrence As ComponentOccurrence For Each oOccurrence In oAsmComp.Occurrences oOccurrence.Grounded = True Next ''' Catch ex As Exception ' MsgBox("Is the selected item a Component?") MsgBox(ex.ToString()) Return End Try End Sub Sub AlignOccurrencesWithConstraints() Dim assemblydoc As AssemblyDocument = ThisApplication.ActiveDocument 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 Dim baseOccurrence As ComponentOccurrence = occurrenceList.Item(1) Dim constraints As AssemblyConstraints = assemblydoc.ComponentDefinition.Constraints ' Iterate through the other occurrences Dim i As Integer For i = 2 To occurrenceList.Count Dim thisOcc As ComponentOccurrence = occurrenceList.Item(i) ConstrPlanes(baseOccurrence, thisOcc) Next End Sub Public Sub ConstrPlanes(ByVal baseOccurrence As ComponentOccurrence,ByVal thisOcc As ComponentOccurrence) Dim oBaseComponent As ComponentOccurrence = baseOccurrence If IsNothing(oBaseComponent) Then Exit Sub oBaseComponent.Grounded = True Dim oADef As AssemblyComponentDefinition = oBaseComponent.Parent Dim oConsts As AssemblyConstraints = oADef.Constraints oTrans = ThisApplication.TransactionManager.StartTransaction(oADef.Document, "Constrain Components (API)") Dim oBaseWPPs As List(Of WorkPlaneProxy) = GetComponentOriginPlaneProxies(oBaseComponent) If IsNothing(oBaseWPPs) OrElse (Not oBaseWPPs.Count = 3) Then MsgBox("Failed to get 3 WorkPlaneProxy objects from Base component. Exiting.", vbCritical, "") oTrans.Abort Exit Sub End If Dim oBaseTrans As Matrix = oBaseComponent.Transformation '<<<< Good Point For Loop Of Remaining Code >>>> Dim oCompToMove As ComponentOccurrence = thisOcc If IsNothing(oCompToMove) Then oTrans.Abort : Exit Sub oCompToMove.Grounded = True Dim oCompToMoveWPPs As List(Of WorkPlaneProxy) = GetComponentOriginPlaneProxies(oCompToMove) If IsNothing(oCompToMoveWPPs) OrElse (Not oCompToMoveWPPs.Count = 3) Then MsgBox("Failed to get 3 WorkPlaneProxy objects from component to move. Exiting.", vbCritical, "") oTrans.Abort Exit Sub End If DeleteConstraints(oCompToMove) Dim oCompToMoveTrans As Matrix = oCompToMove.Transformation Dim oLocationBase As Vector oLocationBase = oBaseTrans.Translation Dim oOriginLocation As Vector oOriginLocation = oCompToMoveTrans.Translation Dim Calcdistance(0 To 2) As Double Calcdistance(0) = (oLocationBase.X-oOriginLocation.X)*(-1) Calcdistance(1) = (oLocationBase.Y-oOriginLocation.Y)*(-1) Calcdistance(2) = (oLocationBase.Z-oOriginLocation.Z)*(-1) For i As Integer = 0 To 2 For i2 As Integer = 0 To 2 Dim oParallel As Boolean = oBaseWPPs.Item(i).Plane.IsParallelTo(oCompToMoveWPPs.Item(i2).Plane, 0.00001) Dim oSameDirection As Boolean=False oSameDirection= oBaseWPPs.Item(i).Plane.Normal.IsEqualTo(oCompToMoveWPPs.Item(i2).Plane.Normal) If oParallel=True Then ' If oSameDirection=True Then oConstraint=oConsts.AddFlushConstraint(oBaseWPPs.Item(i), oCompToMoveWPPs.Item(i2), Calcdistance(i)) End If If oSameDirection=False Then oConstraint=oConsts.AddMateConstraint(oBaseWPPs.Item(i), oCompToMoveWPPs.Item(i2), Calcdistance(i)) End If End If Next ' oConst = oConsts.AddFlushConstraint(oBaseWPPs.Item(i), oCompToMoveWPPs.Item(i), 0) MsgBox(Calcdistance(i)) Next '<<<< End Loop Here, If Using One >>>> oTrans.End End Sub Function PickComponent(oPrompt As String) As ComponentOccurrence oObj = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kAssemblyOccurrenceFilter, oPrompt) If IsNothing(oObj) OrElse (TypeOf oObj Is ComponentOccurrence = False) Then Return Nothing Dim oOcc As ComponentOccurrence = oObj Return oOcc End Function Function GetComponentOriginPlaneProxies(oComp As ComponentOccurrence) As List(Of WorkPlaneProxy) If IsNothing(oComp) Then Return Nothing Dim oWPs As WorkPlanes = Nothing Dim oWPPs As New List(Of WorkPlaneProxy) If TypeOf oComp.Definition Is PartComponentDefinition Or _ TypeOf oComp.Definition Is AssemblyComponentDefinition Then oWPs = oComp.Definition.WorkPlanes Else Return Nothing End If For i As Integer = 1 To 3 Dim oWPP As WorkPlaneProxy = Nothing oWP = oWPs.Item(i) oComp.CreateGeometryProxy(oWP, oWPP) oWPPs.Add(oWPP) Next Return oWPPs End Function Sub DeleteConstraints(oComp As ComponentOccurrence) If IsNothing(oComp) Then Exit Sub If oComp.Constraints.Count = 0 Then Exit Sub For Each oConst As AssemblyConstraint In oComp.Constraints oConst.Delete Next End Sub
Hi @ts2.cad3. This has been an interesting task to tackle. I originally did not realize you needed to maintain relative distances and relative orientations between base component and the other component. But the resulting code I created is probably useful to some folks with a slightly different task to tackle. And I also was not sure if you really intended to constrain 'all' other components to the base component, or just one, or just a select few. So, I altered my code to get rid of the second Pick function, and instead just loop through all other components in the assembly, to constrain them all to the one selected base component. Then streamlined the rest of the code a bit, and incorporated the parallel and direction difference checks into it, but did the offset calculation a bit simpler.
Also, out of interest I continued looking into this task, and threw in a potential stumbling block into it as a test. What about if you have an OccurrencePattern in your assembly? So, in a test assembly file, I created a simple RectangularOccurrencePattern and attempted to update my code to deal with that situation, which would definitely trip up a simpler code. The position of an OccurrencePatternElement object is set/controlled by the pattern, and often do not have any constraints on them to keep them in place. Only the original input component(s) that you specified to create the pattern of will usually be constrained, and attempting to constrain any of the pattern elements will result in errors, due to becoming over constrained. So, I created a custom Function to use as a sort of a 'filter' or 'checker' in this situation, to avoid that potential problem. I also left most of my comment lines in that Function code, because it can be hard to follow/understand what's going on (the train of thought).
Here is the resulting code, just in case you guys may find it helpful. I attached it as a Text file, because of how long it is, but if you can't download it, I can post it directly.
Wesley Crihfield
(Not an Autodesk Employee)
Hello WCrihfield,
So I've adapted my previous code with your better offset calculation. Now it works for me.
One missing step is to select more than one component to constrain to the base component.
Sub Main Dim oBaseComponent As ComponentOccurrence = PickComponent("Pick Base Component.") If IsNothing(oBaseComponent) Then Exit Sub oBaseComponent.Grounded = True Dim oADef As AssemblyComponentDefinition = oBaseComponent.Parent Dim oConsts As AssemblyConstraints = oADef.Constraints oTrans = ThisApplication.TransactionManager.StartTransaction(oADef.Document, "Constrain Components (API)") Dim oBaseWPPs As List(Of WorkPlaneProxy) = GetComponentOriginPlaneProxies(oBaseComponent) If IsNothing(oBaseWPPs) OrElse (Not oBaseWPPs.Count = 3) Then MsgBox("Failed to get 3 WorkPlaneProxy objects from Base component. Exiting.", vbCritical, "") oTrans.Abort Exit Sub End If Dim oBaseTrans As Matrix = oBaseComponent.Transformation '<<<< Good Point For Loop Of Remaining Code >>>> Dim oCompToMove As ComponentOccurrence = PickComponent("Pick Component To Move.") If IsNothing(oCompToMove) Then oTrans.Abort : Exit Sub oCompToMove.Grounded = True Dim oCompToMoveWPPs As List(Of WorkPlaneProxy) = GetComponentOriginPlaneProxies(oCompToMove) If IsNothing(oCompToMoveWPPs) OrElse (Not oCompToMoveWPPs.Count = 3) Then MsgBox("Failed to get 3 WorkPlaneProxy objects from component to move. Exiting.", vbCritical, "") oTrans.Abort Exit Sub End If DeleteConstraints(oCompToMove) For i As Integer = 0 To 2 For i2 As Integer = 0 To 2 Dim oParallel As Boolean = oBaseWPPs.Item(i).Plane.IsParallelTo(oCompToMoveWPPs.Item(i2).Plane, 0.00001) Dim oSameDirection As Boolean=False oSameDirection= oBaseWPPs.Item(i).Plane.Normal.IsEqualTo(oCompToMoveWPPs.Item(i2).Plane.Normal) oOffSet = oBaseWPPs.Item(i).Plane.DistanceTo(oCompToMoveWPPs.Item(i2).Plane.RootPoint) If oParallel=True Then ' If oSameDirection=True Then oConstraint=oConsts.AddFlushConstraint(oBaseWPPs.Item(i), oCompToMoveWPPs.Item(i2), oOffSet) End If If oSameDirection=False Then oConstraint=oConsts.AddMateConstraint(oBaseWPPs.Item(i), oCompToMoveWPPs.Item(i2), oOffSet) End If End If Next Next '<<<< End Loop Here, If Using One >>>> oTrans.End oCompToMove.Grounded = False oBaseComponent.Grounded = False End Sub Function PickComponent(oPrompt As String) As ComponentOccurrence oObj = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kAssemblyOccurrenceFilter, oPrompt) If IsNothing(oObj) OrElse (TypeOf oObj Is ComponentOccurrence = False) Then Return Nothing Dim oOcc As ComponentOccurrence = oObj Return oOcc End Function Function GetComponentOriginPlaneProxies(oComp As ComponentOccurrence) As List(Of WorkPlaneProxy) If IsNothing(oComp) Then Return Nothing Dim oWPs As WorkPlanes = Nothing Dim oWPPs As New List(Of WorkPlaneProxy) If TypeOf oComp.Definition Is PartComponentDefinition Or _ TypeOf oComp.Definition Is AssemblyComponentDefinition Then oWPs = oComp.Definition.WorkPlanes Else Return Nothing End If For i As Integer = 1 To 3 Dim oWPP As WorkPlaneProxy = Nothing oWP = oWPs.Item(i) oComp.CreateGeometryProxy(oWP, oWPP) oWPPs.Add(oWPP) Next Return oWPPs End Function Sub DeleteConstraints(oComp As ComponentOccurrence) If IsNothing(oComp) Then Exit Sub If oComp.Constraints.Count = 0 Then Exit Sub For Each oConst As AssemblyConstraint In oComp.Constraints oConst.Delete Next End Sub
OK. My code worked just fine for me. None of the components moved any at all, and it even constrained the component that I had created a component pattern of, so that the whole pattern would also maintain its position & orientation with the base component. I did notice however, that your code includes lines of code for grounding every component it encounters, including the base component, but then still utilizing the Sub to delete all other constraints on each 'other' component. But then there are two lines of code at the very end of your Sub Main area to turn off the 'ground' setting for the Base component, and the other component. But it seems to me that the line to turn off the ground setting for the other component would only effect the very last 'other' component, because it is after all of the loops, not within the loops. So...are all the 'other' components remaining 'grounded' in your results?
I just had no need to ground anything in my testing scenarios, because I had already fully constrained my base component (and sometimes the other components too) ahead of time, knowing my plans for it, and I was confident that none of the others would move, because I am measuring the offsets before applying the constraints. However, this type of code still is not all encompassing, because it does not address any components that may not be perfectly aligned parallel/perpendicular to the origin planes of the base component. I also considered using the UCS to UCS type constraints, while looking into this case. It seemed like more work was involved, and you have to create a UCS for each component (within the main assembly) to use ahead of time, which is similar to a work feature. It's fairly easy to create them though, using the components transformation matrix, and you end up with an object with a lot of useful properties.
Wesley Crihfield
(Not an Autodesk Employee)
hI WCrihfield, I have done various tests with your code and it works perfectly even in case there are in the set of series. You did a great job, thank you very much!
there would be only one case that should be further inspected, that is the case in which the origin planes of a component are not "aligned" with those of the base component. Probably a way could be found to constrain in this case, the point of origin of the component not "aligned" with the origin planes of the base component. It would still remain "rotatable" on its point of origin but at least it would keep the relative maximum position.
almost. there are some errors
Sub Main Dim oBaseComponent As ComponentOccurrence = PickComponent("Pick Base Component.") oDoc = ThisDoc.Document If IsNothing(oBaseComponent) Then Exit Sub oBaseComponent.Grounded = True Dim oADef As AssemblyComponentDefinition = oBaseComponent.Parent Dim oConsts As AssemblyConstraints = oADef.Constraints oTrans = ThisApplication.TransactionManager.StartTransaction(oADef.Document, "Constrain Components (API)") Dim oOcc As ComponentOccurrence Dim oOccCol As Inventor.ObjectCollection oOccCol = ThisApplication.TransientObjects.CreateObjectCollection Dim oBaseWPPs As List(Of WorkPlaneProxy) = GetComponentOriginPlaneProxies(oBaseComponent) If IsNothing(oBaseWPPs) OrElse (Not oBaseWPPs.Count = 3) Then MsgBox("Failed to get 3 WorkPlaneProxy objects from Base component. Exiting.", vbCritical, "") oTrans.Abort Exit Sub End If Do 'Ask user for a selection oOcc = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kAssemblyOccurrenceFilter, "Select a component :") If Not oOcc Is Nothing Then 'Add component to collection oOccCol.Add(oOcc) 'Set selected component inactive oOcc.Enabled = False End If Loop While Not oOcc Is Nothing 'Add collection to selection oDoc.SelectSet.SelectMultiple(oOccCol) oSelSet = oDoc.SelectSet '<<<< Good Point For Loop Of Remaining Code >>>> For Each oOcc In oSelSet oOcc.Grounded = True Dim oOccWPPs As List(Of WorkPlaneProxy) = GetComponentOriginPlaneProxies(oOcc) If IsNothing(oOccWPPs) OrElse (Not oOccWPPs.Count = 3) Then MsgBox("Failed to get 3 WorkPlaneProxy objects from component to move. Exiting.", vbCritical, "") oTrans.Abort Exit Sub End If ' DeleteConstraints(oOcc) For i As Integer = 0 To 2 For i2 As Integer = 0 To 2 Dim oParallel As Boolean = oBaseWPPs.Item(i).Plane.IsParallelTo(oOccWPPs.Item(i2).Plane, 0.00001) Dim oSameDirection As Boolean=False oSameDirection= oBaseWPPs.Item(i).Plane.Normal.IsEqualTo(oOccWPPs.Item(i2).Plane.Normal) oOffSet = oBaseWPPs.Item(i).Plane.DistanceTo(oOccWPPs.Item(i2).Plane.RootPoint) ' msgbox(oOffset) If oParallel=True Then If oSameDirection = True Then Try oConstraint = oConsts.AddFlushConstraint(oBaseWPPs.Item(i), oOccWPPs.Item(i2), oOffSet) Catch End Try End If If oSameDirection = False Then Try oConstraint = oConsts.AddMateConstraint(oBaseWPPs.Item(i), oOccWPPs.Item(i2), oOffSet) Catch end try End If End If Next Next '<<<< End Loop Here, If Using One >>>> oOcc.Grounded = False oOcc.Enabled = True Next oBaseComponent.Grounded = False oDoc.SelectSet.Clear oTrans.End End Sub Function PickComponent(oPrompt As String) As ComponentOccurrence oObj = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kAssemblyOccurrenceFilter, oPrompt) If IsNothing(oObj) OrElse (TypeOf oObj Is ComponentOccurrence = False) Then Return Nothing Dim oOcc As ComponentOccurrence = oObj Return oOcc End Function Function GetComponentOriginPlaneProxies(oComp As ComponentOccurrence) As List(Of WorkPlaneProxy) If IsNothing(oComp) Then Return Nothing Dim oWPs As WorkPlanes = Nothing Dim oWPPs As New List(Of WorkPlaneProxy) If TypeOf oComp.Definition Is PartComponentDefinition Or _ TypeOf oComp.Definition Is AssemblyComponentDefinition Then oWPs = oComp.Definition.WorkPlanes Else Return Nothing End If For i As Integer = 1 To 3 Dim oWPP As WorkPlaneProxy = Nothing oWP = oWPs.Item(i) oComp.CreateGeometryProxy(oWP, oWPP) oWPPs.Add(oWPP) Next Return oWPPs End Function Sub DeleteConstraints(oComp As ComponentOccurrence) If IsNothing(oComp) Then Exit Sub If oComp.Constraints.Count = 0 Then Exit Sub For Each oConst As AssemblyConstraint In oComp.Constraints oConst.Delete Next End Sub
maybe you can fix it.
Hi guys. I also did a bit more work on this project the other day, but chose not to publish my code yet at that time, because it was still a work in progress, and still needs more R&D. I was attempting to solve the issue of when the 'other' component's origin planes are not parallel with the 'base' component's origin planes. I also incorporated the 'grounding' steps suggested by @SevInventor, figuring that it probably wouldn't hurt anything. I further developed the routine for creating the constraints between the origin planes, out in its own Sub, by incorporating measuring angles and using angle constraints. Then, after seeing that was still not enough to fully constrain everything, I created an additional, but similar Sub routine for constraining the origin WorkAxes. This still was not fully constraining those certain few components that were deliberately not aligned in any way with the 'base' component, and left a lot of 'Redundant' constraints in place. It is also still set-up to loop through all other components, other than the one selected 'base' component, to constrain them all relatively to that base component, rather than selecting multiple components up front to process. For what its worth, I have pasted the code I had developed so far into a Text File, and attached it to this post for others to revue, and possibly further develop if they want.
I don't think that re-considering using the UCS to UCS constraint system will help here either, because the documentation about it says that it essentially creates a 'constraints set' consisting of 'three flush constraints' between either UCS's, component origins, or assembly origin. That doesn't sound any better than what we've already developed here. Plus, the other odd thing about that route, is that there does not appear to be an Inventor API method for creating them directly...just an iLogic only snippet, which returns an 'IManagedConstraint', instead of a regular AssemblyConstraint. I think there just needs to be a new or better constraint type, just for this specific purpose...constraining one component to another, while maintaining exact existing offsets, angles, and orientations, even if they are not aligned with each other in any way.
Wesley Crihfield
(Not an Autodesk Employee)
Can't find what you're looking for? Ask the community or share your knowledge.