solidworks 批量執(zhí)行宏

knight3732449

觀摩一下

受傷的仙人球

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

kbisi

Dim swApp As Object
; i: a7 z% s" }3 |8 l' iDim Part As Object
, [! u/ f4 F! Y  j8 p+ UDim sldPath As String
( L& z  |' Y& k  a5 [
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
" m7 _- g8 V3 O

" {  Y" t2 S5 _& x, N

# p1 A' R7 c2 m9 \5 G1 @# O- OSub Test()
Set swApp = Application.SldWorks
' _# y& g4 M, @: Z2 Q/ OsldPath = "C:\Users\kbisi\Desktop\實驗\" '設定目錄
0 m( T/ c. j- C6 A. @: Z
- F2 P/ Q" r6 ?* [swFileName = Dir(sldPath & "*.sld*")  '搜尋首個零件檔案名稱
! b) `/ Z) G% e* q. LIf UCase(Right(swFileName, 3)) = "PRT" Then swFileTYpe = 1
; l; S* y' y& c6 f9 hIf UCase(Right(swFileName, 3)) = "ASM" Then swFileTYpe = 2

3 W$ \+ I1 t3 u; @5 [Do While swFileName <> ""
# H# b$ G! \- X
! u# n, P' s7 M5 R; U* V& S- ASet swApp = Application.SldWorks

! ~+ M* z: I& G* S'Set swDoc = swApp.OpenDoc(sldPath & swFileName, swFileTYpe) '開啟零件

Set swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)
" n* S& c; E: l$ |- n1 H
0 p( K4 A  J% t
6 f2 x, F8 X" l2 b9 N$ E


& C2 h& w! `3 R1 ~2 U; HSet Part = swApp.ActiveDoc

! b, e! D7 _7 T: z" U7 O; l! qCall plmain

8 g5 L% I. L% ^% j/ U( L/ H! {+ h
'

4 B' S5 ]$ x% j

( \$ |' y$ f" {% F( K0 P0 j. }Part.Save '保存%
swApp.CloseDoc (swFileName) '關閉零件

If swFileName = "" Then Exit Do
" k9 l0 }* s" B4 B, B# c" }" J

9 F$ `! B3 t; u) mswFileName = Dir '搜尋下一個零件檔案名稱0

Loop '循環(huán)搜尋
# \2 ]4 k/ ]0 V# y- Q$ eEnd Sub
按F8一行看程序錯誤為什么老是跳過Then swFileTYpe = 2

kbisi

Dim swApp As Object
7 t& k9 \# M# D/ m# N2 D, ?- O/ JDim Part As Object
Dim sldPath As String
& R4 U& w! m$ {% e$ Y
+ O4 ?6 R/ a0 N( C0 |Dim boolstatus As Boolean
5 x$ o1 D7 n: [  A* y2 eDim longstatus As Long, longwarnings As Long
* k8 p8 z5 I4 Z( n: F/ j
+ {' j9 n0 l$ d9 f: x3 A& O


4 R% T# @9 m: u0 \- ISub Test()
+ o0 n( J& Z) d; j: D; `Set swApp = Application.SldWorks
sldPath = "C:\Users\kbisi\Desktop\實驗\" '設定目錄

* V" u* ]1 Z- Y0 J" lswFileName = Dir(sldPath & "*.sld*")  '搜尋首個零件檔案名稱
If UCase(Right(swFileName, 3)) = "PRT" Then swFileTYpe = 1
+ Q9 u: W7 F, G  h# q+ V+ yIf UCase(Right(swFileName, 3)) = "ASM" Then swFileTYpe = 2
' P5 V, {: Q! S% |8 |6 C
- Z$ h' F( Z& O0 g8 SDo While swFileName <> ""

7 o" z4 S' @$ Q3 Y# T5 ISet swApp = Application.SldWorks
( q$ s  Z, }! i/ h( m
; s+ ^7 c1 n% _8 q, q' n'Set swDoc = swApp.OpenDoc(sldPath & swFileName, swFileTYpe) '開啟零件

Set swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)
/ t9 S$ @- p- c

% s5 j2 Y0 V8 \0 Y5 r% d! P


( K. a' S% ]3 o" W/ F7 V% ^0 r: RSet Part = swApp.ActiveDoc
( I! e! u4 [# M% |  B2 j3 r; t
! Q0 m5 \- p4 t; Y/ T9 U8 TCall plmain

% Z3 H7 K1 b: B
# S/ c* S+ P" I$ u# x'

- o. [' b% u2 x6 M$ W0 G4 M

6 n  B. G; p( N( O7 X8 M' jPart.Save '保存%
* F# A" E5 t# a, l7 }swApp.CloseDoc (swFileName) '關閉零件

If swFileName = "" Then Exit Do
& I3 K$ ]7 T& N; l5 D2 b

8 u$ F" N. F" N. _+ @' G& sswFileName = Dir '搜尋下一個零件檔案名稱0
- S5 }5 ?" l& y" v% Z6 \4 N. Y8 ?
Loop '循環(huán)搜尋
: _' w7 T5 _$ ]: P0 ]End Sub

kbisi

Dim swApp As Object
* P& m. T" ^* c7 [: y. q0 kDim Part As Object
Dim sldPath As String
Dim boolstatus As Boolean
6 c. U$ q) _" ?Dim longstatus As Long, longwarnings As Long
) V0 v+ ^" R( x/ F% P- R1 q% @& cSub Test()
Set swApp = Application.SldWorks
sldPath = "C:\Users\kbisi\Desktop\實驗\" '設定目錄
swFileName = Dir(sldPath & "*.sld*")  '搜尋首個零件檔案名稱
If UCase(Right(swFileName, 3)) = "PRT" Then swFileTYpe = 1
" p, J7 D6 c% R) b0 F" N3 xIf UCase(Right(swFileName, 3)) = "ASM" Then swFileTYpe = 2
Do While swFileName <> ""
, a8 L3 l0 ?; t0 n3 ySet swApp = Application.SldWorks
'Set swDoc = swApp.OpenDoc(sldPath & swFileName, swFileTYpe) '開啟零件
Set swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)
Set Part = swApp.ActiveDoc
Call plmain
* U1 _, F. ~( ^2 Y4 I1 APart.Save '保存%
swApp.CloseDoc (swFileName) '關閉零件
If swFileName = "" Then Exit Do
( i- L9 g! n+ s0 g( W0 i4 WswFileName = Dir '搜尋下一個零件檔案名稱0
Loop '循環(huán)搜尋
) F, h1 |4 B9 \  WEnd Sub   老是被跳過

kbisi

kbisi 發(fā)表于 2021-11-28 10:05
8 \5 o( C* b6 `4 ?: D  o0 ZDim swApp As Object
4 h; R. J1 w* k) NDim Part As Object
Dim sldPath As String

0 \. {6 Q! }1 A5 T& v希望可以得到解答

kbisi

kbisi 發(fā)表于 2021-11-28 10:05
Dim swApp As Object
Dim Part As Object
1 h$ G8 L9 u( r3 c1 K. Y% [Dim sldPath As String

/ }1 g4 G. E' `5 N9 ~2 n  B" B和樓主一樣打不開裝配體

357755306b

多少積分可以分享

xinshiji666

kbisi 發(fā)表于 2021-11-28 13:44
希望可以得到解答

# X; Y& Z" A4 F$ d3 J$ C$ p無法打開裝配體文件，是因為你把文件類型判定的語句放在循環(huán)外了，挪到do...loop內即可，那個call語句調用了什么？用不上可以先屏蔽。
' r3 {. p7 D: u. p* M5 ?經過測試，下面的程序可正常打開零件和裝配體

/ {1 G" b' Y% w; ?. i4 B' ******************************************************************************
" _. Y' `" |5 E5 u6 F6 k' 讀取指定目錄下的Prt/asm文件，關閉
; G2 e1 c: Z  p% ^; y1 l' ******************************************************************************
9 [6 G0 T8 |$ d$ `9 iDim swApp As Object
- B* ?' p6 j- d# F2 G
Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
: _! a1 `& u! w4 b/ Z' Q$ _'Dim sldPath As String
Const sldPath As String = "E:\3Dtest\BOM1\"  '設定目錄
  d# j  z$ _$ b7 V  J
9 K4 y' I. A" o! u! |2 V; R$ f7 iSub main()
7 _1 s0 c; n$ n' U9 V
( C: b. ]. ^0 v# n. |    Set swApp = _
    Application.SldWorks
, r& H/ A6 L% t7 Y    Set Part = swApp.ActiveDoc
        
* M- p, [; q) Q, s$ H' f, `+ i    swFileName = Dir(sldPath & "*.sld*")

    Do While swFileName <> ""
- e2 E4 J8 Z. O+ l        Set swApp = Application.SldWorks
. ~7 B; I' J7 G9 T6 g        If UCase(Right(swFileName, 3)) = "PRT" Then swFileTYpe = 1
        If UCase(Right(swFileName, 3)) = "ASM" Then swFileTYpe = 2
/ R9 w. W" x$ m1 P
! Q+ s$ @' O" n; `; h3 o" g$ m        Set swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)
        Set Part = swApp.ActiveDoc
        'Call plmain
        'Part.Save '保存
2 {8 V- \! @6 W. U% @' o( U        swApp.CloseDoc (swFileName) '關閉零件
& B; n/ Q) I0 d6 Q# ]        If swFileName = "" Then Exit Do:
        swFileName = Dir '搜尋下一個零件檔案名稱
    Loop '循環(huán)搜尋

End Sub
1 A3 q% ?0 H. E5 }1 M+ c$ H

  ^% @& X' J. i' R7 p! h

Ali.

能提供你成功運行的一個代打為參考嗎我的一直報錯
8 G( ~& A  m! D! a  ]