solidworks 批量执行宏

knight3732449

观摩一下

受伤的仙人球

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

kbisi

Dim swApp As Object
Dim Part As Object
2 n/ z. O7 e' U, E6 `" UDim sldPath As String
! e8 X% r( j* Y- ^$ Z
$ V5 K5 z6 p! }" J: ?- V' G' A2 JDim boolstatus As Boolean
3 h  y2 r' L3 n! nDim longstatus As Long, longwarnings As Long



1 Q- T5 K" f) D' x9 W
Sub Test()
' s" d" L5 X" a& E) RSet swApp = Application.SldWorks
( I( W# z/ I9 S* U3 `sldPath = "C:\Users\kbisi\Desktop\实验\" '设定目录
. U8 A2 F4 E7 b% x) B
swFileName = Dir(sldPath & "*.sld*")  '搜寻首个零件档案名称
If UCase(Right(swFileName, 3)) = "PRT" Then swFileTYpe = 1
' Q4 K: k& j% x* iIf UCase(Right(swFileName, 3)) = "ASM" Then swFileTYpe = 2
7 E" J+ d/ m1 g$ W6 E" M2 Q
Do While swFileName <> ""

Set swApp = Application.SldWorks

'Set swDoc = swApp.OpenDoc(sldPath & swFileName, swFileTYpe) '开启零件
# [' j0 j: Z7 A
Set swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)
, R. j  A9 C" ^8 u

4 ^  T5 B7 G) j

! j& `, u, h1 X( E) c! V
* H. S( c( [! C( q& D+ rSet Part = swApp.ActiveDoc

Call plmain


'


0 Q- V6 r8 ?; W' {; l& A( h5 N
Part.Save '保存%
swApp.CloseDoc (swFileName) '关闭零件
4 l9 x: b% g5 `# @3 z( A
6 {; D( P2 }; Z2 O2 D+ mIf swFileName = "" Then Exit Do


. Z$ ?) |! L8 g3 GswFileName = Dir '搜寻下一个零件档案名称0
! x) D5 ]8 o' f. l5 s/ c  U
& x% t6 S+ H# f* m( X% ]  {Loop '循环搜寻
2 f- q" @) S9 j( |7 NEnd Sub
2 D, |  w) _, O' S5 c* S按F8一行看程序错误为什么老是跳过Then swFileTYpe = 2

kbisi

Dim swApp As Object
Dim Part As Object
6 o0 z6 m* b. c: x/ eDim sldPath As String

