solidworks 批量执行宏

knight3732449

观摩一下

受伤的仙人球

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

kbisi

Dim swApp As Object
: @7 W3 }7 P0 }4 y/ b8 NDim Part As Object
" y: f/ [% T$ J4 i9 c6 IDim sldPath As String
. x  H& I% S8 v" P/ q9 ?
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long

" |! r) d( w& b5 i: J0 N; t; i

* D! X" O8 g# B$ R( \. L; I
Sub Test()
Set swApp = Application.SldWorks
" m1 M! ]- h+ c1 m6 Q; |/ _9 V' xsldPath = "C:\Users\kbisi\Desktop\实验\" '设定目录
8 i$ c/ }3 o* i
+ [* s( S: R% o" r. k9 x- E5 @swFileName = Dir(sldPath & "*.sld*")  '搜寻首个零件档案名称
If UCase(Right(swFileName, 3)) = "PRT" Then swFileTYpe = 1
* l& {6 `8 Z+ v7 h2 k9 XIf UCase(Right(swFileName, 3)) = "ASM" Then swFileTYpe = 2

# h1 ?, t; W+ o/ ]Do While swFileName <> ""
/ l/ r: a$ I- X8 `8 K0 T
Set swApp = Application.SldWorks
  \8 F1 N& C: S$ a/ W/ V
'Set swDoc = swApp.OpenDoc(sldPath & swFileName, swFileTYpe) '开启零件
' h: t( D9 J" D& L' |* a
Set swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)
" Q- ?& j: e. M3 |; Z8 |6 {
; {' M' |/ |- e" |2 K$ Z  v
9 ?9 X+ V( O, y7 ^: u; e! O


Set Part = swApp.ActiveDoc
4 x- o7 u- x+ y' N7 F& p
% x: o1 M: ?4 d! a! @0 m' m" BCall plmain
8 D) o* ^3 U2 G! Q
+ J! C2 z5 r- D8 s  v" T! ?6 g6 u6 V
2 u. ^0 u2 h2 U'

" c3 A# r7 A$ }, Q

Part.Save '保存%
) G* r2 C  z5 x6 k0 J- c4 I9 {swApp.CloseDoc (swFileName) '关闭零件
1 @- x3 R) T5 o
5 w3 s4 h9 U* d- uIf swFileName = "" Then Exit Do
. b- ^* F2 M* s! l0 s+ i
; `8 n1 h/ `& A- _  p- m7 d
swFileName = Dir '搜寻下一个零件档案名称0

& {* m0 f& S2 Z+ }: M* \6 l1 uLoop '循环搜寻
End Sub
! y2 P, A: a6 d9 B8 F按F8一行看程序错误为什么老是跳过Then swFileTYpe = 2

kbisi

Dim swApp As Object
/ g3 u  w' n7 L: gDim Part As Object
. X% X" @! c, R/ c% K1 [, K+ mDim sldPath As String

Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long

) B) ^" c( x$ r/ a9 c( m

