solidworks 批量执行宏

knight3732449

观摩一下

受伤的仙人球

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

kbisi

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

3 O9 b0 b1 w; T- |- ?+ W' L1 h; j$ f# \Dim boolstatus As Boolean
( ~7 r. I! }, h0 f" l% i' qDim longstatus As Long, longwarnings As Long

, i' J4 a+ `0 t# a, i
4 G' {4 G  U4 J

Sub Test()
Set swApp = Application.SldWorks
( O5 ^! k7 W6 h  ssldPath = "C:\Users\kbisi\Desktop\实验\" '设定目录

swFileName = Dir(sldPath & "*.sld*")  '搜寻首个零件档案名称
If UCase(Right(swFileName, 3)) = "PRT" Then swFileTYpe = 1
: z- \! O0 O2 |7 }+ L$ lIf UCase(Right(swFileName, 3)) = "ASM" Then swFileTYpe = 2

Do While swFileName <> ""
$ R) f7 i  `- P8 D3 |
; W: Y$ w# s) }7 @! {* }$ zSet swApp = Application.SldWorks

$ K* Z, x2 N4 {3 H7 T# }0 J'Set swDoc = swApp.OpenDoc(sldPath & swFileName, swFileTYpe) '开启零件

) ]7 F1 K$ C; R# Q; H; ^$ qSet swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)

6 F- B0 m5 f8 e( n8 }4 A( @. ]
" A: d$ u5 S& @
/ T4 \2 t/ i$ \  n: S( w/ [( p+ Q
5 I/ F- ]( b2 _6 l& _6 s
Set Part = swApp.ActiveDoc

+ ?5 n$ Y, M. _5 E; ?1 `6 T1 oCall plmain
; k$ Q# Q) E2 D6 S1 a" m! j
4 f+ Q6 ?. i8 ~* l
' s, ]8 D: Z+ l; R'



$ j2 I* [4 G8 F5 V# ^" pPart.Save '保存%
swApp.CloseDoc (swFileName) '关闭零件

If swFileName = "" Then Exit Do
+ U( G! \9 E% k: m

swFileName = Dir '搜寻下一个零件档案名称0
( m6 o3 H8 x6 V  m6 m" l$ E! N
* Z# h- H; b% ~! Y& [9 ]$ }+ bLoop '循环搜寻
End Sub
按F8一行看程序错误为什么老是跳过Then swFileTYpe = 2

kbisi

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

0 c) ^2 n0 o. G- B' `: c4 M1 eDim boolstatus As Boolean
3 o9 I2 U1 f: pDim longstatus As Long, longwarnings As Long
; L! i7 K2 {/ X* ~$ G
0 u% u, s5 g$ ~* p# E$ O( z


* ?2 [, G  l: n. |6 m# ASub Test()
Set swApp = Application.SldWorks
sldPath = "C:\Users\kbisi\Desktop\实验\" '设定目录
0 E+ J7 |' F4 x, J0 ]% L4 ~
swFileName = Dir(sldPath & "*.sld*")  '搜寻首个零件档案名称
! l. I% O4 s0 y; e. oIf UCase(Right(swFileName, 3)) = "PRT" Then swFileTYpe = 1
If UCase(Right(swFileName, 3)) = "ASM" Then swFileTYpe = 2

& m, g7 l5 I" i+ w) Q9 q7 eDo While swFileName <> ""

9 {/ L1 g" F9 K0 @+ QSet swApp = Application.SldWorks

' @7 c/ g$ T6 [9 E: `6 u! v" R1 X'Set swDoc = swApp.OpenDoc(sldPath & swFileName, swFileTYpe) '开启零件
( A9 u* ^1 h- o1 J0 E9 y9 ^' k9 H
! h/ D5 ~% C# g# ]$ Q  ~: rSet swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)
" Z, V3 B0 U: f% H7 z' I
' f+ O& Y  n- i# a
1 a& f& ~# k1 c9 @  k9 X  H
- U  ]! R8 h$ N
- c' l* o7 G  e  Z3 G7 h) G- F; b
) E- [7 ~3 S8 Z" oSet Part = swApp.ActiveDoc
) L" _- f9 g" Q* S
: |; E& `9 e4 L/ i" ~0 R2 QCall plmain
( c# z7 ?1 P5 X5 V+ o% f3 n

7 |6 ]6 E% m* n) d' i/ s, \( P'

. M" O; O; n0 ]# t! ]% q

Part.Save '保存%
! p2 j" A8 [  _5 B9 U' ?) BswApp.CloseDoc (swFileName) '关闭零件
5 H4 c: P' j6 {' ], x+ u1 a* f, E5 ]# E
! n/ G& J& a5 {: m2 |6 zIf swFileName = "" Then Exit Do
) E" o, Q1 }0 |( h8 [8 g
/ w6 y* p- Y. L5 m+ a
8 o% r$ l0 R6 h+ J2 dswFileName = Dir '搜寻下一个零件档案名称0
/ U3 ]" K: I, i' v  a
Loop '循环搜寻
6 D2 e8 f/ I8 ?End Sub

kbisi

Dim swApp As Object
( w. G/ \( W$ ?6 YDim Part As Object
: C7 f, a! y: Y' }5 l7 iDim sldPath As String
1 ~+ C. x, P3 w( A' w) QDim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Sub Test()
Set swApp = Application.SldWorks
) j5 `9 j3 D; I0 h9 k% d- [sldPath = "C:\Users\kbisi\Desktop\实验\" '设定目录
5 \/ K" w  g+ u3 E! w% S7 o' `swFileName = Dir(sldPath & "*.sld*")  '搜寻首个零件档案名称
& d- s; A, D+ N/ uIf UCase(Right(swFileName, 3)) = "PRT" Then swFileTYpe = 1
If UCase(Right(swFileName, 3)) = "ASM" Then swFileTYpe = 2
' c: n, i+ y+ C1 P- F5 rDo While swFileName <> ""
Set swApp = Application.SldWorks
'Set swDoc = swApp.OpenDoc(sldPath & swFileName, swFileTYpe) '开启零件
( f1 z) C# `+ XSet swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)
Set Part = swApp.ActiveDoc
Call plmain
) ]4 n, F: q, ~# tPart.Save '保存%
% i( f* R) j. ]swApp.CloseDoc (swFileName) '关闭零件
5 M% M  s' A$ i$ `$ @If swFileName = "" Then Exit Do
% q4 Y! D1 S4 T- uswFileName = Dir '搜寻下一个零件档案名称0
8 D3 X2 E5 G; \. }8 A5 d* q; V& I* MLoop '循环搜寻
End Sub   老是被跳过

kbisi

kbisi 发表于 2021-11-28 10:05
9 {& d0 ?# C* KDim swApp As Object
Dim Part As Object
& ?/ ?) g! l6 ADim sldPath As String

希望可以得到解答
& a+ d. u' ]) [# R

kbisi

kbisi 发表于 2021-11-28 10:05
$ z1 g* ~  y) e* sDim swApp As Object
Dim Part As Object
Dim sldPath As String

