温馨提示:本文翻译自stackoverflow.com,查看原文请点击:vba - Saving all parts in an assembly as STEP with custom properties. How to solve run-time error 91?

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

发布于 2020-03-27 15:59:22

我正在尝试使用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

查看更多

查看更多

提问者
Jesper K.
被浏览
27
Sinue 2020-01-31 18:55

被抑制的组件并不是您在调用OpenDoc后一无所获的唯一原因。例如,如果该组件轻量级加载或未完全加载,则会发生这种情况。然后,您也将无法获取组件对象的ModelDoc(PartDoc)数据。

为了完全避免这种情况,只有在swPart变量不是空时才可以执行下几行。

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

另外,我可以说您不一定需要使用OpenDoc / CloseDoc,因为在加载程序集时该组件已被加载到内存中。因此,调用子组件的GetModelDoc2就足够了但是最后,它具有相同的行为,如果组件未完全加载,则不会返回任何内容。

set swPart = swChildcomp.GetModelDoc2()

发布
问题

分享
好友

手机
浏览

扫码手机浏览