solidworks 批量执行宏

knight3732449

观摩一下

受伤的仙人球

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

kbisi

Dim swApp As Object
Dim Part As Object
7 e4 Q1 m/ s! L2 BDim sldPath As String

Dim boolstatus As Boolean
  q) m2 L  C: h" R; y! lDim longstatus As Long, longwarnings As Long
0 G2 W$ g1 X1 @$ ~2 k- _& Z' l! e

: w4 G9 Y* d) A. q: t

: O5 x( t5 ?, [. i/ M$ j8 t$ l! v$ aSub Test()
Set swApp = Application.SldWorks
7 j; Z% D7 J. B* s, Z  A7 BsldPath = "C:\Users\kbisi\Desktop\实验\" '设定目录

5 `3 S- P* E9 r& }$ L0 GswFileName = Dir(sldPath & "*.sld*")  '搜寻首个零件档案名称
If UCase(Right(swFileName, 3)) = "PRT" Then swFileTYpe = 1
If UCase(Right(swFileName, 3)) = "ASM" Then swFileTYpe = 2

  K0 X( ~6 k6 ~Do While swFileName <> ""

Set swApp = Application.SldWorks
; Q6 S  a# C, I# A$ T
'Set swDoc = swApp.OpenDoc(sldPath & swFileName, swFileTYpe) '开启零件
/ p2 @% Z, L: d) `; h/ W0 H
" E3 `9 R; }) E( Y+ N, eSet swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)
$ m; J% j' H% {' m: h# W5 q
  f9 J) n, U! D" a* T

% {" s: z$ h) s1 G# e9 l3 H

Set Part = swApp.ActiveDoc
* l& ]: n( x/ Z+ b* ]& V3 X
# E* W1 M- Q( w4 M$ uCall plmain
/ \8 o/ k& A2 Y7 Q! A4 u* [
' d; j/ ~6 p& H2 ?. @" \+ s
'


6 ^& l7 ~4 f  J/ P* C  [, G+ D( `- R8 ?
0 |7 |2 Y. d6 E4 r# o2 l* aPart.Save '保存%
swApp.CloseDoc (swFileName) '关闭零件
, e. K3 K6 G0 y  S3 [/ e% E# a
If swFileName = "" Then Exit Do
( ]5 }! }; p. Y  J
3 N! N4 w" C5 O' @# p. e
, E4 N5 h- `) R2 N6 KswFileName = Dir '搜寻下一个零件档案名称0

# ~9 T$ ]' s* c/ hLoop '循环搜寻
( W' _9 A' e) ~* j" H) W0 ]+ [End Sub
1 b9 c5 V, M$ ^2 h: n7 n% u" {按F8一行看程序错误为什么老是跳过Then swFileTYpe = 2

kbisi

Dim swApp As Object
0 `. x7 c  H- X% G7 kDim Part As Object
- u4 J( |" f, v7 A) {* lDim sldPath As String
/ A8 h& B2 m7 W# k4 }
Dim boolstatus As Boolean
, k9 \, ]* e- D0 B0 `Dim longstatus As Long, longwarnings As Long



( t: g& I/ W) F5 l
. U6 Z) \( T1 l( m1 \- lSub Test()
Set swApp = Application.SldWorks
' C9 U1 U! V0 F2 f* A( M9 @sldPath = "C:\Users\kbisi\Desktop\实验\" '设定目录

swFileName = Dir(sldPath & "*.sld*")  '搜寻首个零件档案名称
If UCase(Right(swFileName, 3)) = "PRT" Then swFileTYpe = 1
If UCase(Right(swFileName, 3)) = "ASM" Then swFileTYpe = 2

Do While swFileName <> ""

Set swApp = Application.SldWorks
, {" d0 A3 J. Y. d7 V/ e
'Set swDoc = swApp.OpenDoc(sldPath & swFileName, swFileTYpe) '开启零件

6 i% K# s" d, \# H1 U$ A( {Set swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)
; y$ Y, u' P2 B5 u; R; T. A
0 q0 \" ]. h6 O, K
; ^- U( h- P7 [# `; z7 _

5 u0 K' }7 {. w& W+ }: l  w
( `  L# I+ S; X/ zSet Part = swApp.ActiveDoc
* ]9 |8 k- M# X/ |7 _& b6 x- G
+ q, n& L5 n9 D( F+ b! N9 v6 ^Call plmain


7 R5 M. j& t" L( z1 W6 A) Q/ r3 y'
  R( w' B0 H7 \& Z: \, B. G8 o

6 d  F2 o7 u1 P. d
$ I& }* M8 O& E+ }Part.Save '保存%
swApp.CloseDoc (swFileName) '关闭零件
+ _7 p5 ]4 E4 F; N$ @% T! G
If swFileName = "" Then Exit Do
' K5 d2 C. ^! ^3 k( k' L

swFileName = Dir '搜寻下一个零件档案名称0
* N- U3 h3 Q$ O% n( }1 w
Loop '循环搜寻
End Sub

kbisi

Dim swApp As Object
Dim Part As Object
' x2 m) G- Y8 {1 m: WDim sldPath As String
. }4 k# a; `. P* d9 kDim boolstatus As Boolean
9 `$ \" I" m# Y9 P; p+ gDim longstatus As Long, longwarnings As Long
Sub Test()
% @+ I) s6 s! A5 ~Set swApp = Application.SldWorks
( n2 ~3 x. ~) M* X) ?) VsldPath = "C:\Users\kbisi\Desktop\实验\" '设定目录
swFileName = Dir(sldPath & "*.sld*")  '搜寻首个零件档案名称
* h+ S6 i# O) tIf UCase(Right(swFileName, 3)) = "PRT" Then swFileTYpe = 1
If UCase(Right(swFileName, 3)) = "ASM" Then swFileTYpe = 2
Do While swFileName <> ""
, p+ s2 J5 b* _" ?- ~' ?Set swApp = Application.SldWorks
9 ~8 ~" y* [9 N' N4 |8 d'Set swDoc = swApp.OpenDoc(sldPath & swFileName, swFileTYpe) '开启零件
' `1 p4 |, ]9 ^/ ?0 N& ESet swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)
  G; T" \4 Y4 |& MSet Part = swApp.ActiveDoc
' X$ R5 @" @+ R0 V' gCall plmain
3 r0 d& |- `' W) ^Part.Save '保存%
swApp.CloseDoc (swFileName) '关闭零件
+ X; R7 o' `" g2 S% _6 [, u! X* DIf swFileName = "" Then Exit Do
8 R% K" |* t* _3 SswFileName = Dir '搜寻下一个零件档案名称0
- R  ~+ a7 G% \( e8 X) ~- tLoop '循环搜寻
End Sub   老是被跳过

kbisi

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

% [  w0 y. z5 M& ]6 _希望可以得到解答
! E$ ^0 X  z1 ]

kbisi

kbisi 发表于 2021-11-28 10:05
$ O2 d4 B/ W0 IDim swApp As Object
Dim Part As Object
Dim sldPath As String

* g0 ^3 I, G7 E! m  q和楼主一样打不开装配体

357755306b

多少积分可以分享

xinshiji666

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

无法打开装配体文件，是因为你把文件类型判定的语句放在循环外了，挪到do...loop内即可，那个call语句调用了什么？用不上可以先屏蔽。
7 o5 `* a  X1 S$ e0 \; c/ z经过测试，下面的程序可正常打开零件和装配体
# h0 i! I# n, N
' ******************************************************************************
: a2 B& k8 H' P" j% [% A, w( i$ ?' 读取指定目录下的Prt/asm文件，关闭
' ******************************************************************************
7 ~* n# t: V! ~& T( s9 x3 BDim swApp As Object

Dim Part As Object
Dim boolstatus As Boolean
0 H1 W8 E  c; k! Y. F5 ~  qDim longstatus As Long, longwarnings As Long
'Dim sldPath As String
Const sldPath As String = "E:\3Dtest\BOM1\"  '设定目录
/ b* v5 I% k: R4 D# W
Sub main()
. N; N0 K! Z5 y# i/ J1 o5 c
    Set swApp = _
    Application.SldWorks
    Set Part = swApp.ActiveDoc
        
5 n% c2 B0 D) h; P  G4 I$ Q    swFileName = Dir(sldPath & "*.sld*")
8 g9 z1 h. T$ ^! _" J" ?( k, Q9 b
  T, ~  R" ^4 q) e, E+ ^    Do While swFileName <> ""
        Set swApp = Application.SldWorks
. y5 L, u& c0 v3 o& Z- ]        If UCase(Right(swFileName, 3)) = "PRT" Then swFileTYpe = 1
2 t2 x6 l8 n4 g& N        If UCase(Right(swFileName, 3)) = "ASM" Then swFileTYpe = 2
7 T$ p6 X+ E* x+ g- }
% G! `5 ^  n0 J$ O3 E& G        Set swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)
0 E2 G: c0 p3 x5 }; ^        Set Part = swApp.ActiveDoc
+ p; f5 z% u+ R1 `        'Call plmain
        'Part.Save '保存
" L! o0 |+ c0 p( C" H        swApp.CloseDoc (swFileName) '关闭零件
/ N, ~' A0 k4 V0 T& z$ {2 o6 W        If swFileName = "" Then Exit Do:
        swFileName = Dir '搜寻下一个零件档案名称
    Loop '循环搜寻

/ M& \! U* @1 J6 j3 h, eEnd Sub

Ali.

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

: ~  Z6 K) G" \* H' G