Dim boolstatus As Boolean
: f. n% J7 ^  O2 ]. ~" JDim longstatus As Long, longwarnings As Long
( W( V( L) d9 Y

1 B1 }* Q7 n0 ]- t/ e
( g  F! f% ~3 g2 Q
! Z4 P, ?) ^! ~1 Z* gSub Test()
9 t5 F; @4 M* c  sSet swApp = Application.SldWorks
sldPath = "C:\Users\kbisi\Desktop\实验\" '设定目录
9 L. E6 b4 U5 m' M
4 i, u# B: h0 k! Y2 p$ vswFileName = Dir(sldPath & "*.sld*")  '搜寻首个零件档案名称
4 q$ F5 H) T3 A* n& IIf UCase(Right(swFileName, 3)) = "PRT" Then swFileTYpe = 1
If UCase(Right(swFileName, 3)) = "ASM" Then swFileTYpe = 2
$ i5 r: h3 U9 f; x
Do While swFileName <> ""
, O& H9 I; {9 d
Set swApp = Application.SldWorks
5 |! q8 d; F: Y! B. G- x. ~
'Set swDoc = swApp.OpenDoc(sldPath & swFileName, swFileTYpe) '开启零件
0 A- p" F& `, A. |& P3 ?
( P3 ]( L, L( k' lSet swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)

2 U4 u+ X, {( G; `) x  ?
  k4 D9 _+ q/ R% G3 l& S4 s, X

: t2 Q7 B: {( c7 i) n
Set Part = swApp.ActiveDoc
" {" x+ H  a1 k8 Q3 o9 H
/ f0 z$ C. l" X( lCall plmain
" p* f1 w8 |4 R9 |: Q
, _. Y: i! X" h, g" z& G
'



+ t8 k1 X' n: g( s( ]Part.Save '保存%
swApp.CloseDoc (swFileName) '关闭零件

If swFileName = "" Then Exit Do

5 I2 p- M  u9 H* n4 \& y0 [" {
+ \/ z5 h4 n+ J! s- `0 U5 W4 J- D: W3 yswFileName = Dir '搜寻下一个零件档案名称0
7 x" Q% Q5 V; }7 p. _
( m4 g( c' H# b  \1 \; R. SLoop '循环搜寻
End Sub

kbisi

Dim swApp As Object
Dim Part As Object
Dim sldPath As String
Dim boolstatus As Boolean
0 U6 \- d( h$ M- B/ bDim longstatus As Long, longwarnings As Long
1 m/ Y: _  T  a9 R5 s2 F) J! SSub Test()
Set swApp = Application.SldWorks
sldPath = "C:\Users\kbisi\Desktop\实验\" '设定目录
swFileName = Dir(sldPath & "*.sld*")  '搜寻首个零件档案名称
If UCase(Right(swFileName, 3)) = "PRT" Then swFileTYpe = 1
5 ^# U( [) X3 i* t4 u& N; |$ ]If UCase(Right(swFileName, 3)) = "ASM" Then swFileTYpe = 2
Do While swFileName <> ""
* F, d2 m4 ~0 S- i- tSet swApp = Application.SldWorks
'Set swDoc = swApp.OpenDoc(sldPath & swFileName, swFileTYpe) '开启零件
Set swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)
. x* Q- t6 W3 s9 U; {8 {1 h" t. bSet Part = swApp.ActiveDoc
: Z& p# B4 L" b# y+ WCall plmain
Part.Save '保存%
swApp.CloseDoc (swFileName) '关闭零件
  z) U, ~, m/ B5 o8 v& cIf swFileName = "" Then Exit Do
! b) X$ e+ L; \  iswFileName = Dir '搜寻下一个零件档案名称0
Loop '循环搜寻
/ _6 v- I1 p* C6 A6 \4 WEnd Sub   老是被跳过

kbisi

kbisi 发表于 2021-11-28 10:05
& v: I! d+ T, z* M" f& d8 g! L# i# jDim swApp As Object
' @+ {4 d. X0 |) x) ^Dim Part As Object
) Y- S& ~! T" d' wDim sldPath As String

希望可以得到解答

kbisi

kbisi 发表于 2021-11-28 10:05
8 F6 A& v! ^% `4 r' e, U0 l2 H  ^9 NDim swApp As Object
Dim Part As Object
Dim sldPath As String

- g2 G) d- |+ M( K& b和楼主一样打不开装配体

357755306b

多少积分可以分享

xinshiji666

kbisi 发表于 2021-11-28 13:44
6 s& e  \$ ~( \- R5 }4 `希望可以得到解答

) Y( K$ t4 d' Q# K无法打开装配体文件，是因为你把文件类型判定的语句放在循环外了，挪到do...loop内即可，那个call语句调用了什么？用不上可以先屏蔽。
经过测试，下面的程序可正常打开零件和装配体

' ******************************************************************************
' 读取指定目录下的Prt/asm文件，关闭
' w) C% e. \0 Q; q+ O! f' ******************************************************************************
Dim swApp As Object

9 d# n! D" ?9 R! ]: HDim Part As Object
) W! u4 L' r& S8 U8 |Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
'Dim sldPath As String
Const sldPath As String = "E:\3Dtest\BOM1\"  '设定目录

2 Q" g+ Q* l% ~# u2 u( HSub main()
8 d+ m# C' `5 s# H
    Set swApp = _
    Application.SldWorks
4 n: o2 y9 G9 z% L! a/ A. h    Set Part = swApp.ActiveDoc
        
% n0 O* i/ i- r    swFileName = Dir(sldPath & "*.sld*")

: x5 \# z8 a1 N# u8 K    Do While swFileName <> ""
        Set swApp = Application.SldWorks
" a/ U& X3 ?# ?        If UCase(Right(swFileName, 3)) = "PRT" Then swFileTYpe = 1
/ K! S6 V/ d( o" r) B  c        If UCase(Right(swFileName, 3)) = "ASM" Then swFileTYpe = 2
5 ~7 O/ [( q5 Q3 }+ c0 P" H5 M) W6 E
        Set swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)
        Set Part = swApp.ActiveDoc
        'Call plmain
        'Part.Save '保存
        swApp.CloseDoc (swFileName) '关闭零件
/ L  P$ S4 z& T4 E% h5 x: F        If swFileName = "" Then Exit Do:
+ O, y+ e4 J; x* e6 s5 H' a, T        swFileName = Dir '搜寻下一个零件档案名称
: a7 D8 }' {1 V    Loop '循环搜寻

8 \2 r: K6 h1 s7 X8 l, JEnd Sub

Ali.

能提供你成功运行的一个代打为参考吗我的一直报错
5 I" k" s- `& b1 X' r  l  w