solidworks 批量执行宏

knight3732449

观摩一下

受伤的仙人球

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

kbisi

Dim swApp As Object
# W+ U' d( Z( \# mDim Part As Object
4 n& U0 X- R2 ~; G$ ZDim sldPath As String

Dim boolstatus As Boolean
2 S$ N- E+ F' _% |" ^Dim longstatus As Long, longwarnings As Long
' d2 S% ]! J  f# W% A9 o



Sub Test()
6 ]( D; p# l2 l! O/ E3 USet swApp = Application.SldWorks
sldPath = "C:\Users\kbisi\Desktop\实验\" '设定目录
: s5 e5 Y* Y, a: L
swFileName = Dir(sldPath & "*.sld*")  '搜寻首个零件档案名称
( \2 ?8 S) V* G/ y( vIf UCase(Right(swFileName, 3)) = "PRT" Then swFileTYpe = 1
If UCase(Right(swFileName, 3)) = "ASM" Then swFileTYpe = 2
/ M- f1 R0 }+ r) v: C
Do While swFileName <> ""

Set swApp = Application.SldWorks
" p* E3 K" a$ E
3 B1 R. z6 u% e'Set swDoc = swApp.OpenDoc(sldPath & swFileName, swFileTYpe) '开启零件
2 S- V& [( X' F: @, n
Set swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)
. N0 A0 |8 [% w9 \




Set Part = swApp.ActiveDoc

/ [9 X1 u  }8 B, t: RCall plmain
8 X, R; Q6 Q- V. `: p% y# f# d2 a

'



0 d0 x; A* p( K% S* y" z1 ePart.Save '保存%
6 I$ h2 }0 X7 }9 S& ZswApp.CloseDoc (swFileName) '关闭零件

If swFileName = "" Then Exit Do
& C2 D" y# G% }5 |& s& [, b
% p8 Y' n5 t4 [
" e6 Z; o5 [# ^swFileName = Dir '搜寻下一个零件档案名称0

Loop '循环搜寻
7 u1 S. ~0 V7 q) xEnd Sub
按F8一行看程序错误为什么老是跳过Then swFileTYpe = 2

kbisi

Dim swApp As Object
9 A! M6 o% G# l: |8 j1 wDim Part As Object
Dim sldPath As String
8 X9 a/ O+ P6 [
Dim boolstatus As Boolean
& f3 q9 z; ^! s( w- s. oDim longstatus As Long, longwarnings As Long


1 l8 {. v0 `. ^; Y
: N/ f- P/ _% ~3 w3 |
Sub Test()
1 N. x: T$ {% m; hSet swApp = Application.SldWorks
' D8 |% ]( y8 k* d% D+ g3 dsldPath = "C:\Users\kbisi\Desktop\实验\" '设定目录
  F- P% C# L* C3 Y3 [
: D: W  I& P1 |swFileName = Dir(sldPath & "*.sld*")  '搜寻首个零件档案名称
If UCase(Right(swFileName, 3)) = "PRT" Then swFileTYpe = 1
If UCase(Right(swFileName, 3)) = "ASM" Then swFileTYpe = 2
& Z5 C6 _4 \4 d& n# A
5 n& t, |# j2 ^1 |: vDo While swFileName <> ""

% e0 y0 Z4 I/ j8 g4 R  ~6 j. @* rSet swApp = Application.SldWorks
2 }5 J8 ]9 ?5 X
'Set swDoc = swApp.OpenDoc(sldPath & swFileName, swFileTYpe) '开启零件

Set swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)
% V% d# k' G5 _



2 a- g; Z" j: d- O" z0 Y: q
; }  K* D# p  u+ F7 Y/ PSet Part = swApp.ActiveDoc

! Q5 K' r# `- V7 Q9 ^Call plmain
: m1 W+ U/ y  L
3 Q# q/ Z9 v9 j/ j/ ~2 s* e6 E' k" I
# R# F( o; W8 D. \1 A'

; h6 w# \0 f# k" N4 Y5 I6 \
8 m- a$ J: c" Y; F0 i, v& O
Part.Save '保存%
swApp.CloseDoc (swFileName) '关闭零件

