solidworks 批量执行宏

knight3732449

观摩一下

受伤的仙人球

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

kbisi

Dim swApp As Object
- i) u( ]& G1 GDim Part As Object
Dim sldPath As String

Dim boolstatus As Boolean
$ x& f6 s1 a+ ]' Z! Y0 @0 fDim longstatus As Long, longwarnings As Long

' s# d) u* X4 z8 ~
$ U; _: f" O$ B3 e; N' G

Sub Test()
Set swApp = Application.SldWorks
sldPath = "C:\Users\kbisi\Desktop\实验\" '设定目录
3 ?" t, T* e' B; k5 p1 [+ _7 K
swFileName = Dir(sldPath & "*.sld*")  '搜寻首个零件档案名称
If UCase(Right(swFileName, 3)) = "PRT" Then swFileTYpe = 1
4 R3 R- J  g3 |; e! JIf UCase(Right(swFileName, 3)) = "ASM" Then swFileTYpe = 2
: ~6 a. v# p# A" K, ?) D
Do While swFileName <> ""
9 f: Y* K$ h5 X' {6 s4 k
6 ^( r$ P. _$ R+ w: M2 w1 |9 G% WSet swApp = Application.SldWorks

9 X5 R2 G7 X$ c'Set swDoc = swApp.OpenDoc(sldPath & swFileName, swFileTYpe) '开启零件

Set swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)
. T5 t. T/ _3 p
. h$ M) R; P9 _- B: C, ?0 j; t
2 X0 Z4 s! C6 O

# w, U6 r/ l- J. G4 T# M
Set Part = swApp.ActiveDoc

  {* o7 t# ~; @. p0 |7 z& ]Call plmain

2 J) h# w% w9 m1 _; s8 q
'
/ c. J/ R8 f  t1 l, F, q1 Q8 \$ e


