solidworks 批量執(zhí)行宏

knight3732449

觀摩一下

受傷的仙人球

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

kbisi

Dim swApp As Object
Dim Part As Object
( y/ n% g* g; o8 s/ ~( B8 B- CDim sldPath As String
' S2 T4 Q1 x4 a+ r) ]" T3 ?' D
1 |- ]& q9 }- K* O& _0 oDim boolstatus As Boolean
9 b+ G' S5 U, [, `Dim longstatus As Long, longwarnings As Long
% e) _+ y: A$ f, I2 A

5 x: W5 e! @# R- o6 D0 w
( x9 o) q4 u6 I) T3 t/ B; ]% Q0 Q& b3 e
Sub Test()
$ N- V9 a  D' ESet swApp = Application.SldWorks
sldPath = "C:\Users\kbisi\Desktop\實驗\" '設(shè)定目錄
5 m$ d( ]2 r0 n0 S' ]4 g/ o, ^; X
swFileName = Dir(sldPath & "*.sld*")  '搜尋首個零件檔案名稱
If UCase(Right(swFileName, 3)) = "PRT" Then swFileTYpe = 1
If UCase(Right(swFileName, 3)) = "ASM" Then swFileTYpe = 2
0 \$ \: r) U7 V2 d
" m2 k$ s* c  v8 |+ K9 ^Do While swFileName <> ""
: K8 J) h  c: @) ^/ H
Set swApp = Application.SldWorks

# C: _7 a6 S5 e- ~0 ?'Set swDoc = swApp.OpenDoc(sldPath & swFileName, swFileTYpe) '開啟零件

Set swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)
" I9 u0 ?; k' L


" V+ U5 {2 d# N

Set Part = swApp.ActiveDoc

# F; ]% d4 R5 z( GCall plmain

+ f0 R' `7 N9 A$ A9 }5 j0 Z0 s
4 C! w; l' p2 S'

! P& p: {9 J. ~8 ^/ m# O- L) F

; R/ v0 x/ `5 p' [9 TPart.Save '保存%
( u9 x' q, f9 g0 `) E3 QswApp.CloseDoc (swFileName) '關(guān)閉零件

If swFileName = "" Then Exit Do
( T4 G* T) n0 ^

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

