solidworks 批量执行宏

knight3732449

观摩一下

受伤的仙人球

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

kbisi

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

Dim boolstatus As Boolean
9 y3 k# X! s1 C3 m1 S! f) C& C2 [Dim longstatus As Long, longwarnings As Long
  u$ u3 V! O& ~6 h" J


) v% W+ L* d3 b+ i$ [, E2 X
Sub Test()
  W; O) P! K9 ]6 |Set swApp = Application.SldWorks
sldPath = "C:\Users\kbisi\Desktop\实验\" '设定目录
8 m3 q  V) x* [1 `5 l( j( e8 C0 @2 o
swFileName = Dir(sldPath & "*.sld*")  '搜寻首个零件档案名称
If UCase(Right(swFileName, 3)) = "PRT" Then swFileTYpe = 1
If UCase(Right(swFileName, 3)) = "ASM" Then swFileTYpe = 2
0 ~7 I* G7 M2 ?. C; C
3 f  M8 I8 ]# l( Z/ p6 {Do While swFileName <> ""

# v; I. u% S4 c: O( A0 r8 m( _. zSet swApp = Application.SldWorks
. X+ c9 I1 ]7 u9 B
& J( D$ Y% f# Z( U2 k'Set swDoc = swApp.OpenDoc(sldPath & swFileName, swFileTYpe) '开启零件

) B& C6 |% V( ~% w' p# D* HSet swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)

' p1 F$ k* @" s$ O" B



Set Part = swApp.ActiveDoc

Call plmain
' m' _: U4 O4 W( Y4 o  m# \; X
5 `! z1 Q& W6 m
9 \) D7 o  @# x% _: A'
+ ?) q' v1 \6 R# m% K& C
9 p! K7 i- c) G% x* a5 I- e

* M. m5 _4 F- mPart.Save '保存%
swApp.CloseDoc (swFileName) '关闭零件

8 d7 a+ `. p2 e' q( |If swFileName = "" Then Exit Do
' [  s7 y9 L4 z

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

Loop '循环搜寻
End Sub
( N4 o( y3 y% M) D$ K+ o6 a$ @按F8一行看程序错误为什么老是跳过Then swFileTYpe = 2

kbisi

Dim swApp As Object
Dim Part As Object
Dim sldPath As String
4 H8 R* I2 q* ^) I* q* g$ `4 M6 p
+ E" |7 k+ y& y/ Z; \+ D' J+ g1 D1 _Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
  m( L. j. p9 ~4 {

$ m' f1 l  Q; g
9 g+ G; r9 e  u. i- Z% @
: q/ B  M7 k9 p( P- ?3 SSub Test()
Set swApp = Application.SldWorks
sldPath = "C:\Users\kbisi\Desktop\实验\" '设定目录
$ y7 B3 I+ e7 _" W
# `- a2 Y- m. C" E9 X, w6 {1 P9 wswFileName = Dir(sldPath & "*.sld*")  '搜寻首个零件档案名称
If UCase(Right(swFileName, 3)) = "PRT" Then swFileTYpe = 1
If UCase(Right(swFileName, 3)) = "ASM" Then swFileTYpe = 2
' L+ v0 U' e6 ~# d7 J
Do While swFileName <> ""

  J/ d/ _2 w) c+ eSet swApp = Application.SldWorks
+ W- ?% [) h. A0 a* Y6 N
5 Z# F0 @* g& U'Set swDoc = swApp.OpenDoc(sldPath & swFileName, swFileTYpe) '开启零件

9 Q/ j3 i; n2 B9 S2 FSet swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)


. X1 W7 p0 L' j' v+ N
/ E6 A+ e  o/ T; w% P0 P3 {. k

Set Part = swApp.ActiveDoc
* Y: S4 p7 g/ J; |  j7 G
! Q$ d; r6 [; _3 WCall plmain
2 q& \9 G8 t7 l$ p  }( f7 ]: [

1 |4 c. |! b$ B/ X'
) [) \7 Y6 \+ ^& c
6 ]3 R* f+ Q$ J* E. C, p) S
9 U$ k) C/ h" a6 _$ H1 z
; u/ D/ `  @. x: S6 u+ G. BPart.Save '保存%
" W; c8 z9 M3 d+ b  m1 T8 j1 F8 XswApp.CloseDoc (swFileName) '关闭零件
' R; l8 ?6 g' `; K- q0 z  V- [
' k4 ]9 u1 J: B& Q1 ^If swFileName = "" Then Exit Do
* T9 E' J+ |3 K8 ?

swFileName = Dir '搜寻下一个零件档案名称0
  ?5 b) m) m' w2 ?
