solidworks 批量执行宏

knight3732449

观摩一下

受伤的仙人球

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

kbisi

Dim swApp As Object
Dim Part As Object
Dim sldPath As String

9 ~1 [- Z0 I+ bDim boolstatus As Boolean
, C* a3 \! q" r  I! t0 S+ bDim longstatus As Long, longwarnings As Long




0 D' D/ A$ q/ t4 \: D. l+ [# N3 HSub Test()
Set swApp = Application.SldWorks
8 q9 V3 u; P7 _6 c! A" [sldPath = "C:\Users\kbisi\Desktop\实验\" '设定目录
6 N* J2 W; G4 ~9 T- D; W; _
! _0 W) v% n* [9 PswFileName = Dir(sldPath & "*.sld*")  '搜寻首个零件档案名称
If UCase(Right(swFileName, 3)) = "PRT" Then swFileTYpe = 1
If UCase(Right(swFileName, 3)) = "ASM" Then swFileTYpe = 2
6 m% ]) ?, h6 Y5 {
4 M$ {5 w% X/ }2 p8 M  s; ODo While swFileName <> ""
  ^9 f3 A, l# n% `" Z: A- o
Set swApp = Application.SldWorks

'Set swDoc = swApp.OpenDoc(sldPath & swFileName, swFileTYpe) '开启零件

8 k* _3 h3 _" e* b- mSet swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)
( C  n. I* h. J; @% U7 |) m7 I
) I- q' k; V; C" C3 N
4 m4 Q$ Y8 _/ b* ]

: w* |9 v  r: A* b
" ~. ]+ N4 u- n3 o5 VSet Part = swApp.ActiveDoc

% j* A! Q3 K5 @- ~Call plmain

