solidworks 批量执行宏

knight3732449

观摩一下

受伤的仙人球

有个使用场景，现在我使用的图号分离宏需要打开零件才能进行属性修改，每次在装配体里多修改几个零件名称或者新做零件就会忘了改属性，如果可以批量打开零件，然后中间插入执行图号分离宏的工具执行，就可以自动帮我一次性修改零件属性了（但是俺不会写，有没有大佬帮帮忙呜呜呜）

kbisi

Dim swApp As Object
Dim Part As Object
2 [7 D7 {* @/ ?3 L% H0 HDim sldPath As String

' u  x) ^8 p) @2 j' L$ TDim boolstatus As Boolean
/ e0 y$ A/ P$ L0 w- \$ MDim longstatus As Long, longwarnings As Long


5 n  H! w" D7 a4 [, X: N- T6 D
5 u3 H; e$ d4 {3 Q# A
- u. j5 J/ O9 q0 GSub Test()
Set swApp = Application.SldWorks
sldPath = "C:\Users\kbisi\Desktop\实验\" '设定目录

swFileName = Dir(sldPath & "*.sld*")  '搜寻首个零件档案名称
If UCase(Right(swFileName, 3)) = "PRT" Then swFileTYpe = 1
4 a0 }' b# \3 e& ]& T1 s$ g* FIf UCase(Right(swFileName, 3)) = "ASM" Then swFileTYpe = 2

2 k' G- T2 }7 F+ d/ n7 |! bDo While swFileName <> ""
# [4 B" `& i% x# F; t+ x. R
Set swApp = Application.SldWorks

( [" U4 C% q4 z- A* d% U8 _" j'Set swDoc = swApp.OpenDoc(sldPath & swFileName, swFileTYpe) '开启零件

  q4 t- {, y' b: iSet swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)

& }' A" M6 J$ \; Q" E& ]& m, @
6 F; x1 F* H) j, E7 Z

2 e$ C+ ^9 j7 j) B1 D
! i: }( J6 F- R' ]. L* j! Q) l) [Set Part = swApp.ActiveDoc

Call plmain
$ J1 x+ o3 W' L) f- w1 |/ x1 ?

0 R" @1 p0 x) ]# b' ['
# S9 J! |( U6 F- G
/ Z$ A! L0 ]6 F; \
$ b' _3 j4 `, m3 I
Part.Save '保存%
& G4 ?$ T, o/ x$ {  C3 O2 {. S; lswApp.CloseDoc (swFileName) '关闭零件

If swFileName = "" Then Exit Do

' U# b: \, d8 L9 [9 b6 ~9 D% K8 f
swFileName = Dir '搜寻下一个零件档案名称0

Loop '循环搜寻
/ j+ Z! y3 v+ G( F9 l- B  z2 EEnd Sub
按F8一行看程序错误为什么老是跳过Then swFileTYpe = 2

kbisi

Dim swApp As Object
Dim Part As Object
1 q# h9 K5 v) V- u1 e; ODim sldPath As String
5 Z& n- V- M' W3 W6 O& K
Dim boolstatus As Boolean
8 R# L$ a- K6 [  {" s% K* pDim longstatus As Long, longwarnings As Long




Sub Test()
Set swApp = Application.SldWorks
sldPath = "C:\Users\kbisi\Desktop\实验\" '设定目录

* f  h- k; k  M; U" v7 s* OswFileName = Dir(sldPath & "*.sld*")  '搜寻首个零件档案名称
* ~" }; c+ ?+ {  }9 I. @If UCase(Right(swFileName, 3)) = "PRT" Then swFileTYpe = 1
3 k& a+ X% x* l+ U3 yIf UCase(Right(swFileName, 3)) = "ASM" Then swFileTYpe = 2

. g1 X; t1 K  l( @Do While swFileName <> ""

Set swApp = Application.SldWorks
8 G7 V5 |; m6 H0 ]& i
- z6 k0 o. y5 m'Set swDoc = swApp.OpenDoc(sldPath & swFileName, swFileTYpe) '开启零件
5 l8 N: s; e5 v2 ^# l3 ]
Set swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)


- s3 q3 v: w1 f2 u% q6 w8 ~- n

# {6 J9 Z2 u1 c# t2 w/ \, Q
8 B5 |* X0 D/ {Set Part = swApp.ActiveDoc

Call plmain
2 z8 q9 p2 G+ Y1 b: ~* {
1 q) ?! O3 P7 N* D) q2 o5 J
'

4 d; B# ]" O$ W' h* C6 h2 L* ^

Part.Save '保存%
swApp.CloseDoc (swFileName) '关闭零件

0 X8 w9 W  p; j+ b1 K. ZIf swFileName = "" Then Exit Do

4 u8 t- K+ M3 D4 O. n9 x, i+ x
swFileName = Dir '搜寻下一个零件档案名称0

! O  m7 A& E3 o7 {9 FLoop '循环搜寻
8 h: H! c' K; ]' A9 [End Sub

kbisi

Dim swApp As Object
Dim Part As Object
Dim sldPath As String
, n# K4 R8 V. I( B! Z! ?( {* ]Dim boolstatus As Boolean
& |- p; ?3 {) x, ]; Z( eDim longstatus As Long, longwarnings As Long
, l7 e8 n: ?: c) k2 {/ ySub Test()
Set swApp = Application.SldWorks
sldPath = "C:\Users\kbisi\Desktop\实验\" '设定目录
swFileName = Dir(sldPath & "*.sld*")  '搜寻首个零件档案名称
4 q/ }# u6 A0 j5 V7 ^If UCase(Right(swFileName, 3)) = "PRT" Then swFileTYpe = 1
If UCase(Right(swFileName, 3)) = "ASM" Then swFileTYpe = 2
; c2 l3 R' }6 [$ o/ h  c, DDo While swFileName <> ""
Set swApp = Application.SldWorks
  u0 E7 n3 H9 p. g1 ~- S  \9 j'Set swDoc = swApp.OpenDoc(sldPath & swFileName, swFileTYpe) '开启零件
! r$ d3 q7 W4 j# l( z8 N& NSet swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)
' n: A  M; F. q" l3 W& O8 P, [Set Part = swApp.ActiveDoc
, @9 E, n# c4 j6 S  vCall plmain
Part.Save '保存%
, d$ \' ~$ b& G0 uswApp.CloseDoc (swFileName) '关闭零件
! \* r; z3 K4 q2 c" {If swFileName = "" Then Exit Do
swFileName = Dir '搜寻下一个零件档案名称0
% l3 F: [, H+ c# x3 D( }& m; x2 yLoop '循环搜寻
1 A6 f. N4 c4 ~6 t: Y: S& Y' W" b5 T" AEnd Sub   老是被跳过

kbisi

kbisi 发表于 2021-11-28 10:05
Dim swApp As Object
" }# v$ [' Z* |& @) p1 @; C  VDim Part As Object
& L- @/ e' h# d' [. O" |Dim sldPath As String

* E5 `. x' l' N6 O) Z希望可以得到解答
9 a5 @* C4 R4 U- e. F: N

kbisi

kbisi 发表于 2021-11-28 10:05
Dim swApp As Object
* \6 e8 U  Z" TDim Part As Object
: q3 d! [# B5 ]) @& L9 r- B# E% PDim sldPath As String

" u" z. G8 ]5 o. F6 k和楼主一样打不开装配体

357755306b

多少积分可以分享

xinshiji666

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

' o8 F+ ?' d: l. W. r% d  A7 V无法打开装配体文件，是因为你把文件类型判定的语句放在循环外了，挪到do...loop内即可，那个call语句调用了什么？用不上可以先屏蔽。
经过测试，下面的程序可正常打开零件和装配体

' ******************************************************************************
' 读取指定目录下的Prt/asm文件，关闭
' ******************************************************************************
$ i/ c% G' a- L$ SDim swApp As Object
& X' T# V7 F7 Q2 i' E: {
+ N! w9 z. V( M8 sDim 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\"  '设定目录
  W* d9 ^$ ~3 A0 c
5 {4 z8 w, |4 k7 e( m7 TSub main()

" K' t) E# Y) T    Set swApp = _
8 Y0 p2 A, ?- ^; X+ u2 A4 I    Application.SldWorks
; V0 h  F& y/ o2 z! `4 n    Set Part = swApp.ActiveDoc
        
    swFileName = Dir(sldPath & "*.sld*")
# t) l% h2 @* `& R  A' `
    Do While swFileName <> ""
7 S8 l9 i; \9 }4 t) F; D8 ?        Set swApp = Application.SldWorks
; `$ Y) \: a" T8 I4 V! L& A        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
        'Call plmain
# z+ W$ a5 E* |8 Y2 W        'Part.Save '保存
; O1 d. O& N" f        swApp.CloseDoc (swFileName) '关闭零件
" k0 c8 v- H8 A/ T: y        If swFileName = "" Then Exit Do:
" p* K. M1 n$ s, [6 ^  I8 z1 {        swFileName = Dir '搜寻下一个零件档案名称
+ h* v2 ^3 z2 f. G    Loop '循环搜寻

: K7 _4 ^- a: c7 M8 h4 AEnd Sub


; h6 e' i. o* [- T3 v( l+ y

Ali.

能提供你成功运行的一个代打为参考吗我的一直报错
3 C, r5 j/ A9 ~' m
: d! m+ }; K5 I( i. V9 h9 H