: l7 d2 E3 d( l% a: n: O" s1 OLoop '循环搜寻
2 l$ c, l' E; I" y8 mEnd Sub

kbisi

Dim swApp As Object
Dim Part As Object
Dim sldPath As String
! t! j8 |- y8 h9 U9 }/ yDim boolstatus As Boolean
/ V/ G% P" h# @2 f- s: C  `5 sDim longstatus As Long, longwarnings As Long
Sub Test()
  r$ ?2 @4 ]* s- g' sSet swApp = Application.SldWorks
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
* t" T8 \  {5 eDo While swFileName <> ""
Set swApp = Application.SldWorks
'Set swDoc = swApp.OpenDoc(sldPath & swFileName, swFileTYpe) '开启零件
9 [) M- q" N/ n/ c/ aSet swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)
6 m9 f! h, t7 S9 v/ ?8 a4 j, iSet Part = swApp.ActiveDoc
Call plmain
- z* z' @: H; g9 e& |, zPart.Save '保存%
5 R2 o- ~2 s# _- A5 g$ @3 FswApp.CloseDoc (swFileName) '关闭零件
If swFileName = "" Then Exit Do
( y' M# Y, @& m. ?5 kswFileName = Dir '搜寻下一个零件档案名称0
+ q: t7 r, K6 e+ ULoop '循环搜寻
" z$ f7 Z4 b" U6 DEnd Sub   老是被跳过

kbisi

kbisi 发表于 2021-11-28 10:05
& o7 V" z3 v2 S, c; y6 a  w  }Dim swApp As Object
Dim Part As Object
Dim sldPath As String

" w1 _7 \" j1 Y: r$ B* O1 ?希望可以得到解答

kbisi

kbisi 发表于 2021-11-28 10:05
Dim swApp As Object
Dim Part As Object
( u/ Y7 C* m2 t/ FDim sldPath As String

0 \( A* G6 w  r" b和楼主一样打不开装配体
3 I  P) \! ^4 m( y- D' G0 o( k1 Q

357755306b

多少积分可以分享

xinshiji666

kbisi 发表于 2021-11-28 13:44
6 D4 h: C- A% w" A0 q1 e$ X希望可以得到解答

无法打开装配体文件，是因为你把文件类型判定的语句放在循环外了，挪到do...loop内即可，那个call语句调用了什么？用不上可以先屏蔽。
# d2 J& W  |! Z1 C' p经过测试，下面的程序可正常打开零件和装配体
2 u3 w( t; f3 q
' ******************************************************************************
  X" L1 i! _: G- h+ b1 S' 读取指定目录下的Prt/asm文件，关闭
  J' G0 T; x+ s0 {; q' ******************************************************************************
Dim swApp As Object

+ g+ d: _" |$ ^2 q* bDim Part As Object
& T# V9 }+ l3 i2 dDim boolstatus As Boolean
- C4 P, t# D: u4 E9 Q* yDim longstatus As Long, longwarnings As Long
'Dim sldPath As String
Const sldPath As String = "E:\3Dtest\BOM1\"  '设定目录
0 B+ V* U1 }% R+ p3 i
; w3 u* Y6 s* j4 |$ f8 mSub main()

    Set swApp = _
) r  L$ ~) J3 P    Application.SldWorks
    Set Part = swApp.ActiveDoc
        
# L, L! l  D; j    swFileName = Dir(sldPath & "*.sld*")
) O3 {" j! t  h  }, A0 s
    Do While swFileName <> ""
        Set swApp = Application.SldWorks
" ]- _! p4 V5 f& r$ }        If UCase(Right(swFileName, 3)) = "PRT" Then swFileTYpe = 1
        If UCase(Right(swFileName, 3)) = "ASM" Then swFileTYpe = 2
) k. J$ @% c8 C8 x
) h  r( _' L/ I8 e$ q4 [        Set swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)
2 v* @: S( f2 T  s0 s$ [        Set Part = swApp.ActiveDoc
        'Call plmain
$ S6 B$ M8 C  A0 d* G6 E        'Part.Save '保存
        swApp.CloseDoc (swFileName) '关闭零件
5 T8 R- X9 d( B5 F: W3 T; \        If swFileName = "" Then Exit Do:
6 p2 ~$ H1 c9 a6 Q+ w8 ^) S5 f        swFileName = Dir '搜寻下一个零件档案名称
2 S. P% h( t7 x- n0 N' y  |    Loop '循环搜寻
! [* H) M  f: `" m0 r1 n6 M5 I. M
End Sub


' B" r3 R; v5 t. E% F8 `. x

Ali.

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

5 U" P- F) G) t