solidworks 批量执行宏

knight3732449

观摩一下

受伤的仙人球

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

kbisi

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

/ z* h2 @! r) U) S5 U. LDim boolstatus As Boolean
0 w' n# K& \1 h/ O9 TDim longstatus As Long, longwarnings As Long
. D0 }) Q2 C  l6 Q

+ V  A" p, N5 D, G0 j& }! x) ^
' O. [- o9 e2 X" Z0 k; ~4 ?$ H
Sub Test()
Set swApp = Application.SldWorks
sldPath = "C:\Users\kbisi\Desktop\实验\" '设定目录

! H" g' c  m, r) y3 ]swFileName = Dir(sldPath & "*.sld*")  '搜寻首个零件档案名称
! k: R+ p/ b4 H) B& GIf UCase(Right(swFileName, 3)) = "PRT" Then swFileTYpe = 1
If UCase(Right(swFileName, 3)) = "ASM" Then swFileTYpe = 2
% Y. v( Y+ G) Y% w
Do While swFileName <> ""
' n; N, J" ~& \5 V  i
: m! Z7 d9 o! f4 _Set swApp = Application.SldWorks
  g, |& W" |; S& m$ E' p0 O
/ \  \& s& Y1 L. g6 X0 u8 u/ x/ e'Set swDoc = swApp.OpenDoc(sldPath & swFileName, swFileTYpe) '开启零件

! L5 C* q8 B4 o( J% DSet swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)
8 x, }: J8 W* E* m9 ~! p+ u

5 u6 w- ?- N" H, `) G" k$ ~

- j& V+ F" |/ C1 n' B$ H7 F! l
) A  X% i2 c9 K0 t1 k6 ~2 h) m3 s- YSet Part = swApp.ActiveDoc
+ Q) K( G: U4 A, D  {9 z
+ S- w. V- u9 C, A% U. XCall plmain
4 {' F& J' `0 ^( J7 {( ]) h$ l

) |! u" ]) k  E" A6 @'
7 X) P# {8 C! u2 C


& z) h/ Q2 R0 ~+ [* i' M" c* K5 `Part.Save '保存%
swApp.CloseDoc (swFileName) '关闭零件

- C% X0 Z2 R0 J* j6 q+ c, {If swFileName = "" Then Exit Do

* f' c. r/ f0 [# F) H( ~
0 }( k* Q* H, b2 z6 E- Y  i" ?8 a9 xswFileName = Dir '搜寻下一个零件档案名称0
) f  T8 ^* O8 F8 b
Loop '循环搜寻
0 r- p1 @: P: `; l8 I9 ]& J6 nEnd Sub
( ], p# d& _4 E( W2 K( g0 x  j/ o按F8一行看程序错误为什么老是跳过Then swFileTYpe = 2

kbisi

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

+ h1 J- f, K; J* S: S8 ^Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
9 [& t9 q% q7 |* F, {4 ~, f  d% c



  }& B& S: ]- f2 `+ w1 ZSub Test()
Set swApp = Application.SldWorks
sldPath = "C:\Users\kbisi\Desktop\实验\" '设定目录

swFileName = Dir(sldPath & "*.sld*")  '搜寻首个零件档案名称
If UCase(Right(swFileName, 3)) = "PRT" Then swFileTYpe = 1
+ I' Q+ ~0 t- {- [" YIf UCase(Right(swFileName, 3)) = "ASM" Then swFileTYpe = 2

Do While swFileName <> ""

Set swApp = Application.SldWorks
# C0 B  T6 A# G" t: J
  i0 ^& E6 ~7 h& M" D& }! t'Set swDoc = swApp.OpenDoc(sldPath & swFileName, swFileTYpe) '开启零件

Set swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)
$ G, `# a! R" W
$ @0 b, K6 P: C$ r0 y$ S; P4 w, a
7 R+ e; ~  k- Z- g- X% r

- c) J: K2 t1 H, N' ^, O+ e
Set Part = swApp.ActiveDoc
$ B% Y$ z; Q# Z  b
Call plmain


, m# E; D9 C& n5 V'



' n- F8 j  o: `+ Q0 ePart.Save '保存%
& t: ?; C& d3 y: w# U& g) S. [% DswApp.CloseDoc (swFileName) '关闭零件
1 |; _3 P) @# Y: f* z+ s
9 L+ F4 L6 P( l: ~$ H6 TIf swFileName = "" Then Exit Do
6 e! f$ Z9 ^; o& S) \2 D

swFileName = Dir '搜寻下一个零件档案名称0
0 p2 R" F, s1 I; S  F4 f
. X8 G" x8 [& m% Q7 D$ s) xLoop '循环搜寻
End Sub

kbisi

Dim swApp As Object
Dim Part As Object
Dim sldPath As String
  b. _! B1 I/ o) |* XDim boolstatus As Boolean
