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ì)寫(xiě),，有沒(méi)有大佬幫幫忙嗚嗚嗚）

kbisi

Dim swApp As Object
Dim Part As Object
Dim sldPath As String

Dim boolstatus As Boolean
& k+ {; X: @4 mDim longstatus As Long, longwarnings As Long
8 g: D8 e) p4 K' T7 t
, T6 s1 P. r' J" @/ F

% k/ l7 P6 [/ V6 q5 u8 v3 [; T! U
( g% @- g3 q# W' V1 ?. nSub Test()
2 ?. j- I0 F2 M8 s3 v$ {Set swApp = Application.SldWorks
! t1 m8 Q" y% X9 W- ~3 {sldPath = "C:\Users\kbisi\Desktop\實(shí)驗(yàn)\" '設(shè)定目錄

swFileName = Dir(sldPath & "*.sld*")  '搜尋首個(gè)零件檔案名稱
2 F" y& T' F& l# G2 z3 r( A7 cIf UCase(Right(swFileName, 3)) = "PRT" Then swFileTYpe = 1
; U# T1 R+ \3 A( wIf UCase(Right(swFileName, 3)) = "ASM" Then swFileTYpe = 2
! j* p7 x8 u, a  q" {) Y
) u% y4 p" L! dDo While swFileName <> ""

% {, L5 j4 @* m+ L% e. O" MSet swApp = Application.SldWorks

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

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

. `+ v3 d9 N, Y9 |5 j& h
. i3 |: W; ]: y' o$ C9 F  {9 I


. a  T+ f; n4 E4 t: ]Set Part = swApp.ActiveDoc
  |4 c4 v( r( j; o
Call plmain
$ G% ^8 L  h2 F/ t& i1 ?5 k% u

'



Part.Save '保存%
swApp.CloseDoc (swFileName) '關(guān)閉零件
8 ?, G7 `! N$ [: h. |
If swFileName = "" Then Exit Do
  j( E2 s; f4 d  d1 [

swFileName = Dir '搜尋下一個(gè)零件檔案名稱0

Loop '循環(huán)搜尋
; N  ?: i4 q; ~+ \# e8 z7 rEnd Sub
: L7 M. O; E0 d5 F7 b$ y$ I按F8一行看程序錯(cuò)誤為什么老是跳過(guò)Then swFileTYpe = 2

kbisi

Dim swApp As Object
Dim Part As Object
* P2 b5 u! b7 Y" [- R% [5 J6 XDim sldPath As String

: k9 a; X' l" [8 n/ a, WDim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
2 v& ^+ V  J; U5 i, H4 V
, F* O6 T+ J9 P$ X6 ]
) |( Z% h/ z( ?+ r, T" k# z  u6 x

Sub Test()
Set swApp = Application.SldWorks
sldPath = "C:\Users\kbisi\Desktop\實(shí)驗(yàn)\" '設(shè)定目錄

9 {! b! T( v) E; _! S) Z8 aswFileName = Dir(sldPath & "*.sld*")  '搜尋首個(gè)零件檔案名稱
; _( h& w; z0 R; u  g- h! p6 vIf UCase(Right(swFileName, 3)) = "PRT" Then swFileTYpe = 1
If UCase(Right(swFileName, 3)) = "ASM" Then swFileTYpe = 2
( l9 Y; P6 n+ L' @1 `4 }
1 \2 c  i/ G" hDo While swFileName <> ""
1 E9 `( T' e0 A4 h
% c- R. e+ C( Z+ vSet swApp = Application.SldWorks
  J1 q' A4 D3 `/ p' \$ E  m# B0 C
4 I/ ~. G& ^4 U% r; A9 a'Set swDoc = swApp.OpenDoc(sldPath & swFileName, swFileTYpe) '開(kāi)啟零件

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

9 Y3 X7 h* M$ s
3 ?/ X* H4 r+ D4 C3 X
! c; _7 d1 n% j1 u$ g" q, y

) c& i3 ?' s& d$ J' KSet Part = swApp.ActiveDoc

9 A+ c6 H2 }& CCall plmain
6 t( \5 N% `4 W; t4 \" \/ a6 Z
5 x% O. {8 K/ L
'

" \; v6 J! o7 Q% w+ K% h" I  Y
: M, U- e2 L* @" q2 b9 k
Part.Save '保存%
3 M+ h9 E. t8 @/ ]( \swApp.CloseDoc (swFileName) '關(guān)閉零件

If swFileName = "" Then Exit Do


1 g- l& X+ T$ a, R5 a( J+ c; \. c. ~swFileName = Dir '搜尋下一個(gè)零件檔案名稱0
& _( l5 P2 e9 h7 v6 q+ R1 Z
Loop '循環(huán)搜尋
  U) o4 H3 q* h2 d6 v$ M3 _) UEnd Sub

kbisi

Dim swApp As Object
, t; \# H6 o8 @/ @7 CDim Part As Object
# ]  d' p# ]) i4 ~+ ~/ _9 sDim sldPath As String
Dim boolstatus As Boolean
" g1 L0 B) O# h5 z% L* v5 b$ TDim longstatus As Long, longwarnings As Long
Sub Test()
5 Y( s; s" C) h2 }2 Z* aSet swApp = Application.SldWorks
sldPath = "C:\Users\kbisi\Desktop\實(shí)驗(yàn)\" '設(shè)定目錄
swFileName = Dir(sldPath & "*.sld*")  '搜尋首個(gè)零件檔案名稱
; v$ `3 H" L* V" ^6 iIf UCase(Right(swFileName, 3)) = "PRT" Then swFileTYpe = 1
7 V" N# J0 E8 @! kIf UCase(Right(swFileName, 3)) = "ASM" Then swFileTYpe = 2
Do While swFileName <> ""
Set swApp = Application.SldWorks
( r9 J- B% j% ~1 s6 K! Z0 C'Set swDoc = swApp.OpenDoc(sldPath & swFileName, swFileTYpe) '開(kāi)啟零件
Set swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)
Set Part = swApp.ActiveDoc
/ G  b- A5 ]; U! Y% ]8 ^# hCall plmain
Part.Save '保存%
swApp.CloseDoc (swFileName) '關(guān)閉零件
If swFileName = "" Then Exit Do
swFileName = Dir '搜尋下一個(gè)零件檔案名稱0
Loop '循環(huán)搜尋
/ R  S: Q0 r! X: VEnd Sub   老是被跳過(guò)

kbisi

kbisi 發(fā)表于 2021-11-28 10:05
Dim swApp As Object
- f8 t2 [, J. I0 P+ CDim Part As Object
0 k% S0 w; V4 d2 P2 [1 S7 \Dim sldPath As String

希望可以得到解答
1 K6 W* i! s4 y

kbisi

kbisi 發(fā)表于 2021-11-28 10:05
6 ^3 K  {( H+ I1 m0 {Dim swApp As Object
/ b9 N# @0 x5 l+ x5 u' t, EDim Part As Object
Dim sldPath As String

$ k# H7 v3 T. {* H  H和樓主一樣打不開(kāi)裝配體
4 Y& a6 D7 \0 a( I9 l" E

357755306b

多少積分可以分享

xinshiji666

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

無(wú)法打開(kāi)裝配體文件,，是因?yàn)槟惆盐募��?lèi)型判定的語(yǔ)句放在循環(huán)外了，挪到do...loop內(nèi)即可,，那個(gè)call語(yǔ)句調(diào)用了什么,？用不上可以先屏蔽。
經(jīng)過(guò)測(cè)試,，下面的程序可正常打開(kāi)零件和裝配體
( i9 C8 ], x3 h
' ******************************************************************************
' 讀取指定目錄下的Prt/asm文件,，關(guān)閉
" ~8 x( @8 G& e) U' ******************************************************************************
' [- H# G; T7 ]! d' oDim swApp As Object

7 R% ~$ Y$ x2 ]Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
'Dim sldPath As String
9 F0 U# e7 z# y' R3 c2 i' OConst sldPath As String = "E:\3Dtest\BOM1\"  '設(shè)定目錄
% @3 n: w5 `3 t2 S% D3 U/ [
Sub main()

    Set swApp = _
; {% p/ n. |3 T    Application.SldWorks
    Set Part = swApp.ActiveDoc
- X: d! g% p' }4 t6 d$ x0 K8 u        
    swFileName = Dir(sldPath & "*.sld*")
8 H" q1 o7 h/ y" @5 @+ f3 G
9 T' ]+ _5 b  g# j/ o    Do While swFileName <> ""
& g, S* x! l: s1 P/ q        Set swApp = Application.SldWorks
8 B# k$ c0 w$ o9 v: B        If UCase(Right(swFileName, 3)) = "PRT" Then swFileTYpe = 1
9 e2 g0 V4 T. B+ R8 D        If UCase(Right(swFileName, 3)) = "ASM" Then swFileTYpe = 2
1 e. _, O7 P9 p
3 c" E; k0 U* R6 Y8 G# }; a' B7 S0 a- i        Set swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)
+ b' }- E/ E* Z- I9 x        Set Part = swApp.ActiveDoc
        'Call plmain
/ L+ `8 Y& K) k4 i& p9 ^3 w  m        'Part.Save '保存
1 v- E' \0 d8 e; i& X$ _5 J: t        swApp.CloseDoc (swFileName) '關(guān)閉零件
        If swFileName = "" Then Exit Do:
6 w2 V6 Z6 y9 e& b, `        swFileName = Dir '搜尋下一個(gè)零件檔案名稱
    Loop '循環(huán)搜尋
4 R5 ]' ?; e9 t8 a# S  k4 T
1 }: c" z0 n7 jEnd Sub
$ f( _0 F$ ]; \. J" Y9 j) L
2 b% S- U$ e+ q) j
7 A  |0 i- X/ \# |

Ali.

能提供你成功運(yùn)行的一個(gè)代打?yàn)閰⒖紗嵛业囊恢眻?bào)錯(cuò)
/ E# K2 T; b7 q, o0 u
, B7 [5 ~* r# o8 G. H* r: X0 W0 q& ~1 u) e