solidworks 批量执行宏

knight3732449

观摩一下

受伤的仙人球

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

kbisi

Dim swApp As Object
  H9 c7 N1 Y; M6 ], `% _3 RDim Part As Object
$ k! H3 L! n7 u0 L7 SDim sldPath As String
) D+ I( {, X2 m, k+ a6 M
& W8 Y; d0 |# M9 Q/ QDim boolstatus As Boolean
. Y4 `) t; r& C! d% cDim longstatus As Long, longwarnings As Long
) f: }" d( x1 {
6 Q3 P3 V) Q( [6 e
( ~6 ^3 O+ d& ~5 x
7 R+ X, r& B/ Q: X* z
1 G7 V; v2 w( }8 g9 a1 j1 @Sub Test()
8 E* G; U% z+ S# L0 g. f2 ISet swApp = Application.SldWorks
sldPath = "C:\Users\kbisi\Desktop\实验\" '设定目录
; @6 `8 ]* m, D. }4 S
swFileName = Dir(sldPath & "*.sld*")  '搜寻首个零件档案名称
1 I3 c0 V; O; A; F3 W. hIf UCase(Right(swFileName, 3)) = "PRT" Then swFileTYpe = 1
If UCase(Right(swFileName, 3)) = "ASM" Then swFileTYpe = 2
- f2 d( R& t- B
1 w% N+ v& d3 v+ Z( C( s0 ODo While swFileName <> ""

6 r) c! _1 G1 I! }, J% O+ E/ ISet swApp = Application.SldWorks
( e) j5 W9 H* e; |- i# U
  g) y# E+ q6 i& Z- F7 w'Set swDoc = swApp.OpenDoc(sldPath & swFileName, swFileTYpe) '开启零件

Set swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)
, t4 y( }& W- B




! n! s/ B# ?  j+ u9 u- r! GSet Part = swApp.ActiveDoc

& i% W$ @) J. i# s8 VCall plmain
) F' L* r" w1 Q1 F) Z( ^

'



Part.Save '保存%
7 R$ r+ q0 S. ~- }( D& h5 QswApp.CloseDoc (swFileName) '关闭零件

If swFileName = "" Then Exit Do


swFileName = Dir '搜寻下一个零件档案名称0
5 A5 }5 r0 ]6 F) p9 N$ z8 B% d6 d8 a
5 V. \. n7 D4 c2 a. @. L: SLoop '循环搜寻
) L; L# S) U8 L2 UEnd Sub
4 T9 }: v( g# Q. A按F8一行看程序错误为什么老是跳过Then swFileTYpe = 2

kbisi

Dim swApp As Object
- M2 {2 B" G, O- mDim Part As Object
Dim sldPath As String

: y6 }3 v9 f; w4 Z) @0 FDim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
' |: a% o6 O9 d3 g



' N% L# g, M, X9 y3 ~Sub Test()
; d) U- G0 l2 D" G4 X- USet swApp = Application.SldWorks
sldPath = "C:\Users\kbisi\Desktop\实验\" '设定目录
! q/ z6 K7 k1 z8 Y7 \. ~
) f8 e4 ?5 Q) m* R$ F+ aswFileName = Dir(sldPath & "*.sld*")  '搜寻首个零件档案名称
+ l# ]8 |9 b2 n* y( _# i- E+ hIf UCase(Right(swFileName, 3)) = "PRT" Then swFileTYpe = 1
& f  ^& S* b7 Z+ ?4 C' BIf UCase(Right(swFileName, 3)) = "ASM" Then swFileTYpe = 2
% e' V" D  K* Z7 A0 V
Do While swFileName <> ""

Set swApp = Application.SldWorks

1 T% ~5 U' F! s, i' J$ f. n'Set swDoc = swApp.OpenDoc(sldPath & swFileName, swFileTYpe) '开启零件

Set swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)
% W+ H% Q2 l* D: k& E- [7 |


( z2 |' \+ V! I$ a* y
8 d0 h; P; @- e3 F
Set Part = swApp.ActiveDoc
+ R% s1 U& ~5 g3 {0 L
Call plmain
' [9 j; {4 Z2 ]4 X3 |- S( L+ I
% |. v' ~% K6 U! C( Q# Q
6 W6 s( e* G" M' y; W- Z7 R'
' [+ q- X9 X4 I3 c$ }

! i; X) U6 L9 y/ ?
4 Y+ X+ c  \0 D7 |! v' yPart.Save '保存%
9 ^6 D1 a0 m3 ]( m! wswApp.CloseDoc (swFileName) '关闭零件

  |1 Q% s1 e& t8 B% D1 @" rIf swFileName = "" Then Exit Do

: H7 W8 e4 U7 \
swFileName = Dir '搜寻下一个零件档案名称0
  }- `. O! s  k, u# i1 R
Loop '循环搜寻
End Sub

kbisi

Dim swApp As Object
+ ^+ q9 y; I5 k2 I3 bDim Part As Object
- F& j: |, l- ~# ?' |7 GDim sldPath As String
Dim boolstatus As Boolean
. E9 Q  Z# {& h2 ]Dim longstatus As Long, longwarnings As Long
7 k7 t+ S- c; {; v  V' `5 }Sub Test()
Set swApp = Application.SldWorks
" q. k( o. {; k! q* zsldPath = "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 <> ""
" T) i' A/ f" u. c0 {$ x0 WSet swApp = Application.SldWorks
* z( e  X& h( K/ S+ Q& o'Set swDoc = swApp.OpenDoc(sldPath & swFileName, swFileTYpe) '开启零件
Set swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)
Set Part = swApp.ActiveDoc
Call plmain
0 a! h2 W0 t+ lPart.Save '保存%
swApp.CloseDoc (swFileName) '关闭零件
% `/ F$ b4 J, I% H, Z5 cIf swFileName = "" Then Exit Do
/ }: X5 r8 [6 E# [- ^. f4 \6 lswFileName = Dir '搜寻下一个零件档案名称0
: n% a4 C/ U* X' n9 M' X; jLoop '循环搜寻
3 G  X, Z$ w- |3 [5 JEnd Sub   老是被跳过

kbisi

kbisi 发表于 2021-11-28 10:05
Dim swApp As Object
0 B* R- f0 v5 e* E7 m# }Dim Part As Object
Dim sldPath As String

6 r1 n2 v3 c  x# D2 G* \希望可以得到解答
+ P! T, q2 ^, e  o! S- C8 R

kbisi

kbisi 发表于 2021-11-28 10:05
5 T7 l" X) ^1 gDim swApp As Object
Dim Part As Object
7 E! M/ a/ s! N- I- I1 w2 zDim sldPath As String

和楼主一样打不开装配体

357755306b

多少积分可以分享

xinshiji666

kbisi 发表于 2021-11-28 13:44
; H5 F: W$ T/ ]& K9 H9 |; O; R希望可以得到解答

无法打开装配体文件，是因为你把文件类型判定的语句放在循环外了，挪到do...loop内即可，那个call语句调用了什么？用不上可以先屏蔽。
7 F0 J& F- V) ~) H经过测试，下面的程序可正常打开零件和装配体
2 S2 i' ~7 P0 S. z
' ******************************************************************************
! h/ s" W$ k* f' 读取指定目录下的Prt/asm文件，关闭
3 M. W4 p5 X. r+ Z1 j/ V: a' ******************************************************************************
Dim swApp As Object

4 l3 ]! F$ w5 b; b5 T' |$ DDim Part As Object
+ `8 v. n' e' h3 UDim boolstatus As Boolean
2 V' R* w3 l. L9 l0 {& `* ?" `8 EDim longstatus As Long, longwarnings As Long
* C" C; }, t* b* g' b, u'Dim sldPath As String
; j, E7 o0 R+ R0 ]9 t! d. j: K2 eConst sldPath As String = "E:\3Dtest\BOM1\"  '设定目录
, Z% a$ K- i. ]
Sub main()
0 B8 Y( e, X' |5 X9 G6 g
    Set swApp = _
    Application.SldWorks
    Set Part = swApp.ActiveDoc
$ }; V0 l" V& o* j; e        
    swFileName = Dir(sldPath & "*.sld*")
  g7 N) y( j) I, d0 z$ H# H( e! m
    Do While swFileName <> ""
        Set swApp = Application.SldWorks
3 ~8 W: m, K( H/ s/ B. t        If UCase(Right(swFileName, 3)) = "PRT" Then swFileTYpe = 1
        If UCase(Right(swFileName, 3)) = "ASM" Then swFileTYpe = 2

+ A- |$ ~& e; x- z* |        Set swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)
2 [2 s' q! B! Y0 r4 ?7 G- o        Set Part = swApp.ActiveDoc
9 x$ t, W1 F0 X! [  H' R, T        'Call plmain
1 w, a/ X3 X) ^- K+ _        'Part.Save '保存
% q2 ?: P) C7 N7 d+ v$ O        swApp.CloseDoc (swFileName) '关闭零件
        If swFileName = "" Then Exit Do:
        swFileName = Dir '搜寻下一个零件档案名称
    Loop '循环搜寻

. k+ C( V2 @# PEnd Sub

, F: b6 T2 c- C9 w

Ali.

能提供你成功运行的一个代打为参考吗我的一直报错
3 Y- a2 u' `+ S7 n