0 @+ w2 s9 J2 PDim longstatus As Long, longwarnings As Long
* ]1 p/ n$ k, V$ Z6 W7 nSub Test()
/ Y8 @( r" I/ n( _. mSet swApp = Application.SldWorks
sldPath = "C:\Users\kbisi\Desktop\实验\" '设定目录
8 u# p+ k2 h' I0 b5 n5 dswFileName = Dir(sldPath & "*.sld*")  '搜寻首个零件档案名称
If UCase(Right(swFileName, 3)) = "PRT" Then swFileTYpe = 1
If UCase(Right(swFileName, 3)) = "ASM" Then swFileTYpe = 2
- {+ P6 P) K8 I& B" U% u/ VDo While swFileName <> ""
( ?4 n' g: _: N2 D" Z! }Set swApp = Application.SldWorks
" m' p3 M; T5 B: a$ \# Q1 V'Set swDoc = swApp.OpenDoc(sldPath & swFileName, swFileTYpe) '开启零件
) v& o# O/ K( W) f4 E* F# LSet swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)
Set Part = swApp.ActiveDoc
  q7 e; ]0 K, J  FCall plmain
5 S+ ^  b+ r& u4 h% PPart.Save '保存%
swApp.CloseDoc (swFileName) '关闭零件
If swFileName = "" Then Exit Do
# k: R% v( b2 LswFileName = Dir '搜寻下一个零件档案名称0
Loop '循环搜寻
End Sub   老是被跳过

kbisi

kbisi 发表于 2021-11-28 10:05
Dim swApp As Object
Dim Part As Object
Dim sldPath As String

1 p' w" b( E& a9 o& n希望可以得到解答

kbisi

kbisi 发表于 2021-11-28 10:05
5 }8 ^; }# `8 ~5 T) N* yDim swApp As Object
Dim Part As Object
Dim sldPath As String

: Y! _7 k6 r, ]1 c' t& c) ?和楼主一样打不开装配体
) Z  D2 F4 z5 c7 O1 J$ }: f. y

357755306b

多少积分可以分享

xinshiji666

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

无法打开装配体文件，是因为你把文件类型判定的语句放在循环外了，挪到do...loop内即可，那个call语句调用了什么？用不上可以先屏蔽。
5 H6 O' C0 h; P; J# T+ j* w( @经过测试，下面的程序可正常打开零件和装配体
1 D: `  C: B2 N! ^) a
7 }# ]9 a+ ]- o7 K/ T' ******************************************************************************
/ D1 K# k8 z8 c' 读取指定目录下的Prt/asm文件，关闭
' ******************************************************************************
2 T" [8 ?6 h! w$ SDim swApp As Object

, _6 U* A# n& T; Z3 N# ODim Part As Object
; h3 a9 Q/ [- m: z* n  iDim boolstatus As Boolean
4 X3 M, _- z4 B2 QDim longstatus As Long, longwarnings As Long
'Dim sldPath As String
* O( _' P" u( R. B% c- IConst sldPath As String = "E:\3Dtest\BOM1\"  '设定目录
! v6 S. Z  z: h4 f
+ o, h  }3 ^4 Q2 R$ ]2 TSub main()

    Set swApp = _
7 j- f  s9 `2 {, R/ G    Application.SldWorks
    Set Part = swApp.ActiveDoc
; x! o1 F/ ~5 z        
    swFileName = Dir(sldPath & "*.sld*")

    Do While swFileName <> ""
% C7 O2 q3 p* n0 l% T* a        Set swApp = Application.SldWorks
/ }4 a$ T/ X; D4 L8 D5 N        If UCase(Right(swFileName, 3)) = "PRT" Then swFileTYpe = 1
% r% J# z0 o, E8 `! Z        If UCase(Right(swFileName, 3)) = "ASM" Then swFileTYpe = 2

4 H" c- f% s* z0 D7 h% ?        Set swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)
+ ~% z+ T' c- _0 }3 h' C4 Q- T  ^4 a        Set Part = swApp.ActiveDoc
        'Call plmain
! d, q* p9 n4 E% J        'Part.Save '保存
        swApp.CloseDoc (swFileName) '关闭零件
0 X' W8 ^7 Q1 ^7 k0 l" L, k# \. r        If swFileName = "" Then Exit Do:
: l; W5 J3 M1 D; ?6 ?5 p        swFileName = Dir '搜寻下一个零件档案名称
    Loop '循环搜寻
$ h0 A" k0 H7 |/ P: M
6 K0 C! c% a* i, ?+ }2 eEnd Sub
- \3 f2 B; F" x9 @$ _5 b

Ali.

能提供你成功运行的一个代打为参考吗我的一直报错

, L0 R. D, R* H0 j' {; |