If swFileName = "" Then Exit Do
7 w0 ]1 V; S% [! E, Z

8 K; j7 o/ C2 [. ?/ o0 j8 y' `swFileName = Dir '搜寻下一个零件档案名称0
' {1 r1 i0 r  d# U
Loop '循环搜寻
End Sub

kbisi

Dim swApp As Object
7 `* c* a' l3 t+ V( y- cDim Part As Object
# [5 ~; k5 J" Z; J& BDim sldPath As String
Dim boolstatus As Boolean
/ U3 i6 Y+ t) p& ]* RDim longstatus As Long, longwarnings As Long
Sub Test()
( c+ S( {5 ?$ e* oSet 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
Do While swFileName <> ""
/ @/ f7 m$ E4 l' Q. iSet swApp = Application.SldWorks
5 L- k# v" x, j! n4 O'Set swDoc = swApp.OpenDoc(sldPath & swFileName, swFileTYpe) '开启零件
# N+ p- s* Y) ^3 l8 K: wSet swModel = swApp.OpenDoc6(sldPath & swFileName, swFileTYpe, swOpenDocOptions_Silent, "", longstatus, longwarnings)
4 f0 `: w/ |( V1 nSet Part = swApp.ActiveDoc
) P5 k8 A) i) ^# e8 ?Call plmain
Part.Save '保存%
swApp.CloseDoc (swFileName) '关闭零件
If swFileName = "" Then Exit Do
0 W/ _5 R7 t; t% d7 ~7 aswFileName = Dir '搜寻下一个零件档案名称0
Loop '循环搜寻
End Sub   老是被跳过

kbisi

kbisi 发表于 2021-11-28 10:05
2 }2 }7 B2 f6 M- n3 `4 }Dim swApp As Object
% o1 \$ g6 M) K4 I% L0 F' l8 U0 EDim Part As Object
) i% e; k8 H) d# @Dim sldPath As String

. w0 I+ @" r2 A0 c+ @3 u1 _$ G希望可以得到解答

kbisi

kbisi 发表于 2021-11-28 10:05
( Z" t1 Q6 \# |! p" `Dim swApp As Object
Dim Part As Object
Dim sldPath As String

和楼主一样打不开装配体

357755306b

多少积分可以分享

xinshiji666

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

: @% `: H- H: T2 C3 p无法打开装配体文件，是因为你把文件类型判定的语句放在循环外了，挪到do...loop内即可，那个call语句调用了什么？用不上可以先屏蔽。
# |& v, q0 [0 f2 d1 F! Z% ?  e3 P经过测试，下面的程序可正常打开零件和装配体

# U6 N$ \  g5 y; S4 s1 W" A' ******************************************************************************
' 读取指定目录下的Prt/asm文件，关闭
' ******************************************************************************
6 T3 P# [6 s2 m2 h9 CDim swApp As Object

" ^0 ?! L7 Q% \5 H$ M) I/ `Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
'Dim sldPath As String
Const sldPath As String = "E:\3Dtest\BOM1\"  '设定目录
: M8 C8 z' I9 r) a
Sub main()

8 q8 U, k8 [( a, y    Set swApp = _
; H5 @! x% L; h: l/ i% M" k' ]# ?    Application.SldWorks
    Set Part = swApp.ActiveDoc
        
" U1 ^  T" m6 Z8 V  M3 R3 N( _    swFileName = Dir(sldPath & "*.sld*")
/ F" f, e) ?' o( ], F
3 l4 ]( J; U& Y( L- R/ {    Do While swFileName <> ""
+ [9 l! U  E8 p4 w" D( E0 w: Y/ X; v        Set swApp = Application.SldWorks
0 B- w7 p+ t8 ]9 u7 p' V        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
) `( {5 @7 h( T/ q9 \3 E        'Part.Save '保存
        swApp.CloseDoc (swFileName) '关闭零件
        If swFileName = "" Then Exit Do:
! Q- a! E' S2 M) C. h/ [        swFileName = Dir '搜寻下一个零件档案名称
    Loop '循环搜寻

End Sub
" U. ]$ a9 n' \2 H
7 S. t0 Q- M1 E* j% K6 i4 d2 L$ \

Ali.

能提供你成功运行的一个代打为参考吗我的一直报错
9 n* n, D0 m& ?$ l& u
4 H7 F, D- j4 r/ G; s: J