API: обход дерева сборки и доступ к значениям параметров каждой детали

Public Sub SetParameter()
' Get the Parameters
object. Assumes a part or assembly document is active.
Dim oParameters As Parameters
Set oParameters = ThisApplication.ActiveDocument.ComponentDefinition.Parameters
' Get the parameter named "Length".
Dim oLengthParam As Parameter
Set
oLengthParam = oParameters.Item("Length")
' Change the equation of the parameter.
oLengthParam.Expression = "3.5 in"
' Upd ate the document.
ThisApplication.ActiveDocument.Update
End Sub

Public Sub GetParameters()
' Get the Parameters object. This uses error handling and will only be successful
' if a part or assembly document is active.
Dim oParameters As Parameters
On Error Resume Next
Se t oParameters = ThisApplication.ActiveDocument.ComponentDefinition.Parameters
If Err Then
' Unable to get the Parameters object, so exit.
MsgBox "Unable to access the parameters. A part or assembly must be active."
Exit Sub
End If
On Error Goto 0
' Do something with the Parameters object.
MsgBox "The document has " & oParameters.Count & " parameters in it."
End Sub

Public Sub AssemblyTraversal()
    Dim oAsmDoc As AssemblyDocument
    Set oAsmDoc = ThisApplication.ActiveDocument
    
    ' Начинаем обход сборки
    Call TraverseAsm(oAsmDoc.ComponentDefinition.Occurrences, 1)
End Sub

Private Sub TraverseAsm(oOccurrences As ComponentOccurrences, Level As Integer)
    ' перебор списка компонентов на текущем уровне иерархии.
    Dim oOcc As ComponentOccurrence
        For Each oOcc In oOccurrences
      
        Dim oParameters As Parameters
        Set oParameters = oOcc.DefinitionReference.ReferencedDefinition.ComponentDefinition.Parameters
        Dim xPar As Parameter
        Set xPar = oParameters.Item("d_1")
        
        MsgBox (Level & ": " & oOcc.Name & "  d_1=" & xPar)
        
        Dim oMassParam As Parameter
        Set oMassParam = oParameters.Item("d1")
        

        If oOcc.DefinitionDocumentType = kAssemblyDocumentObject Then
            Call TraverseAsm(oOcc.SubOccurrences, Level + 1)
        End If
    Next
End Sub

Dim t1 As TextStream
Public Sub AssemblyTraversal()
    Dim f1 As New FileSystemObject
    
    Dim oAsmDoc As AssemblyDocument
    Set oAsmDoc = ThisApplication.ActiveDocument
    
    Dim sf As String
    sf = "D:\\Data.csv"
    Set t1 = f1.CreateTextFile(sf, ForWriting)
    
    Dim oBOM As BOM
    Set oBOM = oAsmDoc.ComponentDefinition.BOM
    Dim oBOMView As BOMView
    Set oBOMView = oBOM.BOMViews.Item(1)
    
    Call TraverseAsm(oBOMView.BOMRows, 1)
    
    t1.Close
End Sub
Private Sub TraverseAsm(oRows As BOMRowsEnumerator, Level As Integer)
    Dim oRow As BOMRow
    Dim st As String
    For Each oRow In oRows
        If Not oRow.ChildRows Is Nothing Then
            Call TraverseAsm(oRow.ChildRows, Level + 1)
        Else
            Dim oCompDef As ComponentDefinition
            Set oCompDef = oRow.ComponentDefinitions.Item(1)
            If Not TypeOf oCompDef Is VirtualComponentDefinition Then
                Dim par As Parameter
                st = ""
                For Each par In oCompDef.Parameters
                    If par.Name = "d1" Or par.Name = "d2" Or par.Name = "d3" Then
                        st = st & ";" & par.Name & ";" & par.Value
                    End If
                Next
                    t1.WriteLine Level & ";" & oCompDef.Document.DisplayName & st
            End If
        End If
    Next
End Sub