Message 1 of 10
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
I found code that I want to use but it is a VBA Macro and I need to use it in ilogic. It copies a component in an assembly and duplicates it along with it's constraints. I was able to do 90% of the conversion and it saves fine but it errors out when I try to run it. Can someone help me. Here is the code I adjusted.
Sub Main()
Call DupeSelectionWithConstraints()
End Sub
Private oNewlyInsertedColl As Collection
Private oOriginalItemColl As Collection
Sub DupeSelectionWithConstraints()
If ThisApplication.ActiveDocument.DocumentType <> kAssemblyDocumentObject Then MsgBox ("Rule not valid for non-assembly files!"): Exit Sub
Dim oDoc As AssemblyDocument = ThisApplication.ActiveDocument
Dim oSS As SelectSet = oDoc.SelectSet
If oSS.Count < 1 Then MsgBox ("Rule Requires a Select Set!"): Exit Sub
Call DuplicateSS(oDoc, oSS)
End Sub
Private Sub DuplicateSS(oParentDoc As Document, oSS As SelectSet)
Dim oTG As TransientGeometry = ThisApplication.TransientGeometry
oPasteMatrix = oTG.CreateMatrix()
oOriginalItemColl = New Collection
oNewlyInsertedColl = New Collection
For Each oItem In oSS
oPasteMatrix = oItem.Transformation
oNewOcc = oParentDoc.ComponentDefinition.Occurrences.Add(oItem.Definition.Document.FullDocumentName, oPasteMatrix)
oOriginalItemColl.Add(oItem)
oNewlyInsertedColl.Add(oNewOcc)
Next
Dim oTestoOcc1 As Object
Dim oTestoOcc2 As Object
Dim oOcc1 As ComponentOccurrence
Dim oOcc2 As ComponentOccurrence
Dim oEntityOne As Object
Dim oEntityTwo As Object
For Each oConstraint In oParentDoc.ComponentDefinition.Constraints
'Grab entities for new constraint to create
oTestoOcc1 = GrabObjectFromColl(oOriginalItemColl, oConstraint.OccurrenceOne)
oTestoOcc2 = GrabObjectFromColl(oOriginalItemColl, oConstraint.OccurrenceTwo)
If oTestoOcc1 Is Nothing And oTestoOcc2 Is Nothing Then GoTo NextConstraint
If oTestoOcc1 Is Nothing Then
oEntityOne = oConstraint.EntityOne
Else
For Each oPossibleOcc In oNewlyInsertedColl
If oPossibleOcc.Definition Is oTestoOcc1.Definition Then
oOcc1 = oPossibleOcc
End If
Next
Call oOcc1.CreateGeometryProxy(GetProxy(oConstraint.EntityOne, oOcc1), oEntityOne)
End If
If oTestoOcc2 Is Nothing Then
oEntityTwo = oConstraint.EntityTwo
Else
For Each oPossibleOcc In oNewlyInsertedColl
If oPossibleOcc.Definition Is oTestoOcc2.Definition Then
oOcc2 = oPossibleOcc
End If
Next
Call oOcc2.CreateGeometryProxy(GetProxy(oConstraint.EntityTwo, oOcc2), oEntityTwo)
End If
'End Grab entities
'Check type of constraint
Select Case oConstraint.Type
Case 100665088 'kAngleConstraintObject
'oParentDoc.Constraints.AddAngleConstraint(EntityOne As Object,
' EntityTwo As Object,
' Angle As Variant,
' [SolutionType] As AngleConstraintSolutionTypeEnum,
' [ReferenceVectorEntity] As Variant,
' [BiasPointOne] As Variant,
' [BiasPointTwo] As Variant )
' As AngleConstraint
Call oParentDoc.ComponentDefinition.Constraints.AddAngleConstraint(oEntityOne, oEntityTwo, oConstraint.Angle, oConstraint.SolutionType, oConstraint.ReferenceVectorEntity)
Case 100707840 'kAssemblySymmetryConstraintObject
'oParentDoc.AddSymmetryConstraint( EntityOne As Object,
' EntityTwo As Object,
' SymmetryPlane As Object,
' [EntityOneInferredType] As InferredTypeEnum,
' [EntityTwoInferredType] As InferredTypeEnum,
' [NormalsOpposed] As Boolean )
' As AssemblySymmetryConstraint
Call oParentDoc.ComponentDefinition.Constraints.AddSymmetryConstraint(oEntityOne, oEntityTwo, oConstraint.SymmetryPlane, oConstraint.EntityOneInferredType, oConstraint.EntityTwoInferredType, oConstraint.NormalsOpposed)
Case 100666368 'kFlushConstraintObject
'oParentDoc.AddFlushConstraint( EntityOne As Object,
' EntityTwo As Object,
' Offset As Variant,
' [BiasPointOne] As Variant,
' [BiasPointTwo] As Variant )
' As FlushConstraint
Call oParentDoc.ComponentDefinition.Constraints.AddFlushConstraint(oEntityOne, oEntityTwo, oConstraint.Offset.Expression)
Case 100665344 'kInsertConstraintObject
'oParentDoc.AddInsertConstraint( EntityOne As Object,
' EntityTwo As Object,
' AxesOpposed As Boolean,
' Distance As Variant,
' [BiasPointOne] As Variant,
' [BiasPointTwo] As Variant )
' As InsertConstraint
Call oParentDoc.ComponentDefinition.Constraints.AddInsertConstraint(oEntityOne, oEntityTwo, oConstraint.AxesOpposed, oConstraint.Distance.Expression)
Case 100665856 'kMateConstraintObject
'oParentDoc.AddMateConstraint( EntityOne As Object,
' EntityTwo As Object,
' Offset As Variant,
' [EntityOneInferredType] As InferredTypeEnum,
' [EntityTwoInferredType] As InferredTypeEnum,
' [BiasPointOne] As Variant,
' [BiasPointTwo] As Variant )
' As MateConstraint
Call oParentDoc.ComponentDefinition.Constraints.AddMateConstraint(oEntityOne, oEntityTwo, oConstraint.Offset.Expression, oConstraint.EntityOneInferredType, oConstraint.EntityTwoInferredType)
Case 100665600 'kTangentConstraintObject
'.AddTangentConstraint( EntityOne As Object,
' EntityTwo As Object,
' InsideTangency As Boolean,
' Offset As Variant,
' [BiasPointOne] As Variant,
' [BiasPointTwo] As Variant )
' As TangentConstraint
Call oParentDoc.ComponentDefinition.Constraints.AddTangentConstraint(oEntityOne, oEntityTwo, oConstraint.InsideTangency, oConstraint.Offset.Expression)
End Select
NextConstraint:
Next 'constraint
End Sub
Private Function GrabObjectFromColl(ByVal oColl As Collection, ByVal oObj As Object) As Object
For Each oItem In oColl
If oItem Is oObj Then
GrabObjectFromColl = oObj
Exit Function
End If
Next
GrabObjectFromColl = Nothing
End Function
Private Function GetProxy(ByRef Prxy As Object, ByRef ContOcc As ComponentOccurrence) As Object
Dim TempPrxy As Object
Dim Occ As Object
If Prxy.ContainingOccurrence.Type = kComponentOccurrenceObject Then
Occ = ContOcc
Else
On Error Resume Next
Occ = ContOcc.Definition.Occurrences.ItemByName(Prxy.ContainingOccurrence.Name)
If Err.Number <> 0 Then
On Error GoTo 0
TempPrxy = Prxy.ContainingOccurrence
Call ContOcc.CreateGeometryProxy(GetProxy(TempPrxy, ContOcc), Occ)
End If
End If
Call Occ.CreateGeometryProxy(Prxy.NativeObject, GetProxy)
End Function
Solved! Go to Solution.
