solidworks 批量執(zhí)行宏

knight3732449

觀摩一下

受傷的仙人球

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

kbisi

Dim swApp As Object
Dim Part As Object
7 B, K2 t8 C3 P& _! U; \Dim sldPath As String
0 |! I: L0 u$ b5 Z1 b/ p
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
! M8 ~' x& b, \; A; E* a
8 e% x  z1 s1 _
# I# u2 t# X+ b" D* k/ n  d! t

# j' v: y! Z2 i: NSub Test()
. A2 D; I+ U# t9 z8 v3 fSet swApp = Application.SldWorks
sldPath = "C:\Users\kbisi\Desktop\實驗\" '設定目錄

swFileName = Dir(sldPath & "*.sld*")  '搜尋首個零件檔案名稱
; ~2 W4 ~# @% n0 ]$ V: NIf UCase(Right(swFileName, 3)) = "PRT" Then swFileTYpe = 1
8 ]- X: H' e5 U- l  v+ ]If UCase(Right(swFileName, 3)) = "ASM" Then swFileTYpe = 2
* {+ L) L( Z- ]7 j2 N) b0 B" p
8 h5 [9 S' c0 ADo While swFileName <> ""

Set swApp = Application.SldWorks
8 L  m" ]9 p( M( e9 s5 ^2 \8 Z
2 d% c% K, o  R6 G& T+ ['Set swDoc = swApp.OpenDoc(sldPath & swFileName, swFileTYpe) '開啟零件
" z* L4 ~; F& j; R
Set swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)



4 h" Y: q/ G6 J/ O
$ L4 Z6 I3 D5 w- O' X% F
Set Part = swApp.ActiveDoc
7 _" n# h) D# k6 ?% {- _7 N
: \; A0 r: E# }8 [5 WCall plmain
8 C& C' u4 U, x7 k  F, `+ G

'
$ g- h8 A* a5 g' t5 R6 d


Part.Save '保存%
0 g- \' p+ J8 t$ R- u* A, e4 @swApp.CloseDoc (swFileName) '關閉零件

If swFileName = "" Then Exit Do


swFileName = Dir '搜尋下一個零件檔案名稱0
- h! s3 x5 o" J* J
+ r6 r0 l7 Q" C  WLoop '循環(huán)搜尋
- ]6 i4 ]$ z0 d+ vEnd Sub
按F8一行看程序錯誤為什么老是跳過Then swFileTYpe = 2

kbisi

Dim swApp As Object
9 A9 c' ]8 r  i: g  M, ]Dim Part As Object
  h/ C- h& u$ L8 V* eDim sldPath As String