Loop '循環(huán)搜尋
4 J+ s9 [6 m, fEnd Sub
& N) b8 M- n& \/ ?+ L( m+ q按F8一行看程序錯誤為什么老是跳過Then swFileTYpe = 2

kbisi

Dim swApp As Object
! s6 y: F' a5 t$ A8 p' M5 s: tDim Part As Object
Dim sldPath As String

0 i; [. o  I3 M% c' K& v3 y0 h% y0 xDim boolstatus As Boolean
  P- g9 }/ R9 F$ t" ]( m6 I0 IDim longstatus As Long, longwarnings As Long
0 a9 K5 E* ^. A( G9 ~

1 V- G* @( o8 ^6 J5 T6 M
* G" F! o( |/ c+ V2 q: B9 g4 ~+ A) z
; S+ y7 f) ~, @  I& y3 USub Test()
Set swApp = Application.SldWorks
sldPath = "C:\Users\kbisi\Desktop\實驗\" '設(shè)定目錄

8 l, u- R3 v: [( r* p9 c  [swFileName = Dir(sldPath & "*.sld*")  '搜尋首個零件檔案名稱
& p  J  `$ R! e8 G5 B5 L" a0 @If UCase(Right(swFileName, 3)) = "PRT" Then swFileTYpe = 1
, F: @. S: h* j3 e; G2 Y* @If UCase(Right(swFileName, 3)) = "ASM" Then swFileTYpe = 2

: z( t0 E0 k2 |! _# e0 zDo While swFileName <> ""

Set swApp = Application.SldWorks
7 U1 }$ c9 R3 s9 X, B6 X
'Set swDoc = swApp.OpenDoc(sldPath & swFileName, swFileTYpe) '開啟零件
7 W6 R! H/ x( @; X
Set swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)




8 }$ |; ^, ]1 D' W
- x5 s4 z' U6 Y/ i3 V$ I% c7 Y6 B2 OSet Part = swApp.ActiveDoc

( L6 b9 m3 H; C( l& dCall plmain
" ~& l9 S9 p' E# H( [
$ I9 |0 P% t3 w& U! G# x
'
# [$ q3 v9 _6 L/ _+ r/ \9 K

7 `: R6 H6 n! m1 M3 Q* T
Part.Save '保存%
swApp.CloseDoc (swFileName) '關(guān)閉零件

If swFileName = "" Then Exit Do

; I$ R; F5 Y) }* ^0 F0 f. Y4 c
* Y" n# ^+ G+ G$ v/ N7 CswFileName = Dir '搜尋下一個零件檔案名稱0

& S: m% A' f# p* @3 s& U1 GLoop '循環(huán)搜尋
End Sub

kbisi

Dim swApp As Object
1 R) O6 ?7 Z+ k& wDim Part As Object
; O: C0 `: W2 V  E! n: X. x6 r2 eDim sldPath As String
3 g* s4 T' O: @* m  Y4 NDim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
  ?% L2 X, q) R! G  M+ a6 }5 I& k% tSub Test()
Set swApp = Application.SldWorks
sldPath = "C:\Users\kbisi\Desktop\實驗\" '設(shè)定目錄
; Q+ x& E* V; ~* c, cswFileName = Dir(sldPath & "*.sld*")  '搜尋首個零件檔案名稱
If UCase(Right(swFileName, 3)) = "PRT" Then swFileTYpe = 1
* f0 v9 C/ X2 ~! H% J2 s: B% f  N) aIf UCase(Right(swFileName, 3)) = "ASM" Then swFileTYpe = 2
/ x9 |8 M& R! Q# ]Do While swFileName <> ""
Set swApp = Application.SldWorks
3 s+ t. l! F/ \  Y" p'Set swDoc = swApp.OpenDoc(sldPath & swFileName, swFileTYpe) '開啟零件
Set swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)
Set Part = swApp.ActiveDoc
Call plmain
Part.Save '保存%
2 |; N- a5 M2 aswApp.CloseDoc (swFileName) '關(guān)閉零件
. E% R+ H: V8 EIf swFileName = "" Then Exit Do
- s) e5 B/ B& T: C, n5 A+ QswFileName = Dir '搜尋下一個零件檔案名稱0
Loop '循環(huán)搜尋
End Sub   老是被跳過

kbisi

kbisi 發(fā)表于 2021-11-28 10:05
Dim swApp As Object
% N9 p# @3 ?5 PDim Part As Object
Dim sldPath As String

希望可以得到解答

kbisi

kbisi 發(fā)表于 2021-11-28 10:05
Dim swApp As Object
Dim Part As Object
) E2 ?. X/ N3 w. d+ WDim sldPath As String

) ^/ w* B. \+ i+ a1 y; Z: k和樓主一樣打不開裝配體

357755306b

多少積分可以分享

xinshiji666

kbisi 發(fā)表于 2021-11-28 13:44
) o4 f" N) }5 L( Z希望可以得到解答

無法打開裝配體文件，是因為你把文件類型判定的語句放在循環(huán)外了,，挪到do...loop內(nèi)即可,，那個call語句調(diào)用了什么？用不上可以先屏蔽,。
經(jīng)過測試,，下面的程序可正常打開零件和裝配體
4 b* A3 |% a$ I2 L0 ~7 i; O: V( k' x
' ******************************************************************************
' 讀取指定目錄下的Prt/asm文件，關(guān)閉
' ******************************************************************************
+ d( \& W1 j% D, M0 g0 i9 {6 jDim swApp As Object

- n! q0 W" D; I/ U4 S" }Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
'Dim sldPath As String
Const sldPath As String = "E:\3Dtest\BOM1\"  '設(shè)定目錄
4 M. C$ F' K5 k9 l( |- T0 E  c8 T
Sub main()
0 p/ U2 {. R: R
( t4 o; Q$ P1 S6 c4 ]( j! a7 F1 J    Set swApp = _
, E$ p+ G: O; q6 J% l) D* G    Application.SldWorks
    Set Part = swApp.ActiveDoc
        
    swFileName = Dir(sldPath & "*.sld*")
+ @- `5 Z( j/ m9 c; a* X. _
& _2 F, o4 p- E6 [( \  J    Do While swFileName <> ""
        Set swApp = Application.SldWorks
- f  o# o4 {" ]5 q2 J5 @. E        If UCase(Right(swFileName, 3)) = "PRT" Then swFileTYpe = 1
        If UCase(Right(swFileName, 3)) = "ASM" Then swFileTYpe = 2

2 c) s  S4 m1 B% p& V        Set swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)
        Set Part = swApp.ActiveDoc
8 d! f$ u! b: m        'Call plmain
        'Part.Save '保存
( k5 E: k1 y( n" q3 _+ B, g/ {        swApp.CloseDoc (swFileName) '關(guān)閉零件
        If swFileName = "" Then Exit Do:
) D7 P  D2 Q8 W7 A: V        swFileName = Dir '搜尋下一個零件檔案名稱
    Loop '循環(huán)搜尋

+ t" H- c. k+ dEnd Sub


& m. \: _$ V! Q; V% s7 m8 G

Ali.

能提供你成功運行的一個代打為參考嗎我的一直報錯
3 i& O* a. s" B