( P4 i" P- Q  r+ j# X0 f5 Q  e
$ ^- [5 i3 J6 l" R! }1 G+ \' ISub Test()
Set swApp = Application.SldWorks
sldPath = "C:\Users\kbisi\Desktop\实验\" '设定目录

$ Q" j+ O! q" I3 w  Z  O. fswFileName = Dir(sldPath & "*.sld*")  '搜寻首个零件档案名称
If UCase(Right(swFileName, 3)) = "PRT" Then swFileTYpe = 1
+ b* s7 g4 G7 ]/ B% ~( ]If UCase(Right(swFileName, 3)) = "ASM" Then swFileTYpe = 2
5 p. T4 d' m7 }$ j# [& w* d9 v
, k( \4 C) M' ?- kDo While swFileName <> ""

1 v5 b# c2 X( Z4 }+ hSet swApp = Application.SldWorks

2 K- Q) [9 m8 ]: m6 H'Set swDoc = swApp.OpenDoc(sldPath & swFileName, swFileTYpe) '开启零件
: r* D  ^$ _7 C8 F) Y, @. y/ C
Set swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)
2 x1 v1 i. M' {( m
/ U* h; u  {3 [8 P2 e( q



1 p, `9 I2 t" z4 P% eSet Part = swApp.ActiveDoc
# u: o" o+ r" T
Call plmain
4 a2 t+ w1 f" ^1 F* c$ F/ [( d# p0 l
9 ~/ D, P' V- c* A. ?3 ^
'
; Q( ~( F( V, e3 X9 m$ l4 f


Part.Save '保存%
$ m2 Y; a1 x  WswApp.CloseDoc (swFileName) '关闭零件
& ]  j1 b6 w8 R4 A9 J: o. _! H4 \
! ]: e2 z, E9 }' nIf swFileName = "" Then Exit Do
9 B( c7 }& h, V9 P, I9 h1 k2 _
- \) H. Y' H4 G* U* O- w$ e; c
swFileName = Dir '搜寻下一个零件档案名称0

Loop '循环搜寻
1 s3 n6 `, F0 f% gEnd Sub

kbisi

Dim swApp As Object
Dim Part As Object
/ {6 S/ ]6 U6 S: _# K/ R, GDim sldPath As String
7 b8 Q! b* q' w3 u0 U1 BDim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Sub Test()
Set swApp = Application.SldWorks
9 a, h  t6 D* B* e. f, e9 S6 ZsldPath = "C:\Users\kbisi\Desktop\实验\" '设定目录
swFileName = Dir(sldPath & "*.sld*")  '搜寻首个零件档案名称
$ I5 D. s& r8 v0 V/ OIf UCase(Right(swFileName, 3)) = "PRT" Then swFileTYpe = 1
( X& X; q+ l$ f& ~8 M' B- U+ zIf UCase(Right(swFileName, 3)) = "ASM" Then swFileTYpe = 2
Do While swFileName <> ""
Set swApp = Application.SldWorks
8 L% [( E8 O$ ?! g. }% o'Set swDoc = swApp.OpenDoc(sldPath & swFileName, swFileTYpe) '开启零件
# C2 {; Y7 Z- H. OSet swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)
Set Part = swApp.ActiveDoc
Call plmain
2 v1 F- i# Z: X2 sPart.Save '保存%
swApp.CloseDoc (swFileName) '关闭零件
If swFileName = "" Then Exit Do
swFileName = Dir '搜寻下一个零件档案名称0
Loop '循环搜寻
) }: a5 g3 w9 u- ^$ H4 v+ a. vEnd Sub   老是被跳过

kbisi

kbisi 发表于 2021-11-28 10:05
Dim swApp As Object
Dim Part As Object
6 A3 y! w+ H/ C: fDim sldPath As String

" w$ ?' \7 p: N1 l5 C希望可以得到解答
  X2 ~" l) Z3 N7 L

kbisi

kbisi 发表于 2021-11-28 10:05
Dim swApp As Object
Dim Part As Object
Dim sldPath As String

和楼主一样打不开装配体
8 S6 O% t. Y; p5 l9 o

357755306b

多少积分可以分享

xinshiji666

kbisi 发表于 2021-11-28 13:44
; E  S6 g1 r' q! T& q. W$ K* E希望可以得到解答

无法打开装配体文件，是因为你把文件类型判定的语句放在循环外了，挪到do...loop内即可，那个call语句调用了什么？用不上可以先屏蔽。
. _3 Y. Q, _; _8 t. z; h6 J$ ?. N经过测试，下面的程序可正常打开零件和装配体

' ******************************************************************************
' 读取指定目录下的Prt/asm文件，关闭
9 W" Q5 ]6 `# W+ v* I' B' ******************************************************************************
Dim swApp As Object

Dim Part As Object
2 L0 j2 D+ C2 `Dim boolstatus As Boolean
1 @, p7 P$ v$ e+ _7 y* WDim longstatus As Long, longwarnings As Long
'Dim sldPath As String
. Z2 k" t- J, [( v) ?( Z6 BConst sldPath As String = "E:\3Dtest\BOM1\"  '设定目录

3 h/ n2 D# m  G6 N- V" I# lSub main()

    Set swApp = _
: ?5 Z  F8 l% L" G    Application.SldWorks
! }3 _8 n# f" L2 j2 {! H, D    Set Part = swApp.ActiveDoc
5 U* u. b3 S3 e9 h" ?/ f        
    swFileName = Dir(sldPath & "*.sld*")

$ }, s( y+ i" |1 m6 j- P& D4 _    Do While swFileName <> ""
" T& ^& u3 i$ i! C! E, M        Set swApp = Application.SldWorks
        If UCase(Right(swFileName, 3)) = "PRT" Then swFileTYpe = 1
1 i( X0 h. W1 q        If UCase(Right(swFileName, 3)) = "ASM" Then swFileTYpe = 2

7 w* _- D9 W, u/ g! V; F0 e        Set swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)
0 v# }% t0 c+ I+ T        Set Part = swApp.ActiveDoc
        'Call plmain
* G, c) S0 s6 U5 `9 L8 g" W        'Part.Save '保存
        swApp.CloseDoc (swFileName) '关闭零件
- Y4 J3 I/ F2 ], [* \        If swFileName = "" Then Exit Do:
( n2 P$ j+ ~2 f        swFileName = Dir '搜寻下一个零件档案名称
    Loop '循环搜寻
/ E5 K* U" Y, Z) V
8 w) d/ l, Q4 Z0 f; e; GEnd Sub

Ali.

能提供你成功运行的一个代打为参考吗我的一直报错
: ?# x6 O3 K$ H9 G" V+ a
* o1 g0 p1 Y8 T* f) L/ l