solidworks 批量執(zhí)行宏

knight3732449

觀摩一下

受傷的仙人球

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

kbisi

Dim swApp As Object
Dim Part As Object
" |' J9 C9 s7 ODim sldPath As String

. q0 }7 n0 h8 m5 U- iDim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
. e) j/ r) y6 k- t& ^! i  G( _
3 L( u- [3 @$ Q# b) v' w3 b
4 S/ C0 o9 C0 F7 o' C
2 p! R8 d/ g% J
7 D% \1 P7 e6 j% H) ]& ]Sub Test()
Set swApp = Application.SldWorks
% \  I, f: S" J. zsldPath = "C:\Users\kbisi\Desktop\實(shí)驗(yàn)\" '設(shè)定目錄
& N& c5 f% w( q) s
swFileName = Dir(sldPath & "*.sld*")  '搜尋首個(gè)零件檔案名稱
4 {' v$ |  R) }7 Z, oIf UCase(Right(swFileName, 3)) = "PRT" Then swFileTYpe = 1
If UCase(Right(swFileName, 3)) = "ASM" Then swFileTYpe = 2

5 B" I& k% ~5 K) L& f- B+ fDo While swFileName <> ""
6 X. N, N% @/ d6 Z! W
Set swApp = Application.SldWorks
, s) y- _# J$ U+ _: n9 N
'Set swDoc = swApp.OpenDoc(sldPath & swFileName, swFileTYpe) '開啟零件
4 g" T0 l% s7 W& Z/ p6 G# p2 C& [
Set swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)


3 L4 g. F/ Y: }9 q/ }

. `2 ^  i5 U, n6 \* l/ I( {
4 m& c8 T  X! S- i( D- y3 ^Set Part = swApp.ActiveDoc
" ~& B( M/ U8 F0 {& j# o1 P
9 D& j- Z+ e; e# i( ~& pCall plmain
) O% V1 L; o0 H4 @0 e; k; r' @

'
/ p( D; f; V* [9 N

3 h. r# s4 g# n1 z# R: e& x7 A, s
5 X) P- h5 i# P1 ~7 U/ wPart.Save '保存%
& z2 p$ d% l" b8 n# N$ F2 QswApp.CloseDoc (swFileName) '關(guān)閉零件
: E) ]: r1 A& j1 u" Q7 ]
% G8 N$ k. e4 ?9 _5 x! h( Z% g; JIf swFileName = "" Then Exit Do
# [% V5 n" ^1 l" Y1 `; s

# A" `* Y0 z' `  o: c# WswFileName = Dir '搜尋下一個(gè)零件檔案名稱0
+ u, h  N. @5 D' j8 y
Loop '循環(huán)搜尋
; a8 p9 t4 C3 A8 F9 w$ D. QEnd Sub
按F8一行看程序錯(cuò)誤為什么老是跳過Then swFileTYpe = 2

kbisi

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

Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
) y5 v1 e+ U# I, |) m5 a
$ U3 F( B" c' B! Q( T9 u6 [


Sub Test()
Set swApp = Application.SldWorks
sldPath = "C:\Users\kbisi\Desktop\實(shí)驗(yàn)\" '設(shè)定目錄
2 k1 Q  n; C& D  G0 Y' }
. O3 ?9 I3 H3 j# x+ MswFileName = Dir(sldPath & "*.sld*")  '搜尋首個(gè)零件檔案名稱
" @: G2 z1 ^6 b0 R1 x, tIf UCase(Right(swFileName, 3)) = "PRT" Then swFileTYpe = 1
If UCase(Right(swFileName, 3)) = "ASM" Then swFileTYpe = 2

Do While swFileName <> ""
# Q: m# c1 R  t2 b+ G& T
Set swApp = Application.SldWorks

& }/ r/ h! {) o; x/ i$ ?'Set swDoc = swApp.OpenDoc(sldPath & swFileName, swFileTYpe) '開啟零件

Set swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)
- }- K$ S, r: ]/ v+ [. g+ q& f
* j# S4 B5 k% S, D5 U0 c4 ~6 \
* V& H9 u! I& Z% ]


" M# V9 |  z8 P3 {Set Part = swApp.ActiveDoc

6 f- C. a$ r' A7 h. \5 w# FCall plmain
& J6 C  f. H3 k. V" F2 U

