solidworks 批量执行宏

knight3732449 · 发表于 2021-7-15 19:53:30

观摩一下

受伤的仙人球 · 发表于 2021-9-29 15:35:14

有个使用场景，现在我使用的图号分离宏需要打开零件才能进行属性修改，每次在装配体里多修改几个零件名称或者新做零件就会忘了改属性，如果可以批量打开零件，然后中间插入执行图号分离宏的工具执行，就可以自动帮我一次性修改零件属性了（但是俺不会写，有没有大佬帮帮忙呜呜呜）

kbisi · 发表于 2021-11-28 10:05:46

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

kbisi · 发表于 2021-11-28 10:06:58

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:12:10

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 13:44:09

kbisi 发表于 2021-11-28 10:05
* l+ e! Y3 y0 Q7 p+ Q! wDim swApp As Object& W1 i: j8 }- p8 A! F; {
Dim Part As Object# Y* ~' H* d8 n# P V( ^! o
Dim sldPath As String

希望可以得到解答

kbisi · 发表于 2021-11-28 13:45:15

kbisi 发表于 2021-11-28 10:057 D9 w" f, L% ^6 K+ D
Dim swApp As Object
( J% B( i! U5 u3 U' T8 w! n- l- XDim Part As Object6 _" X: g" g' j3 h$ x; Q# q
Dim sldPath As String

和楼主一样打不开装配体

357755306b · 发表于 2022-2-10 23:22:01

多少积分可以分享

xinshiji666 · 发表于 2022-2-18 10:31:55

kbisi 发表于 2021-11-28 13:44
" n8 @9 J$ E+ I* ]希望可以得到解答

无法打开装配体文件，是因为你把文件类型判定的语句放在循环外了，挪到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

Ali. · 发表于 2024-1-7 12:50:21

能提供你成功运行的一个代打为参考吗我的一直报错

		自动登录	找回密码
密码			注册会员