" V" U+ P# I; A- A和楼主一样打不开装配体

357755306b

多少积分可以分享

xinshiji666

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

无法打开装配体文件，是因为你把文件类型判定的语句放在循环外了，挪到do...loop内即可，那个call语句调用了什么？用不上可以先屏蔽。
经过测试，下面的程序可正常打开零件和装配体
  h+ A& T, m1 V1 q: u
# c: n$ O0 |9 ^' ******************************************************************************
" j( M, a$ v, U0 P+ c3 [. q" j' 读取指定目录下的Prt/asm文件，关闭
) g* H1 f  A2 I& z0 S# W' ******************************************************************************
Dim swApp As Object
. ]+ {( |& a) ?, o' r. V8 K% f8 g
Dim Part As Object
8 Z, G# w# A+ ~- W: w% y' iDim boolstatus As Boolean
# m% L+ \, Z% W4 D7 dDim longstatus As Long, longwarnings As Long
'Dim sldPath As String
Const sldPath As String = "E:\3Dtest\BOM1\"  '设定目录

Sub main()

1 q% S' v; e9 p1 F  Z4 y    Set swApp = _
    Application.SldWorks
# T# z0 k9 j: S# O  ^& W; L    Set Part = swApp.ActiveDoc
        
% {- {, L9 p& x    swFileName = Dir(sldPath & "*.sld*")
, ]- a* F) [  B1 @* j
    Do While swFileName <> ""
        Set swApp = Application.SldWorks
- r$ }9 b2 u4 Q1 ^        If UCase(Right(swFileName, 3)) = "PRT" Then swFileTYpe = 1
        If UCase(Right(swFileName, 3)) = "ASM" Then swFileTYpe = 2
$ \7 Z$ R; X. I1 _- c$ w! c
6 |: Y8 p  E7 O# D) S        Set swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)
5 ]  |5 v& Q2 \/ M        Set Part = swApp.ActiveDoc
        'Call plmain
. V& ], i; Z+ x3 G9 g5 j" S        'Part.Save '保存
  V/ k3 R3 D  Y. w" s( b* @5 x        swApp.CloseDoc (swFileName) '关闭零件
- e* _- F; [1 ~/ E2 B4 l, r, T% L        If swFileName = "" Then Exit Do:
+ R2 n$ W1 F/ G! X3 \2 x        swFileName = Dir '搜寻下一个零件档案名称
# O( g# d& F! j2 G" f    Loop '循环搜寻

0 k3 H: D9 u, j* g! Q7 hEnd Sub


/ k# }# B# J1 V7 D4 J. t

Ali.

能提供你成功运行的一个代打为参考吗我的一直报错
* Y1 V. L; y, M+ E. t* H2 [$ v