Duplicate Occurrence with Sketch Driven Pattern

HogueOne · ‎07-19-2024

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

A.Acheson · ‎07-23-2024

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.

If this solved a problem, please click (accept) as solution.‌‌‌‌
Or if this helped you, please, click (like)‌‌
Regards
Alan

Community

Duplicate Occurrence with Sketch Driven Pattern

Duplicate Occurrence with Sketch Driven Pattern

Duplicate Occurrence with Sketch Driven Pattern