我正在尝试使用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
答案 0 :(得分:4)
受抑制的组件并不是您在调用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()