观摩一下
有个使用场景，现在我使用的图号分离宏需要打开零件才能进行属性修改，每次在装配体里多修改几个零件名称或者新做零件就会忘了改属性，如果可以批量打开零件，然后中间插入执行图号分离宏的工具执行，就可以自动帮我一次性修改零件属性了（但是俺不会写，有没有大佬帮帮忙呜呜呜）
Dim swApp As Object
Dim Part As Object
Dim sldPath As String
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Sub Test()
Set swApp = Application.SldWorks
sldPath = "C:\Users\kbisi\Desktop\实验\" '设定目录
swFileName = Dir(sldPath & "*.sld*")'搜寻首个零件档案名称
If UCase(Right(swFileName, 3)) = "PRT" Then swFileTYpe = 1
If UCase(Right(swFileName, 3)) = "ASM" Then swFileTYpe = 2
Do While swFileName <> ""
Set swApp = Application.SldWorks
'Set swDoc = swApp.OpenDoc(sldPath & swFileName, swFileTYpe) '开启零件
Set swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)
Set Part = swApp.ActiveDoc
Call plmain
'
Part.Save '保存%
swApp.CloseDoc (swFileName) '关闭零件
If swFileName = "" Then Exit Do
swFileName = Dir '搜寻下一个零件档案名称0
Loop '循环搜寻
End Sub
按F8一行看程序错误为什么老是跳过Then swFileTYpe = 2
Dim swApp As Object
Dim Part As Object
Dim sldPath As String
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Sub Test()
Set swApp = Application.SldWorks
sldPath = "C:\Users\kbisi\Desktop\实验\" '设定目录
swFileName = Dir(sldPath & "*.sld*")'搜寻首个零件档案名称
If UCase(Right(swFileName, 3)) = "PRT" Then swFileTYpe = 1
If UCase(Right(swFileName, 3)) = "ASM" Then swFileTYpe = 2
Do While swFileName <> ""
Set swApp = Application.SldWorks
'Set swDoc = swApp.OpenDoc(sldPath & swFileName, swFileTYpe) '开启零件
Set swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)
Set Part = swApp.ActiveDoc
Call plmain
'
Part.Save '保存%
swApp.CloseDoc (swFileName) '关闭零件
If swFileName = "" Then Exit Do
swFileName = Dir '搜寻下一个零件档案名称0
Loop '循环搜寻
End Sub
Dim swApp As Object
Dim Part As Object
Dim sldPath As String
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Sub Test()
Set swApp = Application.SldWorks
sldPath = "C:\Users\kbisi\Desktop\实验\" '设定目录
swFileName = Dir(sldPath & "*.sld*")'搜寻首个零件档案名称
If UCase(Right(swFileName, 3)) = "PRT" Then swFileTYpe = 1
If UCase(Right(swFileName, 3)) = "ASM" Then swFileTYpe = 2
Do While swFileName <> ""
Set swApp = Application.SldWorks
'Set swDoc = swApp.OpenDoc(sldPath & swFileName, swFileTYpe) '开启零件
Set swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)
Set Part = swApp.ActiveDoc
Call plmain
Part.Save '保存%
swApp.CloseDoc (swFileName) '关闭零件
If swFileName = "" Then Exit Do
swFileName = Dir '搜寻下一个零件档案名称0
Loop '循环搜寻
End Sub 老是被跳过
kbisi 发表于 2021-11-28 10:05
Dim swApp As Object
Dim Part As Object
Dim sldPath As String
希望可以得到解答
kbisi 发表于 2021-11-28 10:05
Dim swApp As Object
Dim Part As Object
Dim sldPath As String
和楼主一样打不开装配体
多少积分可以分享
kbisi 发表于 2021-11-28 13:44
希望可以得到解答
无法打开装配体文件，是因为你把文件类型判定的语句放在循环外了，挪到do...loop内即可，那个call语句调用了什么？用不上可以先屏蔽。
经过测试，下面的程序可正常打开零件和装配体
' ******************************************************************************
' 读取指定目录下的Prt/asm文件，关闭
' ******************************************************************************
Dim swApp As Object
Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
'Dim sldPath As String
Const sldPath As String = "E:\3Dtest\BOM1\"'设定目录
Sub main()
Set swApp = _
Application.SldWorks
Set Part = swApp.ActiveDoc
swFileName = Dir(sldPath & "*.sld*")
Do While swFileName <> ""
Set swApp = Application.SldWorks
If UCase(Right(swFileName, 3)) = "PRT" Then swFileTYpe = 1
If UCase(Right(swFileName, 3)) = "ASM" Then swFileTYpe = 2
Set swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)
Set Part = swApp.ActiveDoc
'Call plmain
'Part.Save '保存
swApp.CloseDoc (swFileName) '关闭零件
If swFileName = "" Then Exit Do:
swFileName = Dir '搜寻下一个零件档案名称
Loop '循环搜寻
End Sub
能提供你成功运行的一个代打为参考吗我的一直报错