solidworks 批量执行宏

knight3732449

观摩一下

受伤的仙人球

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

kbisi

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

4 q% n5 V7 @" ]) _9 ]* N' mDim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long


! n0 ~4 N9 s& l4 B0 Q7 d
7 T7 ]0 n' u4 J) J$ [" z. b
' L3 Z4 [, t# W1 ?6 s7 s0 \$ N  bSub Test()
7 U9 `9 s6 O# v7 S* lSet swApp = Application.SldWorks
sldPath = "C:\Users\kbisi\Desktop\实验\" '设定目录
" K! y2 g2 f+ Z7 K  [4 D
swFileName = Dir(sldPath & "*.sld*")  '搜寻首个零件档案名称
If UCase(Right(swFileName, 3)) = "PRT" Then swFileTYpe = 1
If UCase(Right(swFileName, 3)) = "ASM" Then swFileTYpe = 2
% {$ s+ z% ?; G9 V+ ~
* u6 s- t+ z* B$ GDo While swFileName <> ""
7 I4 r' ^9 f8 d: U" r# N) _
; V# {) R( U; E5 D1 ZSet swApp = Application.SldWorks

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

Set swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)
" Z6 U  a  Z2 h5 X

# M  [5 n, o0 u# w* y- M
& h  W# S+ d0 J4 I1 i
; |% D9 l0 m0 J/ f% l
Set Part = swApp.ActiveDoc

Call plmain
% ]- u% G, F2 a3 a& x3 Z# |

'
; r; W0 |9 m# E2 b: Q

8 u) ?+ G% A8 Q  K: r; I. X
+ o$ B1 K$ @# p- k9 S) h) PPart.Save '保存%
. z9 y: o1 q3 g. m1 v- J; o/ eswApp.CloseDoc (swFileName) '关闭零件

4 i& w' S) y) ~# eIf swFileName = "" Then Exit Do
! H, V% V* m3 v, O8 M9 N
- g9 H/ z- |, G' j
8 [( [  B' O" b9 b3 v1 ?swFileName = Dir '搜寻下一个零件档案名称0

Loop '循环搜寻
# ^# B9 J- v# H. V+ I5 {. _% wEnd Sub
按F8一行看程序错误为什么老是跳过Then swFileTYpe = 2

kbisi

Dim swApp As Object
Dim Part As Object
( p( I' a% j/ L% ?2 ]( [( X+ J3 ]% p! xDim sldPath As String
  W: W* B/ B# F3 X9 L+ \
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long


  {" [( x  ?- l7 t  ~- l- g

2 N2 K) s' j) _' P" ^Sub Test()
  D! W% \# ^$ l# ~: ~2 B: PSet swApp = Application.SldWorks
7 A6 J9 V+ L3 m' D3 RsldPath = "C:\Users\kbisi\Desktop\实验\" '设定目录

swFileName = Dir(sldPath & "*.sld*")  '搜寻首个零件档案名称
If UCase(Right(swFileName, 3)) = "PRT" Then swFileTYpe = 1
9 g$ z2 U% a* l3 f: U" O% i- m5 bIf UCase(Right(swFileName, 3)) = "ASM" Then swFileTYpe = 2

Do While swFileName <> ""
) I. P9 k' p  c* z! ~5 o. [
( Y- E3 ~5 Q0 r- C; K% jSet swApp = Application.SldWorks
6 ]4 F3 P3 B1 I3 _
) x2 V# y+ [& \0 V- D'Set swDoc = swApp.OpenDoc(sldPath & swFileName, swFileTYpe) '开启零件

Set swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)




1 B( I0 m  x- ]- a
, w' I6 V. L% M/ S. jSet Part = swApp.ActiveDoc
  ]/ o  O5 W0 y% x- s  R
Call plmain

: [5 u; v) v5 }3 x1 h5 N
/ \% Z7 ]4 N9 P7 }/ o'
# ]" c4 K4 H% h( J3 e1 |
  J4 q- H3 ]& _
- ^/ I6 E3 G2 X. w5 e  Z
# k# b/ g, e; U" S- x- BPart.Save '保存%
& g; X" k* c) UswApp.CloseDoc (swFileName) '关闭零件

7 f" r  h+ ^8 E4 u- H0 ^5 `If swFileName = "" Then Exit Do


& d' W$ D% [) [% N4 ]! Q% _) HswFileName = Dir '搜寻下一个零件档案名称0
2 i' ]6 Z$ o, \& @5 B% M. y
Loop '循环搜寻
End Sub

