vba - 使用自定义属性将装配中的所有零件另存为STEP。

我正在尝试使用VBA在Solidworks中编写一个宏，该宏将遍历所有子装配并将每个零件另存为STEP文件，其中名称由自定义属性确定。我是机械工程师，所以我没有太多的编程经验，但是我会不时尝试使某些过程自动化。我从别人那里得到的大部分代码，都想根据自己的情况进行调整。我确实了解大多数情况。

我遇到的问题是我不断收到

91运行时错误

当我去调试时，Solidworks告诉我问题出在行中name = swPart.GetTitle。起初，它说“名称=没有”。我想寻找问题，当我添加Set swApp = Application.SldWorks到潜水艇时，仍然出现错误，但现在名称总是有些东西。

Dim swApp As SldWorks.SldWorks
Dim swAssy As SldWorks.AssemblyDoc
Dim swConf As SldWorks.Configuration
Dim swRootComp As SldWorks.Component2
Dim retVal As Boolean
Dim errors As Long, warnings As Long
Dim revision As String
Dim vaultPath As String
Dim name As String
Dim longstatus As Long, longwarnings As Long

Sub main()

Set swApp = Application.SldWorks
Set swAssy = swApp.ActiveDoc
Set swConf = swAssy.GetActiveConfiguration
Set swRootComp = swConf.GetRootComponent3(True)

vaultPath = "C:\Users\Engineering\Desktop\test\" 'set folder for vault (change this later)

TraverseComponent swRootComp, 1, vaultPath

End Sub

Sub TraverseComponent(swComp As SldWorks.Component2, nLevel As Long, vaultPath As String)
    Dim vChilds As Variant, vChild As Variant
    Dim swChildComp As SldWorks.Component2
    Dim MyString As String
    Dim swCustPropMgr As SldWorks.CustomPropertyManager
    Set swApp = Application.SldWorks
    vChilds = swComp.GetChildren
    For Each vChild In vChilds
        Set swChildComp = vChild
        Dim FileName As String
        FileName = swChildComp.GetPathName
        FileName = Left(FileName, InStr(FileName, ".") - 1)
        FileName = Right(FileName, Len(FileName) - InStrRev(FileName, "\"))
        Debug.Print "Part Name    : " & FileName
        MyString = FileName
        Dim ActiveConfig As String
        ActiveConfig = swChildComp.ReferencedConfiguration
        Debug.Print "Configuration: " & ActiveConfig
        FileName = swChildComp.GetPathName
        If UCase(Right(FileName, 6)) = "SLDPRT" Then
            'MsgBox ("part found")
            Dim swPart As SldWorks.ModelDoc2
            Set swPart = swApp.OpenDoc6(swChildComp.GetPathName, 1, 0, "", longstatus, longwarnings)
            'Dim name As String 'I tried adding this but it made no difference
            name = swPart.GetTitle 'get the title of the active document
            'chop the extension off if present
            If Right(name, 7) = ".SLDPRT" Or Right(name, 7) = ".SLDasm" Then
                name = Left(name, Len(name) - 7)
            End If
            Set swCustPropMgr = swPart.Extension.CustomPropertyManager("") 'get properties
            revision = swCustPropMgr.Get("Revision") 'get revision
            retVal = swApp.SetUserPreferenceIntegerValue(swUserPreferenceIntegerValue_e.swStepAP, 214) 'change the step file options
            'save with revision if present
            If revision = "" Or revision = Null Then
            retVal = swPart.Extension.SaveAs(vaultPath & name & ".step", swSaveAsVersion_e.swSaveAsCurrentVersion, swSaveAsOptions_e.swSaveAsOptions_Silent, Nothing, errors, warnings)
            Else
            retVal = swPart.Extension.SaveAs(vaultPath & name & " - Rev " & revision & ".step", swSaveAsVersion_e.swSaveAsCurrentVersion, swSaveAsOptions_e.swSaveAsOptions_Silent, Nothing, errors, warnings)
            End If
            swApp.CloseDoc swPart.GetTitle
        End If
        Debug.Print
        TraverseComponent swChildComp, nLevel + 1, vaultPath
    Next

End Sub

查看更多