4 B; {' R1 o$ m$ xPart.Save '保存%
swApp.CloseDoc (swFileName) '关闭零件
" ]! G9 u0 l0 y0 u- s: {" W
+ j5 O+ V$ q; l6 s7 i4 h1 rIf swFileName = "" Then Exit Do
- |: o% R5 n9 k. d* x; Q4 j

7 A% P6 ^. [, J# AswFileName = Dir '搜寻下一个零件档案名称0
9 y: l. o) n8 j
Loop '循环搜寻
End Sub
按F8一行看程序错误为什么老是跳过Then swFileTYpe = 2

kbisi

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

% A* O* t3 n2 `8 ^) r! G1 MDim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
) _9 x" q# E4 M! m4 I  F0 d
; f2 Z% a4 {2 h6 W+ V' M6 V" E* |
2 N/ e: J1 V/ @. U2 k5 h( r
3 d9 w/ u/ D4 l" W
Sub Test()
Set swApp = Application.SldWorks
* R( ^$ x- J/ ?% K+ s; Z$ q3 ksldPath = "C:\Users\kbisi\Desktop\实验\" '设定目录
! f& K' G- M$ q& l
! U& {# Q4 c( r- v" f: a! {  c  y, `swFileName = Dir(sldPath & "*.sld*")  '搜寻首个零件档案名称
; B: P9 g- `$ \If UCase(Right(swFileName, 3)) = "PRT" Then swFileTYpe = 1
5 Y* C7 Q7 R; T! VIf UCase(Right(swFileName, 3)) = "ASM" Then swFileTYpe = 2
2 y" A* r' O8 L3 t/ N1 l. D: Y
Do While swFileName <> ""
) Z: m& C6 X4 r
* @7 k5 @0 i3 _8 V) j6 {0 sSet swApp = Application.SldWorks

: {4 y$ e0 {3 H6 l, a'Set swDoc = swApp.OpenDoc(sldPath & swFileName, swFileTYpe) '开启零件
1 O0 ^; j2 \  S8 y6 k2 f
Set swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)
5 [' A( I  f% D
. @+ H- t3 I) H( e: V# G/ j
: [" U2 |9 T  j0 ]


Set Part = swApp.ActiveDoc
9 R8 K* |' g3 N+ z0 @# u
0 \" M: P' G+ q/ Y0 t: M! QCall plmain
2 W8 w. n$ {/ n' H, R/ M$ E2 I

'


  S6 F- h6 T7 i0 ]
Part.Save '保存%
swApp.CloseDoc (swFileName) '关闭零件
' p  g/ G: P; ?& e: m. @- A
/ F& z* M9 _% T9 {% J  B# X2 sIf swFileName = "" Then Exit Do
/ L" C# a8 I- ?, `( [3 X. T; P2 {
! |! d( f: N2 `! k
swFileName = Dir '搜寻下一个零件档案名称0

$ Z# s* E7 @4 j: l. FLoop '循环搜寻
, t! p4 ]" W/ b9 h& ~' r* i5 dEnd Sub

kbisi

Dim swApp As Object
  ?$ ~3 \: n% t* Z' D) N0 dDim Part As Object
5 j+ H5 z8 [8 _8 KDim sldPath As String
Dim boolstatus As Boolean
! H' F- P8 N" k1 xDim longstatus As Long, longwarnings As Long
) I# s7 N1 t2 w, \% l5 ]  [Sub Test()
5 j9 |$ f) i* T& a2 J, VSet swApp = Application.SldWorks
sldPath = "C:\Users\kbisi\Desktop\实验\" '设定目录
swFileName = Dir(sldPath & "*.sld*")  '搜寻首个零件档案名称
, c' M+ [7 N5 G! @! v  `( gIf 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) '开启零件
, v0 K) [/ G! b+ Y& y1 U5 y2 KSet swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)
Set Part = swApp.ActiveDoc
Call plmain
Part.Save '保存%
& {2 B+ Q) O6 u5 t+ y1 t; CswApp.CloseDoc (swFileName) '关闭零件
If swFileName = "" Then Exit Do
swFileName = Dir '搜寻下一个零件档案名称0
Loop '循环搜寻
' Z6 |8 \( O# l1 O0 Q! e- nEnd Sub   老是被跳过

kbisi

kbisi 发表于 2021-11-28 10:05
+ X/ L, ~& l  R& m) CDim swApp As Object
4 W2 G! h* v7 x" W& qDim Part As Object
  J) _6 a9 i6 ^( C; y% r; JDim sldPath As String

希望可以得到解答
6 t/ _+ R& B, S$ t4 W$ E

kbisi

kbisi 发表于 2021-11-28 10:05
Dim swApp As Object
7 e) B: i% t; J% |. d" Y2 vDim Part As Object
Dim sldPath As String

和楼主一样打不开装配体
$ t7 w" C' Z! y$ A5 v* m

357755306b

多少积分可以分享

xinshiji666

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

无法打开装配体文件，是因为你把文件类型判定的语句放在循环外了，挪到do...loop内即可，那个call语句调用了什么？用不上可以先屏蔽。
7 Z$ e1 N0 n9 r% ^- Z# P- Y经过测试，下面的程序可正常打开零件和装配体
; W- K. T' t# s8 h( M
' ******************************************************************************
1 }5 j; W: L& b3 G+ ~: y! g' 读取指定目录下的Prt/asm文件，关闭
- x# W7 o& M5 W+ _5 W' ******************************************************************************
( F4 k& i1 v8 JDim swApp As Object
* D9 B2 L8 _, i2 X; C2 L! v( @* ?
8 D2 l1 f/ J% S+ p+ YDim Part As Object
# ?$ c; y1 U! ]2 p- r, c/ lDim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
'Dim sldPath As String
Const sldPath As String = "E:\3Dtest\BOM1\"  '设定目录
' `: e: V* S, K6 s. j* x
0 }( T/ |! w3 P- m9 I* _3 o$ f  o' zSub main()
5 l" @; g  X) s, D9 p1 h% Q
0 }8 }7 C: a; l! B  B+ \, A2 w    Set swApp = _
    Application.SldWorks
: B# J2 P$ o% ~) s- k; P; `4 O    Set Part = swApp.ActiveDoc
        
    swFileName = Dir(sldPath & "*.sld*")

8 e& x% N1 Y2 D" {# ], a- O% q    Do While swFileName <> ""
        Set swApp = Application.SldWorks
) l! K  X& q% ^2 O$ K        If UCase(Right(swFileName, 3)) = "PRT" Then swFileTYpe = 1
/ \; E+ E" z* C1 k' j5 P        If UCase(Right(swFileName, 3)) = "ASM" Then swFileTYpe = 2
8 |* L$ a. X" F# H# Y. t
. Q/ D- Y9 }2 S        Set swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)
2 [1 s  O/ t, C0 G6 \        Set Part = swApp.ActiveDoc
        'Call plmain
9 t) i* i( B* y) Q* W        'Part.Save '保存
        swApp.CloseDoc (swFileName) '关闭零件
        If swFileName = "" Then Exit Do:
/ |, S+ y5 A' D/ J+ f        swFileName = Dir '搜寻下一个零件档案名称
2 p+ \7 ~1 x% B9 |" o    Loop '循环搜寻
) A( E. j/ V5 q) e
+ U/ O- x6 O4 L: dEnd Sub
, h. E0 \. F0 }  C  v1 r9 P
1 @" w" D/ y$ L8 v. K
  Q; `3 W7 R+ b9 ^- I9 I3 v

Ali.

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

- @( e, M7 }: i1 F) E' x