solidworks 批量執行宏

knight3732449

觀摩一下

受傷的仙人球

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

kbisi

Dim swApp As Object
Dim Part As Object
Dim sldPath As String
+ q( e( F8 R! {' H" F
Dim boolstatus As Boolean
# ^4 p! m; v, H- R; [. TDim longstatus As Long, longwarnings As Long

% C/ W; A6 B+ ?3 i9 h8 L6 @0 y4 L( C8 A

! _1 L3 o0 P  L5 s. N
Sub Test()
9 B3 g( J& L% QSet swApp = Application.SldWorks
  a$ n8 t; q( N3 ~sldPath = "C:\Users\kbisi\Desktop\實驗\" '設定目錄

  `+ e7 ~, V3 M. y. Y0 V3 yswFileName = Dir(sldPath & "*.sld*")  '搜尋首個零件檔案名稱
If UCase(Right(swFileName, 3)) = "PRT" Then swFileTYpe = 1
If UCase(Right(swFileName, 3)) = "ASM" Then swFileTYpe = 2

/ l# R. q1 y) j0 q  p* t9 f5 uDo While swFileName <> ""

3 C- H7 P/ j3 A& o/ G/ cSet swApp = Application.SldWorks
4 @3 u: ]; V% a; |& l4 h9 D) c
! E2 ?! b: M# [5 Y'Set swDoc = swApp.OpenDoc(sldPath & swFileName, swFileTYpe) '開啟零件
2 I5 s- |( u7 Q" _$ r+ q4 Y0 j3 o5 ?
Set swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)
+ ]8 U' h( S$ j' x( x/ V

. H7 F' S5 {) V% q! A
* z: n- Z: E; i6 i0 ]# d* f

Set Part = swApp.ActiveDoc

5 X# R5 `+ @) [) h0 Z% eCall plmain
) y' ]" \1 X: B* _1 X/ R0 ?3 |" s
" f- ^' b! f' @8 ~1 K4 c' k% z/ U. D
'

& U4 q( \9 @2 y& ~2 B+ I

* u' g- ^+ Q) j, f. i/ FPart.Save '保存%
swApp.CloseDoc (swFileName) '關閉零件

: f+ W5 w7 ?# GIf swFileName = "" Then Exit Do

# l( ]6 h6 T. Z- ?" F0 P
- g# S, L. e, r' NswFileName = Dir '搜尋下一個零件檔案名稱0

4 \9 S( z8 i2 k" C- o6 h. t- DLoop '循環搜尋
End Sub
6 I6 @6 a7 W7 I" A6 i! l按F8一行看程序錯誤為什么老是跳過Then swFileTYpe = 2

kbisi

Dim swApp As Object
* M7 j4 Y2 |( HDim Part As Object
: b; l$ m9 L. XDim sldPath As String
% m+ t, S9 c+ H+ [0 c" u6 g
3 @. c* y! B6 v2 E1 v/ wDim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
, }3 S! F* _( P; z9 z4 @7 L& V
  F- p3 ?, r7 C# U
+ h+ b4 O( J+ k, J: o/ w- a8 [
' F7 Q# x* a; s
) ~+ Z" D8 |' R! G9 HSub Test()
* z( K0 d: _$ ]) O' Z3 ~7 Y- l5 LSet swApp = Application.SldWorks
0 f5 q+ Z$ t0 l; r( z9 r6 @sldPath = "C:\Users\kbisi\Desktop\實驗\" '設定目錄
. y, H: l; z, e2 \* S# ]
swFileName = Dir(sldPath & "*.sld*")  '搜尋首個零件檔案名稱
7 c, {1 ?3 ?7 d2 R! k4 ~If UCase(Right(swFileName, 3)) = "PRT" Then swFileTYpe = 1
& Q' i9 [- T# ~: QIf UCase(Right(swFileName, 3)) = "ASM" Then swFileTYpe = 2
0 ^+ B- P$ r1 D
Do While swFileName <> ""

Set swApp = Application.SldWorks

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

8 L/ L* x3 M" m' u8 T2 }. uSet swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)
8 N4 y  p( Z7 c

9 F2 R! ?/ R5 c+ V
7 C2 P4 n% g2 M. J. l

Set Part = swApp.ActiveDoc

Call plmain
/ t0 e  `, Y% C! F
4 ~& N  U* U. N
3 E- P( A6 M  {( o6 U7 E! j+ H'


9 Q. b3 k" G6 }+ r# h3 J
Part.Save '保存%
swApp.CloseDoc (swFileName) '關閉零件
) u+ D: z4 ~+ G8 v1 S( {- l
If swFileName = "" Then Exit Do

# ~/ R9 u1 ]1 a0 C4 r' |- z5 X4 g) O1 y
swFileName = Dir '搜尋下一個零件檔案名稱0
0 i0 A! `8 W9 Y# L, o
Loop '循環搜尋
End Sub

kbisi

Dim swApp As Object
Dim Part As Object
* B9 b2 D: i3 ]( kDim sldPath As String
5 C9 D! d" \8 ^5 h% s1 U0 V( ]# RDim boolstatus As Boolean
# o1 z' c0 Y8 m% q% ?9 BDim longstatus As Long, longwarnings As Long
Sub Test()
  u4 Q# T4 L" E7 N* QSet swApp = Application.SldWorks
sldPath = "C:\Users\kbisi\Desktop\實驗\" '設定目錄
% E: Y4 W9 J, c2 h  JswFileName = Dir(sldPath & "*.sld*")  '搜尋首個零件檔案名稱
If UCase(Right(swFileName, 3)) = "PRT" Then swFileTYpe = 1
If UCase(Right(swFileName, 3)) = "ASM" Then swFileTYpe = 2
Do While swFileName <> ""
, u& W/ y) y: d; x, x* N; C% LSet swApp = Application.SldWorks
'Set swDoc = swApp.OpenDoc(sldPath & swFileName, swFileTYpe) '開啟零件
) n+ B# k8 c& w! s% G! gSet swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)
1 b! _0 i. e( X, lSet Part = swApp.ActiveDoc
! g8 J6 J8 _9 X  _; k4 h9 {Call plmain
0 A" K# w+ ?2 E- n8 o$ pPart.Save '保存%
swApp.CloseDoc (swFileName) '關閉零件
$ q, N5 h' ?- q  nIf swFileName = "" Then Exit Do
/ f; Z" s7 \' R/ c# b6 m# V) LswFileName = Dir '搜尋下一個零件檔案名稱0
6 a- J+ h& O% w& j* N* TLoop '循環搜尋
End Sub   老是被跳過

kbisi

kbisi 發表于 2021-11-28 10:05
& @6 d) [( D/ aDim swApp As Object
0 P% l+ H* `$ w1 ~5 f- X3 m! A0 SDim Part As Object
9 B" K3 o! F3 m6 i) D, X3 B" N4 I+ RDim sldPath As String

) ]4 A+ F4 ?$ \; b3 k8 D! k5 p3 l希望可以得到解答

kbisi

kbisi 發表于 2021-11-28 10:05
0 t# \) X2 X1 bDim swApp As Object
# U( V6 b- x) i6 e. c6 o5 y3 t8 f& m6 ADim Part As Object
& Q7 z+ g0 a. L8 n! Q0 Z2 GDim sldPath As String

和樓主一樣打不開裝配體

357755306b

多少積分可以分享

xinshiji666

kbisi 發表于 2021-11-28 13:44
0 c4 z0 Q- t& C! x8 b希望可以得到解答

無法打開裝配體文件，是因為你把文件類型判定的語句放在循環外了，挪到do...loop內即可，那個call語句調用了什么？用不上可以先屏蔽。
經過測試，下面的程序可正常打開零件和裝配體

' ******************************************************************************
( x0 L$ C$ o4 t7 Y5 Q( M4 m$ h0 x' 讀取指定目錄下的Prt/asm文件，關閉
' ******************************************************************************
Dim swApp As Object

0 B" D! B1 O' @( b- V) l3 [2 T! rDim Part As Object
1 M$ A" {. ^& h8 yDim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
'Dim sldPath As String
Const sldPath As String = "E:\3Dtest\BOM1\"  '設定目錄
; M3 J$ B% m. I1 G; w
7 N9 s" t" h3 mSub main()
2 ^. |7 x4 W8 V+ ]
3 b0 {8 h- m5 o/ N    Set swApp = _
    Application.SldWorks
    Set Part = swApp.ActiveDoc
        
+ t! O' o0 k! Y' t7 f: J6 m    swFileName = Dir(sldPath & "*.sld*")
4 O( W* z! _+ I3 h+ [
    Do While swFileName <> ""
3 Q! D7 h" I$ _* V5 r        Set swApp = Application.SldWorks
( b$ ^' d9 G! K1 P  I        If UCase(Right(swFileName, 3)) = "PRT" Then swFileTYpe = 1
        If UCase(Right(swFileName, 3)) = "ASM" Then swFileTYpe = 2

8 |9 T$ h% g. C. l0 U" x        Set swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)
        Set Part = swApp.ActiveDoc
- C1 N0 o$ c# V6 K5 S2 j. t        'Call plmain
        'Part.Save '保存
+ [/ S# ?' r, c6 ~; u        swApp.CloseDoc (swFileName) '關閉零件
0 x: B4 t+ x: ~) M9 S7 {; K9 }# K        If swFileName = "" Then Exit Do:
        swFileName = Dir '搜尋下一個零件檔案名稱
    Loop '循環搜尋
4 S4 p& l" d/ p# r1 C8 l
End Sub


: }3 _& U; S, \  N

Ali.

能提供你成功運行的一個代打為參考嗎我的一直報錯
0 g$ P5 d/ C, k' I$ w- u4 ?# d/ L