5 s2 C' I7 `8 E/ q
1 j3 d3 @; C/ G/ {" ADim boolstatus As Boolean
, M* {, i2 \" y2 n/ I1 x) wDim longstatus As Long, longwarnings As Long
6 [) A) `" p) \2 G6 U! t

6 R+ U& t& H' b6 _0 I
) q4 i" m. W9 G
Sub Test()
Set swApp = Application.SldWorks
. Z) y! B, w0 C, Y/ dsldPath = "C:\Users\kbisi\Desktop\實驗\" '設定目錄

swFileName = Dir(sldPath & "*.sld*")  '搜尋首個零件檔案名稱
! x/ @# r) N. h- N0 n( W1 b* x! F" QIf UCase(Right(swFileName, 3)) = "PRT" Then swFileTYpe = 1
If UCase(Right(swFileName, 3)) = "ASM" Then swFileTYpe = 2
5 w3 y1 k! p7 a; F% h
Do While swFileName <> ""
9 C5 Z  J5 B, x; J) l* F  v
0 V% \) x# x1 p3 u% S8 fSet swApp = Application.SldWorks

# g  W7 F. o2 i9 O2 a'Set swDoc = swApp.OpenDoc(sldPath & swFileName, swFileTYpe) '開啟零件

+ z6 Q/ l0 p& \' C+ h2 G! o- HSet swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)

3 G' |, [/ |0 X0 a  _, s


9 L& l" x' @: r. Z! @* Y  N
Set Part = swApp.ActiveDoc

Call plmain
$ m! g7 I, v! v& v- Z  |

'
2 L# x' p" N4 X2 |  ]$ t
5 S) B$ x2 G- a
/ D+ e/ n9 T" L+ f
Part.Save '保存%
# a& f3 c& f2 F  D* k( k( `1 kswApp.CloseDoc (swFileName) '關閉零件
' ^7 g2 w6 m: r& q$ b( V  Q! p9 @
0 U4 n2 {0 N- m& w0 `; {* w' g: OIf swFileName = "" Then Exit Do
2 m  Q5 {( G0 g0 E9 P6 k
1 Z* g, T/ W9 H8 h
4 ~7 D# l( v  H5 P% _swFileName = Dir '搜尋下一個零件檔案名稱0

0 z- t0 d- t' e: pLoop '循環(huán)搜尋
End Sub

kbisi

Dim swApp As Object
4 e  u6 d" P6 J: dDim Part As Object
Dim sldPath As String
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
& [+ [8 g9 C# zSub Test()
Set swApp = Application.SldWorks
sldPath = "C:\Users\kbisi\Desktop\實驗\" '設定目錄
- {8 L9 s8 P2 LswFileName = Dir(sldPath & "*.sld*")  '搜尋首個零件檔案名稱
If UCase(Right(swFileName, 3)) = "PRT" Then swFileTYpe = 1
If UCase(Right(swFileName, 3)) = "ASM" Then swFileTYpe = 2
) E( c  R$ v7 q" J' k; nDo While swFileName <> ""
  n% t" Z; i8 [  T& MSet swApp = Application.SldWorks
'Set swDoc = swApp.OpenDoc(sldPath & swFileName, swFileTYpe) '開啟零件
# r9 R* R! t6 L% T* iSet swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)
2 [, R) C! b# c3 r9 I. ~Set Part = swApp.ActiveDoc
Call plmain
Part.Save '保存%
swApp.CloseDoc (swFileName) '關閉零件
If swFileName = "" Then Exit Do
5 _. d/ ]0 A+ TswFileName = Dir '搜尋下一個零件檔案名稱0
1 U4 M( @, x7 d& ~Loop '循環(huán)搜尋
End Sub   老是被跳過

kbisi

kbisi 發(fā)表于 2021-11-28 10:05
Dim swApp As Object
' C" t& ^. x: e/ qDim Part As Object
0 }2 r5 k2 S# R3 O3 n7 ~  RDim sldPath As String

希望可以得到解答

kbisi

kbisi 發(fā)表于 2021-11-28 10:05
* l+ \3 d! g, v' R1 RDim swApp As Object
1 q1 G: {5 d, F# C7 hDim Part As Object
Dim sldPath As String

: u' Y# b' c0 {/ _6 f4 m8 n和樓主一樣打不開裝配體

357755306b

多少積分可以分享

xinshiji666

kbisi 發(fā)表于 2021-11-28 13:44
0 c! [0 F( |* M0 c6 j希望可以得到解答

無法打開裝配體文件，是因為你把文件類型判定的語句放在循環(huán)外了，挪到do...loop內(nèi)即可，那個call語句調(diào)用了什么？用不上可以先屏蔽。
經(jīng)過測試，下面的程序可正常打開零件和裝配體
2 f3 |7 x5 `/ u, c( L5 c
) q( ]% q& i  k6 z4 c0 ]' ******************************************************************************
5 L/ j8 h9 p) A' 讀取指定目錄下的Prt/asm文件，關閉
9 Y# a9 f: e* I# E  R! O8 k( R' ******************************************************************************
+ q3 D7 ]4 }% F. }Dim swApp As Object
3 e9 ?. g% o$ w/ y  M2 f
; W5 J, K2 v  B, ^8 _7 W" G+ p) HDim Part As Object
4 W8 h" o$ v: \  g+ x( r5 kDim boolstatus As Boolean
' I  M) l# |7 A! a  B8 e6 pDim longstatus As Long, longwarnings As Long
'Dim sldPath As String
Const sldPath As String = "E:\3Dtest\BOM1\"  '設定目錄

- j: f& z7 C' `4 }* m/ aSub main()
( p+ K$ N5 W$ Y3 R' g. i
    Set swApp = _
    Application.SldWorks
    Set Part = swApp.ActiveDoc
: d9 W9 Z/ I5 d* H        
    swFileName = Dir(sldPath & "*.sld*")
+ A+ J1 W: R, T8 @8 E
    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
* w  ^. `, Q: J( ~/ `7 i
        Set swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)
2 F: b" I0 ], G        Set Part = swApp.ActiveDoc
        'Call plmain
  L/ L# ~2 C1 z+ G- E  w# a6 W2 @        'Part.Save '保存
# j! o2 b( y; |# l" E0 w* A        swApp.CloseDoc (swFileName) '關閉零件
, ^4 w$ N0 o5 _. E7 w$ a        If swFileName = "" Then Exit Do:
5 j2 V' r( n* D& t        swFileName = Dir '搜尋下一個零件檔案名稱
    Loop '循環(huán)搜尋

End Sub

4 X) T. ?1 A7 u" C& u

Ali.

能提供你成功運行的一個代打為參考嗎我的一直報錯