Starting in December, we will archive content from the community that is 10 years and older. This FAQ provides more information.
I'm trying to duplicate an occurrence and constrain a work point nested in one of its subcomponents to each work point in a sketch driven pattern the user picks. Most of the code is working correctly. It duplicates the occurrence as many times as there are points in the sketch driven pattern. but I keep getting this error:
"Error adding mate constraint: Public member 'Position' on type 'FeaturePatternElementProxy' not found."
I'm using AI to help me write these codes, so please forgive me if the code looks wonky. How can I fix this so the constraints work with the sketch driven pattern points?
Here's the not-working correctly code:
Sub Main()
' Prompt the user to select an assembly in the active document
Dim oSelectedEntity As Object
oSelectedEntity = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kAssemblyOccurrenceFilter, "Select a subassembly in the model browser.")
' Check if the user selected a component occurrence
If oSelectedEntity Is Nothing OrElse Not TypeOf oSelectedEntity Is ComponentOccurrence Then
MessageBox.Show("No subassembly selected. Exiting script.", "No Selection")
Exit Sub
End If
' Extract file name and location from the selected assembly occurrence
Dim oCompOcc As ComponentOccurrence
oCompOcc = oSelectedEntity
Dim assemblyDoc As Document = oCompOcc.Definition.Document
Dim assemblyFileName As String = assemblyDoc.FullFileName
Dim assemblyLocation As String = System.IO.Path.GetDirectoryName(assemblyFileName)
' Get the part number of the original part
Dim partNumber As String = oCompOcc.Definition.Document.PropertySets.Item("Design Tracking Properties").Item("Part Number").Value
' Get active assembly document
Dim oDoc As AssemblyDocument
oDoc = ThisApplication.ActiveDocument
' Create a browser folder with the part number and get the folder object
Dim oFolder As BrowserFolder
oFolder = CreateBrowserFolder(oDoc, partNumber)
' Get the browser pane
Dim oPane As BrowserPane = oDoc.BrowserPanes.ActivePane
' Prompt the user to select a sketch-driven pattern
Dim oPattern As SketchDrivenPatternFeature
oPattern = PromptForSketchDrivenPattern(oDoc)
If oPattern Is Nothing Then
MessageBox.Show("No sketch-driven pattern selected. Exiting script.", "No Selection")
Exit Sub
End If
' Process each active element in the pattern
For Each oElement As Object In oPattern.PatternElements
If Not oElement.Suppressed Then
' Add selected assembly as a component to the active assembly
Dim oCompDef As ComponentDefinition
oCompDef = oDoc.ComponentDefinition
' Duplicate the selected occurrence (oCompOcc)
Dim oDuplicateOcc As ComponentOccurrence
oDuplicateOcc = DuplicateOccurrence(oCompOcc, oCompDef)
' Add angle constraints between oCompOcc and oDuplicateOcc
Call ApplyAngleConstraints(oCompOcc, oDuplicateOcc, oDoc.ComponentDefinition, 0)
' Move the duplicate occurrence to the new folder
If oFolder IsNot Nothing Then
Call AddtoFolder(oFolder, oDuplicateOcc, oPane)
End If
' Find sheet metal suboccurrence and add mate constraint
Dim constraintAdded As Boolean = AddMateConstraintToPatternElement(oDoc, oDuplicateOcc, oElement)
If Not constraintAdded Then
' If constraint wasn't added, skip to the next element
Continue For
End If
End If
Next
' Save the document to update changes
oDoc.Save()
MsgBox("Process completed. Document saved.", vbInformation)
End Sub
Function PromptForSketchDrivenPattern(oDoc As AssemblyDocument) As SketchDrivenPatternFeature
Dim oPattern As Object
Try
oPattern = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kAllEntitiesFilter, "Select a sketch-driven pattern")
If oPattern Is Nothing Then
Return Nothing
End If
If TypeOf oPattern Is SketchDrivenPatternFeature Then
Return DirectCast(oPattern, SketchDrivenPatternFeature)
Else
MessageBox.Show("Selected pattern is not a sketch-driven pattern. Please select a sketch-driven pattern.", "Invalid Selection")
Return Nothing
End If
Catch ex As Exception
MessageBox.Show("Error selecting sketch-driven pattern: " & ex.Message, "Error")
Return Nothing
End Try
End Function
Function AddMateConstraintToPatternElement(oDoc As AssemblyDocument, oDuplicateOcc As ComponentOccurrence, oElement As Object) As Boolean
Dim oTrans As Transaction = Nothing
Try
oTrans = ThisApplication.TransactionManager.StartTransaction(oDoc, "Add Mate Constraint to Pattern Element")
' Find the sheet metal suboccurrence
Dim oSheetMetalOcc As ComponentOccurrence = FindSheetMetalSuboccurrence(oDuplicateOcc)
If oSheetMetalOcc Is Nothing Then
MsgBox("No sheet metal suboccurrence found in the duplicated assembly.")
oTrans.End()
Return False
End If
' Get the origin work point of the sheet metal occurrence
Dim oOriginWorkPoint As WorkPoint
oOriginWorkPoint = oSheetMetalOcc.Definition.WorkPoints.Item(1) ' Assuming the first work point is the origin
' Create a proxy for the origin work point
Dim oOriginProxy As WorkPointProxy
oSheetMetalOcc.CreateGeometryProxy(oOriginWorkPoint, oOriginProxy)
' Get the position of the pattern element
Dim oPosition As Point
If TypeOf oElement Is FeaturePatternElement Then
oPosition = DirectCast(oElement, FeaturePatternElement).Position
ElseIf oElement.HasProperty("Position") Then
oPosition = oElement.Position
Else
MsgBox("Unable to get position from pattern element.")
oTrans.End()
Return False
End If
' Create a work point at the location of the pattern element
Dim oPatternPoint As WorkPoint = oDoc.ComponentDefinition.WorkPoints.AddByPoint(oPosition)
' Add mate constraint
Dim oConstraints As AssemblyConstraints = oDoc.ComponentDefinition.Constraints
oConstraints.AddMateConstraint(oOriginProxy, oPatternPoint, 0)
oTrans.End()
Return True
Catch ex As Exception
If Not oTrans Is Nothing Then
oTrans.Abort()
End If
MsgBox("Error adding mate constraint: " & ex.Message)
Return False
End Try
End Function
Function DuplicateOccurrence(sourceOcc As ComponentOccurrence, compDef As ComponentDefinition) As ComponentOccurrence
Dim oTrans As Transaction = Nothing
Dim oDuplicateOcc As ComponentOccurrence = Nothing
Try
oTrans = ThisApplication.TransactionManager.StartTransaction(compDef.Document, "Duplicate Occurrence")
' Create a matrix for positioning the duplicate occurrence
Dim oMatrix As Matrix = ThisApplication.TransientGeometry.CreateMatrix
oMatrix.SetToIdentity()
' Get existing occurrence names in the assembly
Dim existingNames As New List(Of String)
For Each occ As ComponentOccurrence In compDef.Occurrences
existingNames.Add(occ.Name)
Next
' Determine the new name for the duplicate occurrence
Dim baseName As String = sourceOcc.Name & "-COPY-001"
Dim newName As String = baseName
Dim count As Integer = 1
Do While existingNames.Contains(newName)
count += 1
newName = baseName.Substring(0, baseName.Length - 4) & "-" & count.ToString("000")
Loop
' Add the duplicate occurrence
oDuplicateOcc = compDef.Occurrences.Add(sourceOcc.Definition.Document.FullFileName, oMatrix)
' Set BOM structure to reference
oDuplicateOcc.BOMStructure = BOMStructureEnum.kReferenceBOMStructure
' Set the unique name
oDuplicateOcc.Name = newName
oTrans.End()
Catch ex As Exception
If Not oTrans Is Nothing Then
oTrans.Abort()
End If
MessageBox.Show("Error duplicating occurrence: " & ex.Message, "Error")
End Try
Return oDuplicateOcc
End Function
Sub ApplyAngleConstraints(O1 As ComponentOccurrence, O2 As ComponentOccurrence, aCD As ComponentDefinition, angleValue As Double)
On Error GoTo EER
Dim oTrans As Transaction = ThisApplication.TransactionManager.StartTransaction(aCD.Document, "Constraint Creation")
' Setup Proxies
Dim wPlane1 As WorkPlaneProxy
Dim wPlane2 As WorkPlaneProxy
' Run for 3 origin planes
For i = 1 To 3
O1.CreateGeometryProxy(O1.Definition.WorkPlanes.Item(i), wPlane1)
O2.CreateGeometryProxy(O2.Definition.WorkPlanes.Item(i), wPlane2)
' Create angle constraint
Dim angleConst As AngleConstraint = aCD.Constraints.AddAngleConstraint(wPlane1, wPlane2, angleValue)
Next
oTrans.End
Exit Sub
EER:
oTrans.Abort
End Sub
Function CreateBrowserFolder(oDoc As Document, folderName As String) As BrowserFolder
Dim oPane As BrowserPane = oDoc.BrowserPanes.ActivePane
Dim oTopNode As BrowserNode = oPane.TopNode
Dim oFolder As BrowserFolder = Nothing
' Try to find the folder, if it doesn't exist, create it
Try
oFolder = oTopNode.BrowserFolders.Item(folderName)
Catch
oFolder = oPane.AddBrowserFolder(folderName)
End Try
Return oFolder
End Function
Sub AddtoFolder(oFolder As BrowserFolder, oSelectedEntity As Object, oPane As BrowserPane)
Dim oNode As BrowserNode
' Add the selected component to the folder
If TypeOf oSelectedEntity Is ComponentOccurrence Then
Dim oOcc As ComponentOccurrence
oOcc = oSelectedEntity
oNode = oPane.GetBrowserNodeFromObject(oOcc)
oFolder.Add(oNode)
End If
End Sub
Function AddMateConstraintToSheetMetalOrigin(oDoc As AssemblyDocument, oDuplicateOcc As ComponentOccurrence, oWorkPoint As Object) As Boolean
Dim oTrans As Transaction = Nothing
Try
oTrans = ThisApplication.TransactionManager.StartTransaction(oDoc, "Add Mate Constraint to Sheet Metal Origin")
' Find the sheet metal suboccurrence
Dim oSheetMetalOcc As ComponentOccurrence = FindSheetMetalSuboccurrence(oDuplicateOcc)
If oSheetMetalOcc Is Nothing Then
MsgBox("No sheet metal suboccurrence found in the duplicated assembly.")
oTrans.End()
Return False
End If
' Get the origin work point of the sheet metal occurrence
Dim oOriginWorkPoint As WorkPoint
oOriginWorkPoint = oSheetMetalOcc.Definition.WorkPoints.Item(1) ' Assuming the first work point is the origin
' Create a proxy for the origin work point
Dim oOriginProxy As WorkPointProxy
oSheetMetalOcc.CreateGeometryProxy(oOriginWorkPoint, oOriginProxy)
' Add mate constraint
Dim oConstraints As AssemblyConstraints = oDoc.ComponentDefinition.Constraints
oConstraints.AddMateConstraint(oWorkPoint, oOriginProxy, 0)
oTrans.End()
Return True
Catch ex As Exception
If Not oTrans Is Nothing Then
oTrans.Abort()
End If
MsgBox("Error adding mate constraint: " & ex.Message)
Return False
End Try
End Function
Function FindSheetMetalSuboccurrence(oOcc As ComponentOccurrence) As ComponentOccurrence
' Check if the current occurrence is a sheet metal part
If TypeOf oOcc.Definition Is SheetMetalComponentDefinition Then
Return oOcc
End If
' If not, search through suboccurrences
For Each subOcc As ComponentOccurrence In oOcc.SubOccurrences
Dim result As ComponentOccurrence = FindSheetMetalSuboccurrence(subOcc)
If result IsNot Nothing Then
Return result
End If
Next
' If no sheet metal suboccurrence is found, return Nothing
Return Nothing
End Function
And here's the code that works correctly but only allows me to duplicate one at a time:
Sub Main()
' Prompt the user to select an assembly in the active document
Dim oSelectedEntity As Object
oSelectedEntity = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kAssemblyOccurrenceFilter, "Select a subassembly in the model browser.")
' Check if the user selected a component occurrence
If oSelectedEntity Is Nothing OrElse Not TypeOf oSelectedEntity Is ComponentOccurrence Then
MessageBox.Show("No subassembly selected. Exiting script.", "No Selection")
Exit Sub
End If
' Extract file name and location from the selected assembly occurrence
Dim oCompOcc As ComponentOccurrence
oCompOcc = oSelectedEntity
Dim assemblyDoc As Document = oCompOcc.Definition.Document
Dim assemblyFileName As String = assemblyDoc.FullFileName
Dim assemblyLocation As String = System.IO.Path.GetDirectoryName(assemblyFileName)
' Get the part number of the original part
Dim partNumber As String = oCompOcc.Definition.Document.PropertySets.Item("Design Tracking Properties").Item("Part Number").Value
' Get active assembly document
Dim oDoc As AssemblyDocument
oDoc = ThisApplication.ActiveDocument
' Create a browser folder with the part number and get the folder object
Dim oFolder As BrowserFolder
oFolder = CreateBrowserFolder(oDoc, partNumber)
' Get the browser pane
Dim oPane As BrowserPane = oDoc.BrowserPanes.ActivePane
' Main loop for repeating the process
Do
' Prompt the user to select a work point for mate constraint
Dim oWorkPoint As Object
oWorkPoint = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kWorkPointFilter, "Select a work point for mate constraint or press Esc to exit")
If oWorkPoint Is Nothing Then
' User pressed Esc, exit the loop
Exit Do
End If
' Add selected assembly as a component to the active assembly
Dim oCompDef As ComponentDefinition
oCompDef = oDoc.ComponentDefinition
' Duplicate the selected occurrence (oCompOcc)
Dim oDuplicateOcc As ComponentOccurrence
oDuplicateOcc = DuplicateOccurrence(oCompOcc, oCompDef)
' Add angle constraints between oCompOcc and oDuplicateOcc
Call ApplyAngleConstraints(oCompOcc, oDuplicateOcc, oDoc.ComponentDefinition, 0)
' Move the duplicate occurrence to the new folder
If oFolder IsNot Nothing Then
Call AddtoFolder(oFolder, oDuplicateOcc, oPane)
End If
' Find sheet metal suboccurrence and add mate constraint
Dim constraintAdded As Boolean = AddMateConstraintToSheetMetalOrigin(oDoc, oDuplicateOcc, oWorkPoint)
If Not constraintAdded Then
' If constraint wasn't added, exit the loop
Exit Do
End If
Loop
' Save the document to update changes
oDoc.Save()
MsgBox("Process completed. Document saved.", vbInformation)
End Sub
Function DuplicateOccurrence(sourceOcc As ComponentOccurrence, compDef As ComponentDefinition) As ComponentOccurrence
Dim oTrans As Transaction = Nothing
Dim oDuplicateOcc As ComponentOccurrence = Nothing
Try
oTrans = ThisApplication.TransactionManager.StartTransaction(compDef.Document, "Duplicate Occurrence")
' Create a matrix for positioning the duplicate occurrence
Dim oMatrix As Matrix = ThisApplication.TransientGeometry.CreateMatrix
oMatrix.SetToIdentity()
' Get existing occurrence names in the assembly
Dim existingNames As New List(Of String)
For Each occ As ComponentOccurrence In compDef.Occurrences
existingNames.Add(occ.Name)
Next
' Determine the new name for the duplicate occurrence
Dim baseName As String = sourceOcc.Name & "-COPY-001"
Dim newName As String = baseName
Dim count As Integer = 1
Do While existingNames.Contains(newName)
count += 1
newName = baseName.Substring(0, baseName.Length - 4) & "-" & count.ToString("000")
Loop
' Add the duplicate occurrence
oDuplicateOcc = compDef.Occurrences.Add(sourceOcc.Definition.Document.FullFileName, oMatrix)
' Set BOM structure to reference
oDuplicateOcc.BOMStructure = BOMStructureEnum.kReferenceBOMStructure
' Set the unique name
oDuplicateOcc.Name = newName
oTrans.End()
Catch ex As Exception
If Not oTrans Is Nothing Then
oTrans.Abort()
End If
MessageBox.Show("Error duplicating occurrence: " & ex.Message, "Error")
End Try
Return oDuplicateOcc
End Function
Sub ApplyAngleConstraints(O1 As ComponentOccurrence, O2 As ComponentOccurrence, aCD As ComponentDefinition, angleValue As Double)
On Error GoTo EER
Dim oTrans As Transaction = ThisApplication.TransactionManager.StartTransaction(aCD.Document, "Constraint Creation")
' Setup Proxies
Dim wPlane1 As WorkPlaneProxy
Dim wPlane2 As WorkPlaneProxy
' Run for 3 origin planes
For i = 1 To 3
O1.CreateGeometryProxy(O1.Definition.WorkPlanes.Item(i), wPlane1)
O2.CreateGeometryProxy(O2.Definition.WorkPlanes.Item(i), wPlane2)
' Create angle constraint
Dim angleConst As AngleConstraint = aCD.Constraints.AddAngleConstraint(wPlane1, wPlane2, angleValue)
Next
oTrans.End
Exit Sub
EER:
oTrans.Abort
End Sub
Function CreateBrowserFolder(oDoc As Document, folderName As String) As BrowserFolder
Dim oPane As BrowserPane = oDoc.BrowserPanes.ActivePane
Dim oTopNode As BrowserNode = oPane.TopNode
Dim oFolder As BrowserFolder = Nothing
' Try to find the folder, if it doesn't exist, create it
Try
oFolder = oTopNode.BrowserFolders.Item(folderName)
Catch
oFolder = oPane.AddBrowserFolder(folderName)
End Try
Return oFolder
End Function
Sub AddtoFolder(oFolder As BrowserFolder, oSelectedEntity As Object, oPane As BrowserPane)
Dim oNode As BrowserNode
' Add the selected component to the folder
If TypeOf oSelectedEntity Is ComponentOccurrence Then
Dim oOcc As ComponentOccurrence
oOcc = oSelectedEntity
oNode = oPane.GetBrowserNodeFromObject(oOcc)
oFolder.Add(oNode)
End If
End Sub
Function AddMateConstraintToSheetMetalOrigin(oDoc As AssemblyDocument, oDuplicateOcc As ComponentOccurrence, oWorkPoint As Object) As Boolean
Dim oTrans As Transaction = Nothing
Try
oTrans = ThisApplication.TransactionManager.StartTransaction(oDoc, "Add Mate Constraint to Sheet Metal Origin")
' Find the sheet metal suboccurrence
Dim oSheetMetalOcc As ComponentOccurrence = FindSheetMetalSuboccurrence(oDuplicateOcc)
If oSheetMetalOcc Is Nothing Then
MsgBox("No sheet metal suboccurrence found in the duplicated assembly.")
oTrans.End()
Return False
End If
' Get the origin work point of the sheet metal occurrence
Dim oOriginWorkPoint As WorkPoint
oOriginWorkPoint = oSheetMetalOcc.Definition.WorkPoints.Item(1) ' Assuming the first work point is the origin
' Create a proxy for the origin work point
Dim oOriginProxy As WorkPointProxy
oSheetMetalOcc.CreateGeometryProxy(oOriginWorkPoint, oOriginProxy)
' Add mate constraint
Dim oConstraints As AssemblyConstraints = oDoc.ComponentDefinition.Constraints
oConstraints.AddMateConstraint(oWorkPoint, oOriginProxy, 0)
oTrans.End()
Return True
Catch ex As Exception
If Not oTrans Is Nothing Then
oTrans.Abort()
End If
MsgBox("Error adding mate constraint: " & ex.Message)
Return False
End Try
End Function
Function FindSheetMetalSuboccurrence(oOcc As ComponentOccurrence) As ComponentOccurrence
' Check if the current occurrence is a sheet metal part
If TypeOf oOcc.Definition Is SheetMetalComponentDefinition Then
Return oOcc
End If
' If not, search through suboccurrences
For Each subOcc As ComponentOccurrence In oOcc.SubOccurrences
Dim result As ComponentOccurrence = FindSheetMetalSuboccurrence(subOcc)
If result IsNot Nothing Then
Return result
End If
Next
' If no sheet metal suboccurrence is found, return Nothing
Return Nothing
End Function
Hi @HogueOne
If you have a sequence that works once and you want it to repeat you will need some sort of loop and release for the user to end when they need to. This can be done with a message box and conditions to exit the loop. I suggest you start looking at these tools. There are many on this forum. While AI tools can be powerful, they can leave holes in basic steps the coder should be able to do if they learned the basics.
If you have trouble implementing a loop one conditions attach them as a question.
Can't find what you're looking for? Ask the community or share your knowledge.