将装配体中的所有零件保存为具有自定义属性的 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()
我正在尝试在 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()