'
0 |% @. X0 K& d; w" u& r) m
9 y  @+ \$ w. A9 [! F6 @
2 C5 e/ K0 ?+ t' A3 j& i+ V
8 k# @+ a7 I# }; c: i9 S: JPart.Save '保存%
swApp.CloseDoc (swFileName) '關(guān)閉零件

If swFileName = "" Then Exit Do
2 L; @$ R4 I, i6 T
, _1 J0 j2 _# R3 [
swFileName = Dir '搜尋下一個(gè)零件檔案名稱0
: r/ ~" p0 v: S! s
  P$ Y' J( E/ ?: }- iLoop '循環(huán)搜尋
End Sub

kbisi

Dim swApp As Object
$ D# w0 m- A8 }5 f: g* Y  WDim Part As Object
Dim sldPath As String
; r) ?2 |5 |/ w/ D0 bDim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Sub Test()
" Y$ f! r' S+ G' ~* V4 X$ t, `0 }- Z( tSet swApp = Application.SldWorks
sldPath = "C:\Users\kbisi\Desktop\實(shí)驗(yàn)\" '設(shè)定目錄
& }+ t, j5 v2 VswFileName = Dir(sldPath & "*.sld*")  '搜尋首個(gè)零件檔案名稱
. V- [' ~8 w# [- D0 z9 R+ {8 _If UCase(Right(swFileName, 3)) = "PRT" Then swFileTYpe = 1
If UCase(Right(swFileName, 3)) = "ASM" Then swFileTYpe = 2
" f% B; Z, C; yDo While swFileName <> ""
Set swApp = Application.SldWorks
'Set swDoc = swApp.OpenDoc(sldPath & swFileName, swFileTYpe) '開啟零件
Set swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)
( |( Y* u2 p* ~/ o3 gSet Part = swApp.ActiveDoc
/ [0 z4 ?8 I7 J" lCall plmain
, ~+ R7 l; ?) h  ?% s& @& nPart.Save '保存%
$ J* i& t# o1 v, y9 E1 [7 t) ^: V1 qswApp.CloseDoc (swFileName) '關(guān)閉零件
If swFileName = "" Then Exit Do
! B5 k8 Q* F/ s% I* t8 cswFileName = Dir '搜尋下一個(gè)零件檔案名稱0
, f7 l8 @5 U/ A! U/ i$ {9 vLoop '循環(huán)搜尋
End Sub   老是被跳過

kbisi

kbisi 發(fā)表于 2021-11-28 10:05
0 m- A9 P+ D9 ]8 m0 _6 i6 ^Dim swApp As Object
Dim Part As Object
Dim sldPath As String

" f2 L  Q, ^5 P& t7 e3 w8 u希望可以得到解答
/ @& M! y# Z! `( P1 T/ d

kbisi

kbisi 發(fā)表于 2021-11-28 10:05
$ Y, V- K" \$ ?5 U- YDim swApp As Object
; w: B: W( u2 Y: G6 H: c: V( b; M$ ZDim Part As Object
Dim sldPath As String

  I. @( p7 N" F$ x4 t5 \0 m9 J和樓主一樣打不開裝配體

357755306b

多少積分可以分享

xinshiji666

kbisi 發(fā)表于 2021-11-28 13:44
: e) \3 S, P4 c+ M- }6 M( I希望可以得到解答

無法打開裝配體文件,，是因?yàn)槟惆盐募�類型判定的語句放在循環(huán)外了，挪到do...loop內(nèi)即可,，那個(gè)call語句調(diào)用了什么,？用不上可以先屏蔽。
. X$ x" B& i( H經(jīng)過測試,，下面的程序可正常打開零件和裝配體

' ******************************************************************************
9 M. x2 `3 ~3 o* G' M' 讀取指定目錄下的Prt/asm文件,，關(guān)閉
1 j' D6 B; t. a' ******************************************************************************
Dim swApp As Object

Dim Part As Object
+ @9 D/ n% K1 IDim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
, V. [1 g8 T; R: I0 K' T'Dim sldPath As String
Const sldPath As String = "E:\3Dtest\BOM1\"  '設(shè)定目錄

Sub main()

6 M4 J9 L! ?  @- l$ K+ ]& n    Set swApp = _
    Application.SldWorks
7 U* a1 o1 ~" c3 J7 ~" d    Set Part = swApp.ActiveDoc
% I2 n! x4 J+ I- X3 ?+ Q4 k        
' G7 n* P. N1 q    swFileName = Dir(sldPath & "*.sld*")

    Do While swFileName <> ""
% y4 ?% t. {* F+ ~3 A        Set swApp = Application.SldWorks
        If UCase(Right(swFileName, 3)) = "PRT" Then swFileTYpe = 1
        If UCase(Right(swFileName, 3)) = "ASM" Then swFileTYpe = 2

        Set swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)
        Set Part = swApp.ActiveDoc
  c# ]9 R& J1 K4 d" z5 N6 i7 E- b        'Call plmain
        'Part.Save '保存
        swApp.CloseDoc (swFileName) '關(guān)閉零件
        If swFileName = "" Then Exit Do:
        swFileName = Dir '搜尋下一個(gè)零件檔案名稱
    Loop '循環(huán)搜尋

6 O0 z% N' n  Z3 g2 tEnd Sub


- a' i, l: @' K5 L( s: g/ D4 K3 V  f

Ali.

能提供你成功運(yùn)行的一個(gè)代打?yàn)閰⒖紗嵛业囊恢眻?bào)錯(cuò)

! R2 N% i- G' {4 H" E& I& S. T