, ^" f; s$ c- B' c9 `% d* n
'
( l5 ~: @" h. w& b/ E  |

; p1 w/ W, g) G; `- f2 d  n
Part.Save '保存%
+ G( ^1 v  C6 Y6 f; lswApp.CloseDoc (swFileName) '关闭零件

If swFileName = "" Then Exit Do
3 v0 L  Z. A. J9 b2 ?1 r

swFileName = Dir '搜寻下一个零件档案名称0

Loop '循环搜寻
5 H: n  R. V& L8 h6 F/ K# TEnd Sub
8 `+ @2 P* E1 @* u) s/ J( ?按F8一行看程序错误为什么老是跳过Then swFileTYpe = 2

kbisi

Dim swApp As Object
Dim Part As Object
Dim sldPath As String

Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
+ K  r7 g! f/ t% i: O  y' g  w
3 j8 r' _0 W  L. n

. E5 d: |8 E3 n( M; S4 X
, ?( |3 E3 U" E6 }3 y0 Q0 cSub Test()
1 U+ B! u+ y  k9 E% t, VSet swApp = Application.SldWorks
sldPath = "C:\Users\kbisi\Desktop\实验\" '设定目录

1 A: o3 H0 l4 ~6 z! w/ U) SswFileName = Dir(sldPath & "*.sld*")  '搜寻首个零件档案名称
If UCase(Right(swFileName, 3)) = "PRT" Then swFileTYpe = 1
6 V: D  J! I7 B* @If UCase(Right(swFileName, 3)) = "ASM" Then swFileTYpe = 2
! _7 ], R- e. u2 w* z! V& K. F
Do While swFileName <> ""

* l' w+ R# X; YSet swApp = Application.SldWorks

'Set swDoc = swApp.OpenDoc(sldPath & swFileName, swFileTYpe) '开启零件
: p7 J0 [$ {1 m7 s6 ?# ?2 q( }
Set swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)
8 ]' s) ]* {8 P+ W( |6 V. m( g
- u  K0 y  ]5 I
. N6 o( j( E+ A: X: {5 K% `

/ G8 P6 h' D+ ^( d
0 m) n) m( l; PSet Part = swApp.ActiveDoc

( E. ?3 _7 ?, A6 I5 ACall plmain

0 j3 T% [' t, {' w: M5 ]
'

& b- J* x8 j5 q) n  }! v

Part.Save '保存%
* @5 |* ~6 _8 K5 HswApp.CloseDoc (swFileName) '关闭零件

  T( M+ S0 y% _. Y6 {1 CIf swFileName = "" Then Exit Do
( @$ J9 j9 H% X( |6 y1 @

swFileName = Dir '搜寻下一个零件档案名称0

Loop '循环搜寻
End Sub

kbisi

Dim swApp As Object
Dim Part As Object
Dim sldPath As String
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
/ o9 X' I# }* \9 W4 v& u; GSub Test()
6 f* E) O' w; `& zSet swApp = Application.SldWorks
1 Y) y# G# w( m- SsldPath = "C:\Users\kbisi\Desktop\实验\" '设定目录
swFileName = Dir(sldPath & "*.sld*")  '搜寻首个零件档案名称
If UCase(Right(swFileName, 3)) = "PRT" Then swFileTYpe = 1
7 C. D0 j: @" I0 s  A, lIf UCase(Right(swFileName, 3)) = "ASM" Then swFileTYpe = 2
Do While swFileName <> ""
3 [. F5 o* v6 M/ R9 i5 I& V. ESet swApp = Application.SldWorks
( N! ~4 c' M* z7 T'Set swDoc = swApp.OpenDoc(sldPath & swFileName, swFileTYpe) '开启零件
Set swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)
Set Part = swApp.ActiveDoc
7 S- O8 W/ F' U+ ?# L; LCall plmain
Part.Save '保存%
0 q, M" c7 f: W* w( I% `! o5 @8 vswApp.CloseDoc (swFileName) '关闭零件
If swFileName = "" Then Exit Do
swFileName = Dir '搜寻下一个零件档案名称0
Loop '循环搜寻
End Sub   老是被跳过

kbisi

kbisi 发表于 2021-11-28 10:05
Dim swApp As Object
) F5 O: y7 b6 j+ W0 zDim Part As Object
) K8 P( Y+ I2 @6 Z- Y. pDim sldPath As String

- F( E. b2 {; E  M希望可以得到解答

kbisi

kbisi 发表于 2021-11-28 10:05
7 i( G: k; d. u7 Z& D% d1 BDim swApp As Object
0 J& b, i+ ]% m# b* S. G0 u3 JDim Part As Object
Dim sldPath As String

: K$ T: x- `  P' C- A; G2 `和楼主一样打不开装配体

357755306b

多少积分可以分享

xinshiji666

kbisi 发表于 2021-11-28 13:44
希望可以得到解答

1 r( E! P2 _& H! \  I! v4 l  H' P无法打开装配体文件，是因为你把文件类型判定的语句放在循环外了，挪到do...loop内即可，那个call语句调用了什么？用不上可以先屏蔽。
8 S1 B. j* u1 D经过测试，下面的程序可正常打开零件和装配体

' ******************************************************************************
: K2 j5 W4 j+ e, v8 _! R6 V2 X' 读取指定目录下的Prt/asm文件，关闭
6 S; k+ L/ y2 L* i7 o/ r, w, k' ******************************************************************************
8 H# n5 {8 d+ Z+ ZDim swApp As Object
3 m3 ]0 T9 F# f1 [% M
Dim Part As Object
Dim boolstatus As Boolean
! o) m6 @& i- f  f- z' JDim longstatus As Long, longwarnings As Long
'Dim sldPath As String
Const sldPath As String = "E:\3Dtest\BOM1\"  '设定目录

( ~5 |4 Y- j8 B/ ~Sub main()
$ x- c. c0 @$ b3 P3 R. ?) j, p
/ R# J+ H0 c" c1 J    Set swApp = _
    Application.SldWorks
9 ^" i" V2 ]' G6 F    Set Part = swApp.ActiveDoc
        
2 l9 v, I! ^: C! @1 R    swFileName = Dir(sldPath & "*.sld*")
/ j2 K, C9 J% n' P+ f
. }4 Z3 S" C8 T  Q    Do While swFileName <> ""
' H# R- n. G+ t4 L6 R9 e0 j        Set swApp = Application.SldWorks
' Z& y9 x3 V" k+ K, I' k        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)
' d* w5 }0 h0 [5 G2 |) d- l        Set Part = swApp.ActiveDoc
        'Call plmain
        'Part.Save '保存
: }% b2 c* i6 S6 g        swApp.CloseDoc (swFileName) '关闭零件
        If swFileName = "" Then Exit Do:
        swFileName = Dir '搜寻下一个零件档案名称
    Loop '循环搜寻
/ ^; M4 n4 ^! A) K7 |6 L
8 L1 [& p4 Q( ^1 J- D7 d# yEnd Sub
! L4 K$ M: O; g, f9 ]# z
, B8 u3 V  @1 Z! h$ x
" U; k& T+ @+ p& }" i3 T

Ali.

能提供你成功运行的一个代打为参考吗我的一直报错
( u, D  r6 `, x. P. o" r
9 k2 K* C9 Y$ b4 \1 b; K