solidworks 批量执行宏

knight3732449

观摩一下

受伤的仙人球

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

kbisi

Dim swApp As Object
5 T$ j& v1 J/ t1 _Dim Part As Object
" U" O( @) e, {3 |8 s3 @# {; c% IDim sldPath As String
. y( u$ K( W# J3 E# ~4 L; I
Dim boolstatus As Boolean
; q: L5 \; G) w/ Q3 k% wDim longstatus As Long, longwarnings As Long
1 `: D, k1 k0 o. H


, W- _6 k6 `. n1 z9 s5 H
Sub Test()
Set swApp = Application.SldWorks
8 p( ]$ L# O3 z  a6 X! zsldPath = "C:\Users\kbisi\Desktop\实验\" '设定目录
- r) B: R: c, |2 ^& x
- M. n; M) n, N6 d: WswFileName = Dir(sldPath & "*.sld*")  '搜寻首个零件档案名称
  w) {6 [+ v$ v* n/ U/ e" oIf UCase(Right(swFileName, 3)) = "PRT" Then swFileTYpe = 1
! a3 y/ }* |, i! K" VIf UCase(Right(swFileName, 3)) = "ASM" Then swFileTYpe = 2
% L( h- ], [0 U0 ^0 l" C% T
Do While swFileName <> ""
2 U" O4 f: R2 _* [
# c. k5 t$ [8 L6 l$ S0 D% hSet swApp = Application.SldWorks

'Set swDoc = swApp.OpenDoc(sldPath & swFileName, swFileTYpe) '开启零件
( N0 P( s$ [' H4 n- U
5 Z9 q/ ^- _2 ZSet swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)


* E9 |9 H& |1 J


Set Part = swApp.ActiveDoc
7 p  _9 u" @4 ~/ o% W
  N& d( [5 h% F% F  s, ?0 kCall plmain


$ A) q/ I2 C2 l& \' r'
& [% i  P% c" b% H8 @6 A
# ^# @; [8 g7 {+ k4 ]

" x  J# z( F9 D& ~3 m; ]+ ]% APart.Save '保存%
/ e  S, r  [4 k- D/ BswApp.CloseDoc (swFileName) '关闭零件

% \- l5 g% X. FIf swFileName = "" Then Exit Do
& k2 _4 b9 O- x
, o% D4 o- h; T9 t4 y( J3 N0 l
5 n1 l! U0 l' n) m9 L2 R9 X5 I, y) xswFileName = Dir '搜寻下一个零件档案名称0

: N0 b0 z$ i" DLoop '循环搜寻
End Sub
按F8一行看程序错误为什么老是跳过Then swFileTYpe = 2

kbisi

Dim swApp As Object
5 A1 m3 {, z( g/ RDim Part As Object
Dim sldPath As String
: z& q, N" y9 Q# j; e' Y
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long

/ B. E$ R8 w  T& y! I
' Z( I4 L! N3 g% r* w+ n" J7 l

Sub Test()
: ^) B; p$ E; G7 T* U6 USet swApp = Application.SldWorks
' N0 r+ i  A  `* R4 m8 E0 SsldPath = "C:\Users\kbisi\Desktop\实验\" '设定目录
: L, C) l3 e* T1 k, I
swFileName = Dir(sldPath & "*.sld*")  '搜寻首个零件档案名称
; N* i0 A# W" U9 }7 {6 [If UCase(Right(swFileName, 3)) = "PRT" Then swFileTYpe = 1
+ B) n7 }5 s) m/ Y" d# z& sIf UCase(Right(swFileName, 3)) = "ASM" Then swFileTYpe = 2
$ G2 H  ?) G6 i$ t% f
  R9 m' H) q% D( F9 }" q% \Do While swFileName <> ""
: Z+ B# x9 g, k. W
( G- r5 [5 `: V- P; GSet swApp = Application.SldWorks
: e& k2 L' t- \3 I1 F
8 X4 ?9 Q2 \. N6 p5 i+ }'Set swDoc = swApp.OpenDoc(sldPath & swFileName, swFileTYpe) '开启零件

/ {! \  g- K! o8 M+ ?Set swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)
9 L+ O7 ]) G, Q* f
5 w/ j* `! m' t7 A8 c
: D/ {0 R- j4 W& Y4 j. K
1 q$ D& x/ X' A7 z! k

Set Part = swApp.ActiveDoc

Call plmain
4 l+ i; g: x$ V1 Y

! i, U" S- l: I'


; R* Q$ R( C0 P' ]7 o& T' W) z/ X
Part.Save '保存%
swApp.CloseDoc (swFileName) '关闭零件

If swFileName = "" Then Exit Do

- d2 u) M; N" v$ H+ g
" ]4 F& l- R' ~' _1 BswFileName = Dir '搜寻下一个零件档案名称0
& p1 [6 _2 l$ i7 s4 s3 \6 P
9 ^( G1 i7 {: Y( t* WLoop '循环搜寻
End Sub

kbisi

Dim swApp As Object
Dim Part As Object
8 p5 k* V0 M1 i% h$ R& k, XDim sldPath As String
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
4 g' e3 r* _1 h0 ]# o$ xSub Test()
Set swApp = Application.SldWorks
; _  R% y$ o, h+ }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 <> ""
; D$ f# [. _+ A$ O, {Set swApp = Application.SldWorks
'Set swDoc = swApp.OpenDoc(sldPath & swFileName, swFileTYpe) '开启零件
; w$ z1 k' S& zSet swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)
Set Part = swApp.ActiveDoc
Call plmain
/ ?. r: ~9 ?% t% Y+ `Part.Save '保存%
swApp.CloseDoc (swFileName) '关闭零件
  r$ P' a) K3 dIf swFileName = "" Then Exit Do
' q2 d5 H. O& x4 K6 [swFileName = Dir '搜寻下一个零件档案名称0
, u5 `( u& b, t. ]Loop '循环搜寻
9 D2 M- t) g3 U6 i6 |# iEnd Sub   老是被跳过

kbisi

kbisi 发表于 2021-11-28 10:05
Dim swApp As Object
Dim Part As Object
+ `: u, j3 p, a. N: ODim sldPath As String

希望可以得到解答

kbisi

kbisi 发表于 2021-11-28 10:05
Dim swApp As Object
  q, d1 U9 _5 c; S/ fDim Part As Object
Dim sldPath As String

% h3 Y7 c3 o3 ^- J& S和楼主一样打不开装配体

357755306b

多少积分可以分享

xinshiji666

kbisi 发表于 2021-11-28 13:44
/ ]4 M2 r6 U- f' l希望可以得到解答

- e( x  z1 a8 A8 f* n7 S无法打开装配体文件，是因为你把文件类型判定的语句放在循环外了，挪到do...loop内即可，那个call语句调用了什么？用不上可以先屏蔽。
经过测试，下面的程序可正常打开零件和装配体
* W* W6 Z; s+ m2 t6 _. X/ y6 U, F0 T
# D# ^. o$ V9 f* b1 t' ******************************************************************************
' 读取指定目录下的Prt/asm文件，关闭
1 d* D  ?1 q/ h6 c* f2 R' ******************************************************************************
Dim swApp As Object

9 I' v* N& X/ _! uDim Part As Object
% R8 |4 i2 S0 ^) ?Dim boolstatus As Boolean
' M) Y1 S2 P- O9 i3 tDim longstatus As Long, longwarnings As Long
$ M2 ^" F: `/ K'Dim sldPath As String
. \* h% ^1 I, iConst sldPath As String = "E:\3Dtest\BOM1\"  '设定目录
. [; ^* _( h$ Y( ^9 l4 z. M2 a
Sub main()
6 Q7 o! k! A) e
$ h9 t4 \# z" M9 o: g% U    Set swApp = _
; b# y/ g  D; n. G    Application.SldWorks
  I5 y9 m% Q. T    Set Part = swApp.ActiveDoc
        
    swFileName = Dir(sldPath & "*.sld*")

/ K2 x& ^3 s% X% Q/ W    Do While swFileName <> ""
        Set swApp = Application.SldWorks
        If UCase(Right(swFileName, 3)) = "PRT" Then swFileTYpe = 1
  T$ f6 D" V, h" ^) E2 ]        If UCase(Right(swFileName, 3)) = "ASM" Then swFileTYpe = 2

        Set swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)
5 \, D9 j  v8 ?, M9 Z        Set Part = swApp.ActiveDoc
. L9 k2 I3 m& J* [" m2 Y        'Call plmain
        'Part.Save '保存
        swApp.CloseDoc (swFileName) '关闭零件
, b6 k1 k3 S; e+ j% Q; @! }0 b        If swFileName = "" Then Exit Do:
' G' P8 J  V0 A+ Z  v5 A* |0 _        swFileName = Dir '搜寻下一个零件档案名称
    Loop '循环搜寻
+ v4 Y$ P7 Q7 P* ~. U) T7 u
1 E& z0 F# K& M2 x! |End Sub

Ali.

能提供你成功运行的一个代打为参考吗我的一直报错
9 m- {; B' y' V* [3 ?6 m( ?; i4 [
2 }* ?# O7 {& }; a9 [& v8 v' e; i8 u