将装配体中的所有零件保存为具有自定义属性的 STEP。如何解决运行-time error 91?

Saving all parts in an assembly as STEP with custom properties. How to solve run-time error 91?

我正在尝试在 Solidworks 中使用 VBA 编写一个宏,它将遍历所有子组件并将每个零件保存为 STEP 文件,其中名称由自定义 属性 确定.我没有太多的编程经验,因为我是一名机械工程师,但我不时尝试自动化一些流程。大部分代码是我从别人那里得到的,我试图根据我的情况对其进行调整。不过,我确实了解大部分情况。

我遇到的问题是我一直收到

91 runtime error

当我调试 Solidworks 时,告诉我问题出在 name = swPart.GetTitle 行。起初它说 "name = nothing"。我试着寻找问题,当我将 Set swApp = Application.SldWorks 添加到 sub 时,我仍然收到错误,但现在名称总是 something.

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

被抑制的组件并不是您在调用 OpenDoc 后获得 "nothing" 的唯一原因。这发生在例如如果组件加载轻或未完全加载。那么您也无法获取组件对象的 ModelDoc (PartDoc) 数据。

为了完全防止这种情况发生,您可以仅在 swPart 变量不是空的情况下执行下一行。

If (Not swPart Is Nothing) Then 
    name = swPart.GetTitle 'get the title of the active document
    ...
End If

此外,我可以说您不一定需要使用 OpenDoc/CloseDoc,因为在加载程序集时组件已经加载到内存中。因此调用子组件的 GetModelDoc2 就足够了。但最终它具有相同的行为,并且如果组件未完全加载,则 return 什么也不会。

set swPart = swChildcomp.GetModelDoc2()