kbisi

Dim swApp As Object
Dim Part As Object
6 K7 |. ?# k6 F, F) `" [+ yDim sldPath As String
' a4 x  n1 n5 R; m& T* s4 WDim boolstatus As Boolean
2 h  ]3 P$ @# Y  ^' qDim longstatus As Long, longwarnings As Long
. {# f0 x: Y  nSub Test()
2 ~- K/ j0 E1 LSet swApp = Application.SldWorks
sldPath = "C:\Users\kbisi\Desktop\实验\" '设定目录
4 |9 e: t/ x8 r1 p; |/ G7 V5 T. `swFileName = Dir(sldPath & "*.sld*")  '搜寻首个零件档案名称
6 _6 h3 D; z5 B2 o* ]8 IIf UCase(Right(swFileName, 3)) = "PRT" Then swFileTYpe = 1
5 J7 U' j$ a4 Z' |6 d) SIf UCase(Right(swFileName, 3)) = "ASM" Then swFileTYpe = 2
Do While swFileName <> ""
Set swApp = Application.SldWorks
" G3 j* L8 C+ c4 `$ f' a'Set swDoc = swApp.OpenDoc(sldPath & swFileName, swFileTYpe) '开启零件
Set swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)
Set Part = swApp.ActiveDoc
. u6 G+ W4 _& `- W& Z3 QCall plmain
Part.Save '保存%
2 A0 W/ a: W) w- b/ jswApp.CloseDoc (swFileName) '关闭零件
If swFileName = "" Then Exit Do
9 Y2 \) S6 G  b- F, H1 vswFileName = Dir '搜寻下一个零件档案名称0
Loop '循环搜寻
End Sub   老是被跳过

kbisi

kbisi 发表于 2021-11-28 10:05
8 {% H/ I- V4 l1 \7 @+ G& FDim swApp As Object
0 m8 p' K* Q  W; YDim Part As Object
Dim sldPath As String

希望可以得到解答

kbisi

kbisi 发表于 2021-11-28 10:05
$ I* B# V6 C0 BDim swApp As Object
Dim Part As Object
Dim sldPath As String

和楼主一样打不开装配体
3 `4 f( R) Z, i! O: i" ]2 d0 e% P

357755306b

多少积分可以分享

xinshiji666

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

. @: b, o* x5 x# h3 G' y无法打开装配体文件，是因为你把文件类型判定的语句放在循环外了，挪到do...loop内即可，那个call语句调用了什么？用不上可以先屏蔽。
经过测试，下面的程序可正常打开零件和装配体
  X6 E, x! M' H3 H" e! }+ l
' ******************************************************************************
' 读取指定目录下的Prt/asm文件，关闭
' ******************************************************************************
Dim swApp As Object

& U. `0 b# Y+ @1 \, M9 w/ Q! M, |Dim Part As Object
2 j. b1 ?$ [8 a/ fDim boolstatus As Boolean
% y' b7 r& _+ e, U+ J& M& c5 lDim longstatus As Long, longwarnings As Long
'Dim sldPath As String
3 {8 V. _2 M& Y! U% L! U" x  kConst sldPath As String = "E:\3Dtest\BOM1\"  '设定目录

4 m4 Q5 b& n2 @4 d$ u7 L3 cSub main()
8 l4 R1 Q9 ~! o, X5 E
    Set swApp = _
    Application.SldWorks
4 A7 ]3 Q. l  k* q4 r* c# o    Set Part = swApp.ActiveDoc
        
    swFileName = Dir(sldPath & "*.sld*")

    Do While swFileName <> ""
        Set swApp = Application.SldWorks
, @$ K+ z$ ^) U% C        If UCase(Right(swFileName, 3)) = "PRT" Then swFileTYpe = 1
: f. Q- ~# ]5 J4 v) x6 M        If UCase(Right(swFileName, 3)) = "ASM" Then swFileTYpe = 2
+ l. N/ s/ T' H
3 i% g" h; F3 @# Q& M        Set swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)
        Set Part = swApp.ActiveDoc
        'Call plmain
        'Part.Save '保存
        swApp.CloseDoc (swFileName) '关闭零件
. R; F% s$ m, v2 c8 {5 o# X: v* v        If swFileName = "" Then Exit Do:
        swFileName = Dir '搜寻下一个零件档案名称
    Loop '循环搜寻
6 [! U3 L) a  Q4 _8 c4 O
End Sub

Ali.

能提供你成功运行的一个代打为参考吗我的一直报错
! k! n' b8 t9 v