solidworks 批量執行宏

knight3732449

觀摩一下

受傷的仙人球

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

kbisi

Dim swApp As Object
: I8 [0 q3 H- S7 X* c3 eDim Part As Object
Dim sldPath As String
$ n; v0 D& A: f" t3 q
Dim boolstatus As Boolean
5 w& J6 n- ^) ~) J. p7 WDim longstatus As Long, longwarnings As Long
9 J7 ?" s# ~* e3 \
; e+ Y$ S" [& _. _, k! |

6 l  E& z& t/ q; u9 q* f1 k: l9 C
Sub Test()
3 t; k( Y' k7 T: {8 o: ~. \8 MSet swApp = Application.SldWorks
sldPath = "C:\Users\kbisi\Desktop\實驗\" '設定目錄
+ y" b4 G+ `, w. d& E& }
% r/ D! W9 p$ BswFileName = Dir(sldPath & "*.sld*")  '搜尋首個零件檔案名稱
If UCase(Right(swFileName, 3)) = "PRT" Then swFileTYpe = 1
If UCase(Right(swFileName, 3)) = "ASM" Then swFileTYpe = 2
) ~/ }  V% ~0 ]  l8 G
Do While swFileName <> ""

- l  [+ k" Z, u5 }( M  bSet swApp = Application.SldWorks
( }# a) e/ X7 A( V% O
'Set swDoc = swApp.OpenDoc(sldPath & swFileName, swFileTYpe) '開啟零件

7 b; ~& O4 ^: N/ v: S  mSet swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)
' x9 B8 m, A! X
* w: E& X' u3 q
2 l9 Q& m& L+ L$ \1 o, ^


. h- t2 g% @$ ?- L9 e' e+ b) e; tSet Part = swApp.ActiveDoc

Call plmain
4 F0 i" r& M2 U5 g* m3 A

+ G, o# Y3 g- L  H'
9 w* P6 e* O3 m

' v) C) |, e  K: N1 D
. |" D( q# [( r" cPart.Save '保存%
swApp.CloseDoc (swFileName) '關閉零件
. F, l/ h  M9 M, b# x* H$ h" @
If swFileName = "" Then Exit Do
6 L9 D) x  {2 a

$ I0 O# i. X& _/ P; N! v: FswFileName = Dir '搜尋下一個零件檔案名稱0
/ U$ S( g7 q  X' S" \+ m
Loop '循環搜尋
5 |; X9 E' I( N: b6 O: lEnd Sub
按F8一行看程序錯誤為什么老是跳過Then swFileTYpe = 2

kbisi

Dim swApp As Object
: O6 h& L; ~% K# G8 \! r- `Dim Part As Object
Dim sldPath As String

Dim boolstatus As Boolean
5 @  q. G1 I0 E, j: PDim longstatus As Long, longwarnings As Long
; _2 b) P* M: K8 ~, o# ]# N$ h
) p( h0 E, T* S3 A) u1 K

