solidworks 批量执行宏

knight3732449

观摩一下

受伤的仙人球

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

kbisi

Dim swApp As Object
Dim Part As Object
( [# t, c! x+ v, fDim sldPath As String

$ A, g# c+ E+ H7 O* o# |  g: fDim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long




$ e6 \2 a7 m. g/ J+ r2 G9 h3 c- |Sub Test()
Set swApp = Application.SldWorks
. v; a/ h7 R0 S1 D0 hsldPath = "C:\Users\kbisi\Desktop\实验\" '设定目录

! \9 L( _4 c: Z1 }8 K! }swFileName = Dir(sldPath & "*.sld*")  '搜寻首个零件档案名称
$ Z* B2 A; \  q: d2 eIf UCase(Right(swFileName, 3)) = "PRT" Then swFileTYpe = 1
7 b2 l6 k/ a( h9 z9 {If UCase(Right(swFileName, 3)) = "ASM" Then swFileTYpe = 2

Do While swFileName <> ""
: d: _1 z3 m: u' F% w
: O( [: \: B; bSet swApp = Application.SldWorks

2 m5 B7 R$ @& k; b" Y! U'Set swDoc = swApp.OpenDoc(sldPath & swFileName, swFileTYpe) '开启零件
9 L$ [& @6 O& @5 M2 q
$ v/ s: r( ^. a0 p8 s  p6 _Set swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)

0 N) e6 O0 k; P: a9 G) K( n



- B4 e8 `$ ?; C4 y& m: m' NSet Part = swApp.ActiveDoc
8 @$ O6 E  K6 N4 n' J3 f0 F
5 ~4 u- _. ^  O# b1 V8 W# B! v2 VCall plmain

6 J( w! C' R7 w2 c1 f9 n
0 d: v9 X" g- j- M1 h/ a8 j'
5 T+ l( T& Z) X, w$ Q- Y


8 P9 i. d- g9 kPart.Save '保存%
* _6 n, i( A1 p' d9 m/ SswApp.CloseDoc (swFileName) '关闭零件

If swFileName = "" Then Exit Do


swFileName = Dir '搜寻下一个零件档案名称0

Loop '循环搜寻
End Sub
; L9 V& J8 G; w按F8一行看程序错误为什么老是跳过Then swFileTYpe = 2

kbisi

Dim swApp As Object
Dim Part As Object
- I) T* a, a% z& \' {" qDim sldPath As String
; k4 m7 z" n, ?3 o3 H
7 y7 J: `' Z" \5 e8 kDim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
0 B8 K' K! i0 ^  N! Z/ L* O+ _" ~" }



Sub Test()
* D5 \3 N$ X$ y8 }6 BSet swApp = Application.SldWorks
' K4 }3 y+ E# J  h- m8 m+ IsldPath = "C:\Users\kbisi\Desktop\实验\" '设定目录

swFileName = Dir(sldPath & "*.sld*")  '搜寻首个零件档案名称
- z( ^4 @* U  c/ c( C: K0 f1 ?If UCase(Right(swFileName, 3)) = "PRT" Then swFileTYpe = 1
If UCase(Right(swFileName, 3)) = "ASM" Then swFileTYpe = 2
7 `# X+ p' C- O0 `! x
8 o7 v9 W! y1 ^  q4 i1 B, lDo While swFileName <> ""
$ d+ {) u0 K7 }' s+ F& N7 Z
Set swApp = Application.SldWorks

3 n2 D2 n+ h, w  i2 i$ F/ U'Set swDoc = swApp.OpenDoc(sldPath & swFileName, swFileTYpe) '开启零件

Set swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)
9 ^4 f7 k2 s" X- S# ^4 Y2 }
0 w, U2 c" ]4 h! F. J1 k0 y
& {" u6 F# J( L' X


  m8 Z; P% Y* i; u3 o* XSet Part = swApp.ActiveDoc

Call plmain


, {' J# {" ~* K1 u0 ]'

- t) z/ r* T- M! M( n

Part.Save '保存%
swApp.CloseDoc (swFileName) '关闭零件
' ~7 L! S8 I8 q  V* _) j
) z2 K/ s( y' U( [2 V4 {- ]If swFileName = "" Then Exit Do

& H. w$ c3 d% _- b; n! C
swFileName = Dir '搜寻下一个零件档案名称0
3 D' d! G: X! C; {1 j
, z$ C; ]( V: CLoop '循环搜寻
End Sub

kbisi

Dim swApp As Object
  H/ O" G6 ^/ E- cDim Part As Object
Dim sldPath As String
/ B  r+ }( G  ~! z! G' yDim boolstatus As Boolean
/ ?& N! i5 i  K# i2 X- s2 tDim longstatus As Long, longwarnings As Long
, D' [1 C5 e+ S5 L0 \) ~5 lSub Test()
+ O* ~0 @. w' H' z, g" L6 r& NSet swApp = Application.SldWorks
sldPath = "C:\Users\kbisi\Desktop\实验\" '设定目录
swFileName = Dir(sldPath & "*.sld*")  '搜寻首个零件档案名称
If UCase(Right(swFileName, 3)) = "PRT" Then swFileTYpe = 1
If UCase(Right(swFileName, 3)) = "ASM" Then swFileTYpe = 2
Do While swFileName <> ""
Set swApp = Application.SldWorks
) ~& }- }( D$ J& H0 Y) s'Set swDoc = swApp.OpenDoc(sldPath & swFileName, swFileTYpe) '开启零件
: Y3 \9 @6 ~- O5 _( USet swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)
Set Part = swApp.ActiveDoc
4 w1 n0 M$ i9 U8 B7 bCall plmain
# ~, M! K3 g' q+ H* gPart.Save '保存%
swApp.CloseDoc (swFileName) '关闭零件
If swFileName = "" Then Exit Do
  F8 h2 c5 A0 {8 h0 GswFileName = Dir '搜寻下一个零件档案名称0
& ~. U+ W, P. K7 lLoop '循环搜寻
6 |6 _6 C+ ~( o1 FEnd Sub   老是被跳过

kbisi

kbisi 发表于 2021-11-28 10:05
Dim swApp As Object
Dim Part As Object
* B6 F5 A- O, O5 f1 s& z5 A  iDim sldPath As String

3 {$ k9 V5 U2 M# w0 S* T希望可以得到解答
; b! E9 b& Z) j) k

kbisi

kbisi 发表于 2021-11-28 10:05
( Z1 ?- m8 h) V3 z# E  B- _Dim swApp As Object
' @2 C% S+ f+ J8 P$ \% ?Dim Part As Object
/ o% K  F# k9 }0 eDim sldPath As String

" U9 o( j6 p* z! j; R1 ^# `# c- y和楼主一样打不开装配体
9 m& |0 O9 w+ I4 j1 `

357755306b

多少积分可以分享

xinshiji666

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

无法打开装配体文件，是因为你把文件类型判定的语句放在循环外了，挪到do...loop内即可，那个call语句调用了什么？用不上可以先屏蔽。
经过测试，下面的程序可正常打开零件和装配体
& y# @( b- m; ~3 X  L9 e$ J
' ******************************************************************************
" s( W- G+ R* H' 读取指定目录下的Prt/asm文件，关闭
( o% S" p0 A9 z7 D( }. {! {' ******************************************************************************
; U# x5 c4 T8 f. J5 T6 }Dim swApp As Object
* U7 w% b# f+ y/ j/ }6 R4 K
2 [# n4 a( q* l) x! N5 z5 L: lDim Part As Object
5 {3 z9 Z, H, Z1 DDim boolstatus As Boolean
3 K/ H" L$ e5 A! l! zDim longstatus As Long, longwarnings As Long
'Dim sldPath As String
8 i( K5 c& ~) XConst sldPath As String = "E:\3Dtest\BOM1\"  '设定目录
  q% P+ R. w8 T& ^7 S
( Q. e9 y& o/ bSub main()

    Set swApp = _
( p7 {" w$ g8 K) d. G+ ?    Application.SldWorks
! k9 T2 d; r9 D# [6 T    Set Part = swApp.ActiveDoc
        
# N. i: ?. H. K- z& y3 Y2 ?% @3 b    swFileName = Dir(sldPath & "*.sld*")
7 H, m; R$ \, Q6 \' W/ J9 i
7 d9 y% F/ g5 _0 {8 E- n    Do While swFileName <> ""
        Set swApp = Application.SldWorks
        If UCase(Right(swFileName, 3)) = "PRT" Then swFileTYpe = 1
        If UCase(Right(swFileName, 3)) = "ASM" Then swFileTYpe = 2
- z% a+ M: z; i$ i% y/ Y* _0 p
        Set swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)
        Set Part = swApp.ActiveDoc
        'Call plmain
        'Part.Save '保存
        swApp.CloseDoc (swFileName) '关闭零件
        If swFileName = "" Then Exit Do:
        swFileName = Dir '搜寻下一个零件档案名称
    Loop '循环搜寻
- D# g$ U( o" n; K8 `3 U
% ^9 m( p$ }* W1 T1 \1 P4 DEnd Sub

4 X  ~7 U& `0 q6 ]' @2 w; H7 [# j, |

Ali.

能提供你成功运行的一个代打为参考吗我的一直报错
  {7 K9 w  \- O/ e3 t
8 n* |3 p& ?: Z' w: r& q