SolidWorks 新・遍历装配体（VBA）

'遍历装配体
Sub TraverseComponent(swComp As SldWorks.Component2)
    Dim vChildComp As Variant
    Dim swChildComp As SldWorks.Component2
    Dim i As Long

    vChildComp = swComp.GetChildren
    For i = 0 To UBound(vChildComp)
        Set swChildComp = vChildComp(i)
        Debug.Print swChildComp.Name2
        TraverseComponent swChildComp
    Next i
End Sub

Option Explicit

Sub main()

    '施法前摇
    Dim swApp As SldWorks.SldWorks
    Dim swModel As SldWorks.ModelDoc2
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc

    If swModel.GetType <> SwConst.swDocASSEMBLY Then
        swApp.SendMsgToUser "请在装配体中运行"
        Exit Sub
    End If

    '遍历装配（使用字典去除重复出现的零部件名）
    Dim swConfMgr As SldWorks.ConfigurationManager
    Dim swConf As SldWorks.Configuration
    Dim swRootComp As SldWorks.Component2
    Dim dict As Object
    Set dict = CreateObject("Scripting.Dictionary")
    Set swConfMgr = swModel.ConfigurationManager
    Set swConf = swConfMgr.ActiveConfiguration
    Set swRootComp = swConf.GetRootComponent3(True)
    Debug.Print "File = " & swModel.GetPathName
    If swModel.GetType = SwConst.swDocASSEMBLY Then
        TraverseComponent swRootComp, dict
    End If
    '增加顶层装配体
    dict(Left(swModel.GetTitle, InStrRev(swModel.GetTitle, ".") - 1)) = ""
End Sub

'遍历装配体
Sub TraverseComponent(swComp As SldWorks.Component2)
    Dim vChildComp As Variant
    Dim swChildComp As SldWorks.Component2
    Dim i As Long

    vChildComp = swComp.GetChildren
    For i = 0 To UBound(vChildComp)
        Set swChildComp = vChildComp(i)
        '零件名
        dict(TrueName(swChildComp.Name2)) = ""
        '装配体名
        dict(TrueName(swComp.Name2)) = ""
        TraverseComponent swChildComp, dict
    Next i
End Sub

'获取真实零部件名
Function TrueName(longname As String)
    '获取最后一个/后面的零件名
    If InStr(longname, "/") > 0 Then
        Dim tmp As Variant
        tmp = Split(longname, "/")
        tmp = tmp(UBound(tmp))
        TrueName = Left(tmp, InStrRev(tmp, "-") - 1)
    Else
        '这里暂时没想到更好的方法
        TrueName = IIf(InStr(Right(longname, 3), "-"), _
                       Left(longname, InStrRev(longname, "-") - 1), _
                       longname)
    End If

End Function