solidworks 批量执行宏

knight3732449

观摩一下

受伤的仙人球

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

kbisi

Dim swApp As Object
Dim Part As Object
Dim sldPath As String
% Z& P9 f$ w0 {2 @
) L+ ?) z+ Z1 d* xDim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
  Q% S" U, v* x3 C

: O' H& P& L- |. x  ]% B8 o
$ ~! C* q3 Q! M0 b- _4 h
Sub Test()
Set swApp = Application.SldWorks
4 E6 D( J. Y( n0 k" GsldPath = "C:\Users\kbisi\Desktop\实验\" '设定目录

: i- l3 \* d7 W9 Z# i+ S# SswFileName = Dir(sldPath & "*.sld*")  '搜寻首个零件档案名称
If UCase(Right(swFileName, 3)) = "PRT" Then swFileTYpe = 1
9 k7 @1 r3 P; UIf UCase(Right(swFileName, 3)) = "ASM" Then swFileTYpe = 2

+ m" H* d/ `  I) n6 Q3 eDo While swFileName <> ""
9 W# u: O* v+ @, Y! @
Set swApp = Application.SldWorks
/ U' O. F( D; P: V
( C5 f7 C( [, `# L. U) `0 i'Set swDoc = swApp.OpenDoc(sldPath & swFileName, swFileTYpe) '开启零件

4 `, \9 _( m/ W0 e' u. tSet swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)
7 d4 t, `4 o& [; M
! f" h. Z$ k$ Z4 s0 ~; S
4 }9 h! q/ N7 G1 C1 k/ d, I4 d
) Y/ g  U2 C& `

Set Part = swApp.ActiveDoc

6 P  w0 E8 X7 G; z  S) SCall plmain
+ D: B, u5 M* s+ w/ v

' ]; D1 C" i5 C# M  ^'


9 H. B9 y$ Z; k4 i1 C7 t
Part.Save '保存%
swApp.CloseDoc (swFileName) '关闭零件
. [# N1 a$ B5 l. }0 c- n5 V5 a
If swFileName = "" Then Exit Do


. Q# U6 g% U" R3 S; |swFileName = Dir '搜寻下一个零件档案名称0

+ @& r# R% s1 d$ iLoop '循环搜寻
End Sub
$ [/ x, V7 V  r; e' n4 Q/ F" i9 {按F8一行看程序错误为什么老是跳过Then swFileTYpe = 2

kbisi

Dim swApp As Object
' Z# P3 w- l. Z6 T3 c0 S! T, NDim Part As Object
Dim sldPath As String
0 I' j0 w3 m' k$ f2 ?" }0 [
- T4 ?- D$ ^6 R8 vDim boolstatus As Boolean
7 l) r: G: B- X6 b! L, j3 B6 EDim longstatus As Long, longwarnings As Long
$ T; ^* u6 J5 U# u7 L& C& e* G
/ R+ A/ R0 c0 B$ K8 ^' w

9 U5 H7 h# F4 x2 y
2 A& F2 D7 a1 q/ p+ p3 @! kSub Test()
Set swApp = Application.SldWorks
. Y2 E/ J) \3 w7 NsldPath = "C:\Users\kbisi\Desktop\实验\" '设定目录
' }# v4 `- [& y+ x
swFileName = Dir(sldPath & "*.sld*")  '搜寻首个零件档案名称
5 e$ G( d$ B* p0 u# k4 [9 w  _If UCase(Right(swFileName, 3)) = "PRT" Then swFileTYpe = 1
# X0 y, U) s# }2 Y" ^: F2 CIf UCase(Right(swFileName, 3)) = "ASM" Then swFileTYpe = 2

0 L% g1 k+ e8 I8 j  x6 JDo While swFileName <> ""
1 c5 T- q- w3 S* o% ~4 _
4 [3 t' |" R  i& O* B5 X- xSet swApp = Application.SldWorks

'Set swDoc = swApp.OpenDoc(sldPath & swFileName, swFileTYpe) '开启零件
% t) s1 H* \6 {3 d0 a& M
Set swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)

9 c9 v, w  c% c; ]' n9 n
& o" Z4 Q, w) J2 @4 Q
5 u# u- c" B2 n& b& q
4 J! |- B. |: D3 [
Set Part = swApp.ActiveDoc

1 Z9 W4 V& H* U$ QCall plmain

" P* p; u! H+ u2 k- G4 i. B* N
5 }( w  F' y* `# ]) F8 H4 U'


3 F$ C4 F# {4 ]9 }. O$ J- M
: O8 ~. `0 \5 O) E, i" rPart.Save '保存%
, r1 |3 ]% [; T. ~' n- j6 [swApp.CloseDoc (swFileName) '关闭零件

  t, @% _! n8 R5 r& A+ lIf swFileName = "" Then Exit Do
8 h% [9 Q# k$ S. v0 @
4 @/ w$ k* R& G1 `3 Q
swFileName = Dir '搜寻下一个零件档案名称0

' a0 I' B$ U1 @Loop '循环搜寻
End Sub

kbisi

Dim swApp As Object
Dim Part As Object
' w/ \. J) P& N8 yDim sldPath As String
& i; y# d0 @& Z! z' j; L/ wDim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Sub Test()
Set swApp = Application.SldWorks
, w6 P/ H- G7 ^" ~, esldPath = "C:\Users\kbisi\Desktop\实验\" '设定目录
swFileName = Dir(sldPath & "*.sld*")  '搜寻首个零件档案名称
0 n8 l# N! I7 h; m  \$ T9 GIf UCase(Right(swFileName, 3)) = "PRT" Then swFileTYpe = 1
If UCase(Right(swFileName, 3)) = "ASM" Then swFileTYpe = 2
Do While swFileName <> ""
Set swApp = Application.SldWorks
1 B8 T+ A( P- L( P6 ^) A'Set swDoc = swApp.OpenDoc(sldPath & swFileName, swFileTYpe) '开启零件
; {' R/ m+ S$ D( k3 b+ I/ vSet swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)
Set Part = swApp.ActiveDoc
! v: V2 f7 D/ ICall plmain
. M7 [5 {+ T# [  w2 `5 j$ HPart.Save '保存%
swApp.CloseDoc (swFileName) '关闭零件
If swFileName = "" Then Exit Do
swFileName = Dir '搜寻下一个零件档案名称0
Loop '循环搜寻
End Sub   老是被跳过

kbisi

kbisi 发表于 2021-11-28 10:05
6 A! S6 }  g4 q% _) MDim swApp As Object
; n8 u+ L$ o. H1 t; _" ?1 eDim Part As Object
& n+ S2 s" ~$ t9 UDim sldPath As String

2 `% |! Q# s4 I, s4 a希望可以得到解答
; X4 s6 B% c4 E- `

kbisi

kbisi 发表于 2021-11-28 10:05
& G8 ^" m$ i: Q- x  xDim swApp As Object
! a2 w- d9 N6 p+ ?; f7 {; m3 sDim Part As Object
Dim sldPath As String

和楼主一样打不开装配体
7 g2 K+ `  l% X3 M! m! \

357755306b

多少积分可以分享

xinshiji666

kbisi 发表于 2021-11-28 13:44
: A2 O; v  `% Y5 u6 w# x4 c& u希望可以得到解答

无法打开装配体文件，是因为你把文件类型判定的语句放在循环外了，挪到do...loop内即可，那个call语句调用了什么？用不上可以先屏蔽。
经过测试，下面的程序可正常打开零件和装配体
, p2 f* b; S/ [3 d% p9 z3 A
. a; J4 ]) t" t' ******************************************************************************
' 读取指定目录下的Prt/asm文件，关闭
0 }/ z! T; u# J. w2 P' ******************************************************************************
Dim swApp As Object
5 l6 V+ \! n: F* F, e4 _3 b
Dim Part As Object
) x; u: k; b. \4 p: Z1 c2 R* |Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
: C, p7 m6 d- v7 w'Dim sldPath As String
. c/ c: J4 {0 s$ y/ a( S$ fConst sldPath As String = "E:\3Dtest\BOM1\"  '设定目录

" c% v% `0 v5 M3 _  I6 |( |Sub main()
' C8 X* k, c' c" U
% ?$ w  W+ h( J: J% a    Set swApp = _
    Application.SldWorks
; [+ z: O5 L2 N1 W    Set Part = swApp.ActiveDoc
2 n. B$ P9 F! f9 E        
    swFileName = Dir(sldPath & "*.sld*")

$ z# m" |0 S! Z5 x- A    Do While swFileName <> ""
! R8 L. F& |, W" V( s        Set swApp = Application.SldWorks
        If UCase(Right(swFileName, 3)) = "PRT" Then swFileTYpe = 1
        If UCase(Right(swFileName, 3)) = "ASM" Then swFileTYpe = 2

        Set swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)
        Set Part = swApp.ActiveDoc
        'Call plmain
1 n) z5 ^  w5 R, _% M        'Part.Save '保存
4 f4 T6 R% n1 F: [        swApp.CloseDoc (swFileName) '关闭零件
        If swFileName = "" Then Exit Do:
        swFileName = Dir '搜寻下一个零件档案名称
    Loop '循环搜寻

" u3 ~* o* X& [" G, VEnd Sub


; D/ S+ Z2 u# Q5 E

Ali.

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