solidworks 批量執(zhí)行宏

knight3732449

觀摩一下

受傷的仙人球

有個(gè)使用場(chǎng)景，現(xiàn)在我使用的圖號(hào)分離宏需要打開(kāi)零件才能進(jìn)行屬性修改，每次在裝配體里多修改幾個(gè)零件名稱或者新做零件就會(huì)忘了改屬性，如果可以批量打開(kāi)零件，然后中間插入執(zhí)行圖號(hào)分離宏的工具執(zhí)行，就可以自動(dòng)幫我一次性修改零件屬性了（但是俺不會(huì)寫，有沒(méi)有大佬幫幫忙嗚嗚嗚）

kbisi

Dim swApp As Object
' e8 C6 M# [4 j( M% M. b5 b" ADim Part As Object
7 i6 C. @9 M% j) WDim sldPath As String

Dim boolstatus As Boolean
& ?. G% L* N' [/ I0 jDim longstatus As Long, longwarnings As Long
: E; Z( t. z; |+ L6 Y# ^$ v/ h
  [$ P  |8 w* p! o& y8 n. j


Sub Test()
Set swApp = Application.SldWorks
6 }5 t: V4 b, J' |7 C$ A7 XsldPath = "C:\Users\kbisi\Desktop\實(shí)驗(yàn)\" '設(shè)定目錄
0 A$ `  `2 ]2 H6 t: _
swFileName = Dir(sldPath & "*.sld*")  '搜尋首個(gè)零件檔案名稱
If UCase(Right(swFileName, 3)) = "PRT" Then swFileTYpe = 1
+ w+ @0 S9 q4 r' fIf UCase(Right(swFileName, 3)) = "ASM" Then swFileTYpe = 2

Do While swFileName <> ""
, e$ ?# P; b- H9 U/ ?6 x
3 x" I+ X* A; c% X5 ZSet swApp = Application.SldWorks

& Z; O9 {' Z' [2 m  q: E'Set swDoc = swApp.OpenDoc(sldPath & swFileName, swFileTYpe) '開(kāi)啟零件
. P# U" x6 L# M" Y/ \3 x7 j
Set swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)

' O* U4 C( ]( s

* G) T( m1 |) n3 s' ~$ N

" }3 n0 S% h% s  H( fSet Part = swApp.ActiveDoc

Call plmain


4 U6 p' H% S  w6 S: q'
' ^7 c: k. w; {


Part.Save '保存%
swApp.CloseDoc (swFileName) '關(guān)閉零件
0 f. Y7 J% t6 d5 @4 W; _& j
" E* |5 T, p5 r- _If swFileName = "" Then Exit Do
. M/ h$ b, G/ S8 m* i6 a7 J+ ^

