solidworks 批量执行宏

knight3732449

观摩一下

受伤的仙人球

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

kbisi

Dim swApp As Object
3 w6 D# F# T3 S. u' o3 DDim Part As Object
Dim sldPath As String
& ~! o4 Y  z- M  s
: I8 t, u7 T3 m( r7 J) X% dDim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
9 p2 r% l7 l; `1 b! U

! [+ K+ I& R2 a1 ?; V4 u3 u0 e0 p

3 P- ^" f( s, i: mSub Test()
Set swApp = Application.SldWorks
$ K$ Y$ Z0 h. D# ksldPath = "C:\Users\kbisi\Desktop\实验\" '设定目录

swFileName = Dir(sldPath & "*.sld*")  '搜寻首个零件档案名称
* @9 u6 ^) M& M8 ]# D! I3 o. T7 d0 }If UCase(Right(swFileName, 3)) = "PRT" Then swFileTYpe = 1
$ I9 k! O8 V' o  M/ i' k; |If UCase(Right(swFileName, 3)) = "ASM" Then swFileTYpe = 2
, @6 S& k9 s1 h7 a( ]# w; P
1 h' y: M4 l. YDo While swFileName <> ""
( ]* f- v( T  V  q
Set swApp = Application.SldWorks

'Set swDoc = swApp.OpenDoc(sldPath & swFileName, swFileTYpe) '开启零件
6 k+ @: w7 z8 v/ o7 }' a# Z+ s4 A
Set swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)

" z9 o# c* k' ~

; @% Z( [) _* @2 Y! ^9 I$ o

Set Part = swApp.ActiveDoc

$ P1 Z: K5 K5 j7 {Call plmain
/ b# W& v1 c- s: g0 D

& V& a( G$ J9 ^'

  b9 k) U% U: C0 r& k

Part.Save '保存%
6 d6 `+ o( O) ~. X/ F! Q- B. k. s' ?swApp.CloseDoc (swFileName) '关闭零件
, w& I" i! u: P+ M
If swFileName = "" Then Exit Do
& Y2 |7 g& r  G6 K1 ~
! T; E3 R+ `+ f% h
% A) l! D/ d7 p/ L0 G- \# i( s8 dswFileName = Dir '搜寻下一个零件档案名称0
/ B" N8 v% T. m* r+ |6 O; C1 m
1 \3 t6 d5 J3 W2 _( N$ h+ ZLoop '循环搜寻
End Sub
按F8一行看程序错误为什么老是跳过Then swFileTYpe = 2

kbisi

Dim swApp As Object
Dim Part As Object
Dim sldPath As String
# T5 Q; x8 a& X0 P9 Y0 _* g
! }. ~3 `; V8 I$ {Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long




Sub Test()
Set swApp = Application.SldWorks
+ [; W8 {, N, W6 Z$ ~sldPath = "C:\Users\kbisi\Desktop\实验\" '设定目录

/ ?1 N* D, O1 c( u# GswFileName = Dir(sldPath & "*.sld*")  '搜寻首个零件档案名称
5 }5 z% S! y  m7 \If UCase(Right(swFileName, 3)) = "PRT" Then swFileTYpe = 1
If UCase(Right(swFileName, 3)) = "ASM" Then swFileTYpe = 2
/ [# |% ~( a: n1 a
Do While swFileName <> ""
( H$ g( ]0 Y5 y$ g& o4 I+ Z
. M+ e  x8 f  ?6 S$ S& z! F7 d6 hSet swApp = Application.SldWorks
3 R9 q! K  m7 h: d
5 z. g- q2 R( |4 |'Set swDoc = swApp.OpenDoc(sldPath & swFileName, swFileTYpe) '开启零件

9 |' A6 X6 W, ]" ^2 eSet swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)

3 n( u  ~6 N* c* p- j



# v! D4 {' M! {" D. @. a8 qSet Part = swApp.ActiveDoc

Call plmain

0 `4 s4 i! V  `  j$ j2 m4 e! K8 Y
'


% Z5 q/ T' ^/ T
& }/ Y; k$ ~1 Z/ j/ d/ c; \Part.Save '保存%
! z2 L+ {) R; g" aswApp.CloseDoc (swFileName) '关闭零件

# C9 e. D8 w1 B& b  d* tIf swFileName = "" Then Exit Do
2 _/ P  l& E' }- S( l
7 Z4 Y4 ?9 @* F# y3 J! c
swFileName = Dir '搜寻下一个零件档案名称0

+ s# j, Y: ~# t* J2 QLoop '循环搜寻
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
( F/ c0 G. J8 q+ j; V' I# l+ zSub Test()
$ `$ n/ e; J1 Y* M+ jSet swApp = Application.SldWorks
sldPath = "C:\Users\kbisi\Desktop\实验\" '设定目录
swFileName = Dir(sldPath & "*.sld*")  '搜寻首个零件档案名称
If UCase(Right(swFileName, 3)) = "PRT" Then swFileTYpe = 1
; m/ l( a. S6 @6 k7 QIf UCase(Right(swFileName, 3)) = "ASM" Then swFileTYpe = 2
* @* k, j! A( M" x& P3 Z3 k% }' kDo While swFileName <> ""
Set swApp = Application.SldWorks
'Set swDoc = swApp.OpenDoc(sldPath & swFileName, swFileTYpe) '开启零件
: S" D4 s9 `( E) t: S2 ESet swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)
/ L, f  x  u9 NSet Part = swApp.ActiveDoc
0 Q3 [( o9 {" `1 U9 gCall plmain
  f6 _, }/ v/ x9 m. R9 rPart.Save '保存%
swApp.CloseDoc (swFileName) '关闭零件
If swFileName = "" Then Exit Do
swFileName = Dir '搜寻下一个零件档案名称0
Loop '循环搜寻
5 T' Z5 K  n) H% H  Y+ FEnd Sub   老是被跳过

kbisi

kbisi 发表于 2021-11-28 10:05
Dim swApp As Object
4 A- Q( Q" U' [9 JDim Part As Object
0 U- V) I2 M$ |Dim sldPath As String

希望可以得到解答
% i4 [/ z& e- ]+ w' W

kbisi

kbisi 发表于 2021-11-28 10:05
Dim swApp As Object
Dim Part As Object
' J+ Y" L" F+ LDim sldPath As String

' o( h) W, x+ m和楼主一样打不开装配体

357755306b

多少积分可以分享

xinshiji666

kbisi 发表于 2021-11-28 13:44
4 L+ j6 v* G7 G, J/ Y7 v6 N) k% c希望可以得到解答

无法打开装配体文件，是因为你把文件类型判定的语句放在循环外了，挪到do...loop内即可，那个call语句调用了什么？用不上可以先屏蔽。
6 h4 m( j& N/ G7 O( b经过测试，下面的程序可正常打开零件和装配体
; C( n  Q% |* w+ B9 [- o* b
: h. `, M6 T9 q. o$ h' ******************************************************************************
' 读取指定目录下的Prt/asm文件，关闭
6 i) p( [4 ]5 J& F; L" d- f' ******************************************************************************
Dim swApp As Object
& s. U, n' `6 ?
Dim Part As Object
Dim boolstatus As Boolean
6 C$ W( b, I) G  K3 E$ H$ S7 w1 \Dim longstatus As Long, longwarnings As Long
, z; A1 A& X! _, K  ^'Dim sldPath As String
Const sldPath As String = "E:\3Dtest\BOM1\"  '设定目录

. A* F; X" h$ l/ aSub main()

6 D, F) N5 |) a" \0 G6 i1 f    Set swApp = _
    Application.SldWorks
    Set Part = swApp.ActiveDoc
        
8 n4 ?7 z- b) q2 F) }  z0 C6 @$ l    swFileName = Dir(sldPath & "*.sld*")
$ f% J: d6 l4 \5 D( K
    Do While swFileName <> ""
        Set swApp = Application.SldWorks
        If UCase(Right(swFileName, 3)) = "PRT" Then swFileTYpe = 1
0 C  _& G( n, ~& x: [# q, I        If UCase(Right(swFileName, 3)) = "ASM" Then swFileTYpe = 2

6 ?$ X+ |: @8 G, r. {  q        Set swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)
        Set Part = swApp.ActiveDoc
& }6 N' f/ x- \( A# w        'Call plmain
        'Part.Save '保存
        swApp.CloseDoc (swFileName) '关闭零件
        If swFileName = "" Then Exit Do:
        swFileName = Dir '搜寻下一个零件档案名称
' X8 h4 D1 c" |" o, ~2 v    Loop '循环搜寻

End Sub

* }- O+ a" A" Q$ H7 ?! ^- r" k" G

Ali.

能提供你成功运行的一个代打为参考吗我的一直报错
, L' K8 h- ~# U! o, P: M4 `5 Y1 J