solidworks 批量执行宏

knight3732449

观摩一下

受伤的仙人球

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

kbisi

Dim swApp As Object
Dim Part As Object
; x! o  {. |/ m3 L" j  cDim sldPath As String

2 c1 M  c6 g, {Dim boolstatus As Boolean
3 z; k+ `. v! @2 K+ v5 U5 l  SDim longstatus As Long, longwarnings As Long

1 t& L. g  m: V, M. `0 j0 ?3 m* ]
% A4 f  l2 j8 K, a' W9 _- l4 g
7 b0 b/ a! T/ T  t1 ^7 E/ A
" j8 |/ O# `' M2 w& n8 S/ dSub Test()
/ V0 d! x( x  g" I: s3 w' t: VSet swApp = Application.SldWorks
, S" p2 R( x. `% RsldPath = "C:\Users\kbisi\Desktop\实验\" '设定目录

swFileName = Dir(sldPath & "*.sld*")  '搜寻首个零件档案名称
$ ]% `: M$ m, \- tIf UCase(Right(swFileName, 3)) = "PRT" Then swFileTYpe = 1
% o" u# |1 H: p& Q8 ^If UCase(Right(swFileName, 3)) = "ASM" Then swFileTYpe = 2

, h5 y8 x/ X) \Do While swFileName <> ""

Set swApp = Application.SldWorks
6 U6 N% {" m8 X2 Y" r) W
'Set swDoc = swApp.OpenDoc(sldPath & swFileName, swFileTYpe) '开启零件
: |6 A! }( z* `1 O9 R( {
% P% u" S  C, W- C9 pSet swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)
4 X& c& r# }3 u" I

7 H- U" W8 e$ c0 H/ x2 C7 g; Y3 V  U
* u" {. y; }, i7 y3 n2 F% Z- b

+ o* j6 l1 n# d/ c+ zSet Part = swApp.ActiveDoc

9 x. M' J- Z: E7 c; ~Call plmain

" a" J9 ~( a$ ]) I
'



Part.Save '保存%
swApp.CloseDoc (swFileName) '关闭零件
: |/ r5 v' K  I9 c5 F
9 L; X( ]; Y2 Q4 |- a0 UIf swFileName = "" Then Exit Do
/ D1 x3 U5 N% {" d; ?

( b6 H; w' q! Z1 ~+ T7 U" ?- _swFileName = Dir '搜寻下一个零件档案名称0
: p% a2 }  x; b. w+ [
! S: H+ h3 @" J: dLoop '循环搜寻
End Sub
1 r5 I8 {) {! D# ]按F8一行看程序错误为什么老是跳过Then swFileTYpe = 2

kbisi

Dim swApp As Object
Dim Part As Object
/ R7 z; a- Y+ {5 p3 u# QDim sldPath As String

3 q) n$ h0 s* M+ N- d0 m8 Q' W: qDim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long




: Y3 k' B, c$ q+ H) E; _Sub Test()
Set swApp = Application.SldWorks
2 u: T  c* e: g0 D- `: WsldPath = "C:\Users\kbisi\Desktop\实验\" '设定目录

4 e% U# F: h' T4 T4 ZswFileName = Dir(sldPath & "*.sld*")  '搜寻首个零件档案名称
If UCase(Right(swFileName, 3)) = "PRT" Then swFileTYpe = 1
* ^: Z7 x) @# M4 w/ [3 C2 U+ _$ eIf UCase(Right(swFileName, 3)) = "ASM" Then swFileTYpe = 2

* q& x. _6 ?9 {- u. {7 l/ U) MDo While swFileName <> ""

Set swApp = Application.SldWorks

; Y/ {. c7 o% m& `3 h; F'Set swDoc = swApp.OpenDoc(sldPath & swFileName, swFileTYpe) '开启零件

Set swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)
" l. i1 h' ^" G6 M


: s4 K. {5 E3 ]# F* a+ }

Set Part = swApp.ActiveDoc

" D9 B/ |/ M0 w1 T9 UCall plmain


'
0 A  ?. v6 G; j: _6 r


Part.Save '保存%
! v# e  F; F% _# {2 jswApp.CloseDoc (swFileName) '关闭零件
2 n5 F* p. B& J8 [3 f. Z
If swFileName = "" Then Exit Do


swFileName = Dir '搜寻下一个零件档案名称0

2 r! b1 m2 e0 \! c" t6 g: j; W+ wLoop '循环搜寻
" a& D+ ~! A! Z- q4 o; d" JEnd Sub

kbisi

Dim swApp As Object
9 D& ]( i3 S# x0 JDim Part As Object
  K; h+ q$ g' \Dim sldPath As String
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
2 Z$ w" ^0 Y7 sSub Test()
; s) j. b7 m2 u& w  d% wSet swApp = Application.SldWorks
sldPath = "C:\Users\kbisi\Desktop\实验\" '设定目录
swFileName = Dir(sldPath & "*.sld*")  '搜寻首个零件档案名称
, |, a# j- \9 h: o7 o8 AIf UCase(Right(swFileName, 3)) = "PRT" Then swFileTYpe = 1
If UCase(Right(swFileName, 3)) = "ASM" Then swFileTYpe = 2
4 ~" g; j& D' y( d7 A; N- cDo While swFileName <> ""
3 O, p! q8 P/ o9 S" D; ~- zSet swApp = Application.SldWorks
& e0 m. c1 a0 g- t* E, d'Set swDoc = swApp.OpenDoc(sldPath & swFileName, swFileTYpe) '开启零件
- O& g* Q0 k4 h6 X0 C6 tSet swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)
Set Part = swApp.ActiveDoc
% f, U( r$ G/ q1 i/ Z$ Q- i9 `9 `$ DCall plmain
Part.Save '保存%
% U& M$ }. _# _. d: o) y1 d2 WswApp.CloseDoc (swFileName) '关闭零件
If swFileName = "" Then Exit Do
! }# v8 a2 |0 B5 T! }3 ~1 A+ wswFileName = Dir '搜寻下一个零件档案名称0
Loop '循环搜寻
End Sub   老是被跳过

kbisi

kbisi 发表于 2021-11-28 10:05
4 ]3 E7 q& n* i/ J* @+ Q* O) eDim swApp As Object
Dim Part As Object
/ `' e/ V* R$ c7 z1 A' g8 ODim sldPath As String

希望可以得到解答
6 t. C; I/ Z1 i0 s$ [

kbisi

kbisi 发表于 2021-11-28 10:05
Dim swApp As Object
8 z5 z, m1 s8 Q5 H# R! m! dDim Part As Object
( r1 d3 {  U- E) X- [! `Dim sldPath As String