swFileName = Dir '搜尋下一個(gè)零件檔案名稱0
, u, I- {! d3 V, x
Loop '循環(huán)搜尋
* o1 L5 D" K! A6 D: u/ bEnd Sub
按F8一行看程序錯(cuò)誤為什么老是跳過(guò)Then swFileTYpe = 2

kbisi

Dim swApp As Object
( E7 D5 q$ h' hDim Part As Object
Dim sldPath As String

3 [- |" R& F7 ]0 CDim boolstatus As Boolean
& ^4 N0 N5 k) y& k. VDim longstatus As Long, longwarnings As Long
) X6 N; J9 ?2 y( J0 g# b0 |) \& i& I
' x/ J- v8 g' `) Y
/ w$ f. O+ L7 s3 {" n( f( ~% Q
+ y) b) _% {9 E  e3 X0 i
: S: {8 X3 d1 S9 TSub Test()
4 E+ i' X. X' s9 j" _4 GSet swApp = Application.SldWorks
sldPath = "C:\Users\kbisi\Desktop\實(shí)驗(yàn)\" '設(shè)定目錄

swFileName = Dir(sldPath & "*.sld*")  '搜尋首個(gè)零件檔案名稱
! i5 c4 d  V$ n' KIf UCase(Right(swFileName, 3)) = "PRT" Then swFileTYpe = 1
If UCase(Right(swFileName, 3)) = "ASM" Then swFileTYpe = 2
3 o3 L) v. R" L0 `
Do While swFileName <> ""
1 _- J3 l' G3 J1 C7 g
. C9 k/ m) u: F/ nSet swApp = Application.SldWorks
9 e/ q1 ~/ s( q2 m* E3 b4 N
'Set swDoc = swApp.OpenDoc(sldPath & swFileName, swFileTYpe) '開(kāi)啟零件

Set swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)
0 @7 v, o7 \8 Q6 v) G
: }+ \$ ]8 g8 w# g6 @  X
+ a8 A8 [- t0 S* E8 H; |- R


Set Part = swApp.ActiveDoc
, n! W+ z5 ]! X0 O: e0 S4 Q* Q) F/ ]7 b( g
Call plmain
2 d- M5 F5 ]6 ~, S6 @
; N4 `: Y7 B6 @" v7 V
'



% l0 W/ V1 s9 s% l5 I" M1 q* BPart.Save '保存%
swApp.CloseDoc (swFileName) '關(guān)閉零件
1 {6 C5 S; w5 v; r2 B
If swFileName = "" Then Exit Do

: _7 _# F9 t: S5 g5 C  D
swFileName = Dir '搜尋下一個(gè)零件檔案名稱0

' v' w+ S# C4 H# z+ iLoop '循環(huán)搜尋
End Sub

kbisi

Dim swApp As Object
Dim Part As Object
8 l! }+ [% e( h& L4 l; SDim sldPath As String
; m! m# z! @" X, p; t  [Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
2 \/ [' g$ ^/ B% L7 vSub Test()
Set swApp = Application.SldWorks
sldPath = "C:\Users\kbisi\Desktop\實(shí)驗(yàn)\" '設(shè)定目錄
swFileName = Dir(sldPath & "*.sld*")  '搜尋首個(gè)零件檔案名稱
If UCase(Right(swFileName, 3)) = "PRT" Then swFileTYpe = 1
/ J# J# e! Y- n. b& ^If UCase(Right(swFileName, 3)) = "ASM" Then swFileTYpe = 2
. |9 d! w4 d8 S& L) RDo While swFileName <> ""
3 m- j* I- z( J( y) a3 RSet swApp = Application.SldWorks
'Set swDoc = swApp.OpenDoc(sldPath & swFileName, swFileTYpe) '開(kāi)啟零件
Set swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)
Set Part = swApp.ActiveDoc
Call plmain
Part.Save '保存%
+ x% j' K4 ?* Q: J+ v: ^* @swApp.CloseDoc (swFileName) '關(guān)閉零件
If swFileName = "" Then Exit Do
; {! o8 {$ _# X; {$ KswFileName = Dir '搜尋下一個(gè)零件檔案名稱0
Loop '循環(huán)搜尋
End Sub   老是被跳過(guò)

kbisi

kbisi 發(fā)表于 2021-11-28 10:05
Dim swApp As Object
Dim Part As Object
; b) \3 H# _$ W  zDim sldPath As String

1 w" o9 z7 u& k1 w% }希望可以得到解答

kbisi

kbisi 發(fā)表于 2021-11-28 10:05
Dim swApp As Object
% ?5 C7 }7 V, }Dim Part As Object
Dim sldPath As String

和樓主一樣打不開(kāi)裝配體
' q  e! n8 W/ y+ n! f$ z) T* G2 u( G

357755306b

多少積分可以分享

xinshiji666

kbisi 發(fā)表于 2021-11-28 13:44
( q4 M' v* }3 {希望可以得到解答

無(wú)法打開(kāi)裝配體文件，是因?yàn)槟惆盐募�類型判定的語(yǔ)句放在循環(huán)外了，挪到do...loop內(nèi)即可，那個(gè)call語(yǔ)句調(diào)用了什么？用不上可以先屏蔽。
! q) H* Q% E$ i$ h) D2 Z經(jīng)過(guò)測(cè)試，下面的程序可正常打開(kāi)零件和裝配體

4 q8 q% x, e; v0 N- q" _3 }' ******************************************************************************
' 讀取指定目錄下的Prt/asm文件，關(guān)閉
' ******************************************************************************
Dim swApp As Object

: ^% m5 `9 g6 sDim Part As Object
2 O; @/ G* Z* A& w. @: vDim boolstatus As Boolean
# r  l: u$ n/ w  S+ Z7 JDim longstatus As Long, longwarnings As Long
1 d( r' z: `' @0 U'Dim sldPath As String
Const sldPath As String = "E:\3Dtest\BOM1\"  '設(shè)定目錄

) V3 T; E1 U/ c) HSub main()

    Set swApp = _
    Application.SldWorks
    Set Part = swApp.ActiveDoc
! n( c, ^1 B: ~8 f        
    swFileName = Dir(sldPath & "*.sld*")
8 A+ k+ _  d, t# I# B
" g- h% i) h3 f3 o) I    Do While swFileName <> ""
        Set swApp = Application.SldWorks
/ E8 t7 F" @: v" G5 I        If UCase(Right(swFileName, 3)) = "PRT" Then swFileTYpe = 1
        If UCase(Right(swFileName, 3)) = "ASM" Then swFileTYpe = 2
! ^. p& ~: \7 N, A5 Y& r: V
        Set swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)
/ F% b% x4 A" g/ ?: f- s( T3 G; `' d        Set Part = swApp.ActiveDoc
        'Call plmain
        'Part.Save '保存
        swApp.CloseDoc (swFileName) '關(guān)閉零件
' z7 q$ X. I; j+ H& T        If swFileName = "" Then Exit Do:
        swFileName = Dir '搜尋下一個(gè)零件檔案名稱
    Loop '循環(huán)搜尋

End Sub

Ali.

能提供你成功運(yùn)行的一個(gè)代打?yàn)閰⒖紗嵛业囊恢眻?bào)錯(cuò)
- r+ m% F  c: W  Q' C
. V  q8 v1 n( |8 S' [