5 ]! b$ ?% L5 t1 F1 B; _+ p$ W8 H( |
, g8 K$ Y  |. k& z  |5 _& P" cSub Test()
8 w5 T, r$ |0 m6 r* o1 H! _Set swApp = Application.SldWorks
% p2 l2 \6 t( s2 w6 Q  z' B* esldPath = "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

  q, P! @: u( E3 e% k* K  |8 |Do While swFileName <> ""

Set swApp = Application.SldWorks
% J/ O( e; E1 t2 m+ F
% `2 I* R" |6 y4 k" c'Set swDoc = swApp.OpenDoc(sldPath & swFileName, swFileTYpe) '開啟零件

Set swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)

& ^8 s$ E3 x2 H: E& O; p0 n
" z* H( b4 x! ~3 H8 i

# E: c/ t! p8 _' }# T( M8 y8 S3 h
; c! r% S) |9 B0 Q9 H0 b) ySet Part = swApp.ActiveDoc

Call plmain


4 A( C8 N% ~: s'

5 R1 F. @' u2 D$ F

1 y! `) O0 a$ a7 U/ L5 P3 fPart.Save '保存%
4 m) T# q4 R6 O$ lswApp.CloseDoc (swFileName) '關閉零件
& @2 t2 `7 Z" k% M/ S
If swFileName = "" Then Exit Do


! X6 E. p  r8 M1 v1 m3 X! _swFileName = Dir '搜尋下一個零件檔案名稱0

$ R- |  _4 a8 C" U" TLoop '循環搜尋
- X  ?/ u3 K8 M9 C6 d: l, qEnd Sub

kbisi

Dim swApp As Object
Dim Part As Object
Dim sldPath As String
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
( X1 Q- m- x; S% A6 f4 jSub Test()
Set swApp = Application.SldWorks
5 P% ?! D" p6 F9 I; s7 dsldPath = "C:\Users\kbisi\Desktop\實驗\" '設定目錄
, |- {. {: O. [- j0 Q  S$ J% tswFileName = Dir(sldPath & "*.sld*")  '搜尋首個零件檔案名稱
  S6 Y) i" B. C) q$ k+ `If UCase(Right(swFileName, 3)) = "PRT" Then swFileTYpe = 1
If UCase(Right(swFileName, 3)) = "ASM" Then swFileTYpe = 2
9 J( t& Z( {% g3 eDo While swFileName <> ""
Set swApp = Application.SldWorks
8 {3 T( u3 l4 K) R6 O'Set swDoc = swApp.OpenDoc(sldPath & swFileName, swFileTYpe) '開啟零件
Set swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)
& b5 h, Q. |/ PSet Part = swApp.ActiveDoc
Call plmain
4 {  N4 k: M# XPart.Save '保存%
- B5 ]6 U6 t  b  `% |! lswApp.CloseDoc (swFileName) '關閉零件
If swFileName = "" Then Exit Do
) e+ S; V+ F9 H6 d+ ~6 h9 }+ nswFileName = Dir '搜尋下一個零件檔案名稱0
+ z' p7 ~/ n& j0 ]5 ?2 E; gLoop '循環搜尋
End Sub   老是被跳過

kbisi

kbisi 發表于 2021-11-28 10:05
Dim swApp As Object
Dim Part As Object
& Y5 P- B* x' H1 ]! a' ?Dim sldPath As String

. E" p% P8 s1 C! u9 u3 |希望可以得到解答
# G9 u, M5 C: |* j. m& I2 b

kbisi

kbisi 發表于 2021-11-28 10:05
' \5 w# X1 X0 p! J& H% p6 S9 lDim swApp As Object
Dim Part As Object
Dim sldPath As String

9 N- H4 H" g$ O* C9 W和樓主一樣打不開裝配體

357755306b

多少積分可以分享

xinshiji666

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

無法打開裝配體文件，是因為你把文件類型判定的語句放在循環外了，挪到do...loop內即可，那個call語句調用了什么？用不上可以先屏蔽。
) t4 N& \: A4 A* ~% P1 s% U1 \3 e% F* t經過測試，下面的程序可正常打開零件和裝配體

' ******************************************************************************
' 讀取指定目錄下的Prt/asm文件，關閉
: d- C- @1 }7 _+ ?9 b' ******************************************************************************
2 f& S/ I9 Q: g/ {% |- C) ~; dDim swApp As Object
) g0 p$ H- o3 b9 E  H( z! @0 R
2 Q4 M6 s% Q' e( O5 |" UDim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
'Dim sldPath As String
' y4 L0 R# i9 R* P( y' ^3 A  F; |% qConst sldPath As String = "E:\3Dtest\BOM1\"  '設定目錄
0 m- V: `, M  N7 e: h; `. v+ D, [
Sub main()
+ I* E0 n- D2 D$ p! h  w( S
    Set swApp = _
% ]$ B9 {8 R  |: o1 ?: |7 c/ h    Application.SldWorks
9 a  P. ?8 ?! u! f( ?* s' u    Set Part = swApp.ActiveDoc
( O# `$ p! p1 j5 P" M: `  W        
  q2 J- b/ q2 }  p    swFileName = Dir(sldPath & "*.sld*")

' u- a+ y1 j( ]! ~    Do While swFileName <> ""
# o- e5 f8 I0 n2 z        Set swApp = Application.SldWorks
9 J6 Q7 h9 {1 m- G# Y        If UCase(Right(swFileName, 3)) = "PRT" Then swFileTYpe = 1
+ v' u) ]) {% g* K% \        If UCase(Right(swFileName, 3)) = "ASM" Then swFileTYpe = 2

        Set swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)
        Set Part = swApp.ActiveDoc
        'Call plmain
        'Part.Save '保存
  g& K) ], Q! J/ l' I8 c" d; U+ n        swApp.CloseDoc (swFileName) '關閉零件
3 U! Z, L, w( `4 {0 ]; U. ?! q        If swFileName = "" Then Exit Do:
        swFileName = Dir '搜尋下一個零件檔案名稱
    Loop '循環搜尋

7 D% b4 I6 ], W8 K) u; e0 sEnd Sub

2 m0 \! U* o0 z$ n4 c4 G% T+ k* L! s
2 ?; o9 w3 o' x7 i, X3 Z1 F, i

Ali.

能提供你成功運行的一個代打為參考嗎我的一直報錯
( L5 ]" L% z- J8 A9 ^: O
0 @! g5 Q! g' h$ T. A6 C