" I; B; b* Y  U: V2 u2 W0 C4 f( U和楼主一样打不开装配体

357755306b

多少积分可以分享

xinshiji666

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

无法打开装配体文件，是因为你把文件类型判定的语句放在循环外了，挪到do...loop内即可，那个call语句调用了什么？用不上可以先屏蔽。
3 s; [3 \. b( m3 W( _经过测试，下面的程序可正常打开零件和装配体
$ o+ \  r. w( l- F+ k, b
, h" K$ G+ L5 F' ******************************************************************************
' 读取指定目录下的Prt/asm文件，关闭
' ******************************************************************************
Dim swApp As Object
- v) z6 H5 _5 u4 W, B
Dim Part As Object
% N: {' A% R9 ZDim boolstatus As Boolean
4 [% V$ B1 B& j: @3 p2 ]1 m: w9 c5 eDim longstatus As Long, longwarnings As Long
( q7 a% ~0 u. a! V2 Q8 X; E'Dim sldPath As String
% d( ]7 Z, J9 o# y' q1 U5 K( V9 aConst sldPath As String = "E:\3Dtest\BOM1\"  '设定目录

2 c% X& M4 n% O( B4 bSub main()

    Set swApp = _
- D+ L- {; S  V2 D9 p& w    Application.SldWorks
, G  x! o4 K4 ~& X( s    Set Part = swApp.ActiveDoc
        
( h! V% `! N: V) G* G    swFileName = Dir(sldPath & "*.sld*")
2 z2 p5 s" k! e4 Y/ r. f( D5 F
) e+ n1 h1 T8 T' `- L    Do While swFileName <> ""
        Set swApp = Application.SldWorks
        If UCase(Right(swFileName, 3)) = "PRT" Then swFileTYpe = 1
        If UCase(Right(swFileName, 3)) = "ASM" Then swFileTYpe = 2
1 s8 k5 Z. g# o" K# s
: ?8 K9 I$ j2 n# K" z: F; M        Set swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)
        Set Part = swApp.ActiveDoc
! f8 y. O! g1 S) }        'Call plmain
        'Part.Save '保存
        swApp.CloseDoc (swFileName) '关闭零件
& f4 J0 U5 [* y# _; V- `        If swFileName = "" Then Exit Do:
5 v4 h. {( E- T' u        swFileName = Dir '搜寻下一个零件档案名称
1 T9 z. ?, G5 j3 P3 q/ S! T5 Z    Loop '循环搜寻

End Sub
" Z3 V% J2 b, E$ C  a* D5 t
, J; p% d3 Z7 ^) H
. f7 [) r# v* j* U0 k8 F$ E% z& v

Ali.

能提供你成功运行的一个代打为参考吗我的一直报错
# l$ w$ w4 f3 Z6 O8 z9 t9 Y
! G) {) ^6 Z+ C9 H7 _/ z