SOLIDWORKS 宏合并执行的问题

arter_2006 · 发表于 2018-11-23 12:41:43

是这样的，想做一个宏，通过这个宏，会先后调用其它的宏，请问如何编写？非常感谢。
宏的名称分别是：
删除所有配置属性.swp
删除自定义属性.swp
partitionTM.swp

ryouss · 发表于 2018-11-23 14:34:19

參考

Sub 删除所有配置属性()
.
.
.
Call 删除自定义属性 '呼叫 "删除自定义属性" 之宏
.
.
End Sub

Sub 删除自定义属性()
.
.
End Sub

arter_2006 · 发表于 2018-11-24 12:51:08

ryouss 发表于 2018-11-23 14:34
: O: O9 E) W5 w. ~8 H4 N6 y$ n9 h參考

非常感谢您的指点，根据我的浅薄理解，我的宏如下，但不起作用：
' ******************************************************************************
' C:\Users\admin\AppData\Local\Temp\swx10500\Macro1.swb - macro recorded on 11/24/18 by arter
' ******************************************************************************
Dim swApp As Object

Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Sub 删除所有配置属性()

Call 删除自定义属性

End Sub

Sub 删除自定义属性()

Call partitionTM

End Sub

Sub partitionTM()

End Sub

能否帮我改下？非常感谢。

arter_2006 · 发表于 2018-11-24 12:53:47

不知道3个宏有没有问题，这三个宏单独执行的是没问题的。上面提到的，就是想把附件压缩包里的三个宏联合执行。

ryouss · 发表于 2018-11-24 13:45:49

arter_2006 发表于 2018-11-24 12:53. I' n0 o" g n
不知道3个宏有没有问题，这三个宏单独执行的是没问题的。上面提到的，就是想把附件压缩包里的三个宏联合执 ...

[Run main() 試試!]

' ******************************************************************************# r: h; Z& m. H* r+ R4 Y6 M
' C:\Users\admin\AppData\Local\Temp\swx8144\Macro1.swb - macro recorded on 11/22/18 by mqlu
1 w" ^+ N4 o O0 C4 e$ |+ V
' ******************************************************************************
' z. M! ^) I/ i* ^ r# C0 d O
Dim swApp As Object
y L5 u; ?. P1 V6 Y
Dim Part As Object
% }# w% e1 }' l3 [5 \9 e+ v) b# W+ \
Dim boolstatus As Boolean* H2 e' J& Q& h/ R1 R
Dim longstatus As Long, longwarnings As Long
" k, C- n: l# w/ I! Y M8 H8 ]/ C
k$ `" P! H4 z s1 a
Dim SelMgr As Object5 \0 c' Q2 ~. H
Dim Feature As Object' A, J; @& O' E, ~- k5 d: }
Dim a As Integer2 o- S3 N; w8 u) ^8 d
Dim b As String* F: k* a/ i$ D4 S5 v
Dim m As String
6 a( G/ {) N% H; M) ^$ z' i
Dim e As String
+ n- E' j6 B# a1 d- U
Dim k As String4 ?) [, }% Y& C3 b- J
Dim t As String
7 A" M4 r. N3 W
Dim c As String
" w# o- ?" f. l( k
Dim j As Integer K8 U1 J3 v& D9 _9 r* H+ c
Dim strmat As String
' z9 {! Y: P6 r# v' A7 F
Dim tempvalue As String) P1 j5 c+ ^4 o l: F
% n/ l5 y2 R6 d0 t) u) _6 I* I
Sub main() '刉壺垀衄饜离扽俶(刪除所有配置屬性)
. s/ y8 m; z3 Z, p) n
Set swApp = Application.SldWorks" |3 F9 `4 `+ E. `4 w& s N
Set Part = swApp.ActiveDoc
2 O1 }( A# V$ d5 C" Y7 M- b
CurCFGname = Part.GetConfigurationNames, t2 r6 A+ Y; I3 t% H( {% f8 t) f
CurCFGnameCount = Part.GetConfigurationCount, c7 X* u9 w! \! i1 L
For i = 0 To CurCFGnameCount - 1
2 B/ E5 T; E- B# c( n3 u: d
Set CusPropMgr = Part.Extension.CustomPropertyManager(CurCFGname(i))7 Q2 p9 o) E8 N5 V% R
Vnamearr = CusPropMgr.GetNames
( V/ c: ?# ~2 h
If Not IsEmpty(Vnamearr) Then. |* p+ b* H4 ?# r( B
For Each Vnamearr2 In Vnamearr
+ d! }1 I1 P0 J4 y
bRet = Part.DeleteCustomInfo2(CurCFGname(i), Vnamearr2)
( R- T* W+ U$ ?; E1 [ V9 P
Next, Y! ?9 c1 F4 G+ l& W5 i6 g
End If6 T+ V, N7 n6 R1 ?, ^
Next( `6 X3 ~; S% b! w) z+ L
Call 刉壺赻隅砱扽俶 '(刪除自定義屬性)9 [2 k( c* `, M9 i
Call partitionTM
+ }' z( e% u+ W, w% W1 a* r
+ h8 j8 m7 ~. Q4 W+ u
End Sub
) r0 ~2 k2 ]$ F; g4 E* f
( e# Z" j0 B2 @4 h
'~~~ 刉壺赻隅砱扽俶 ~~~
; w2 K6 o/ v6 ?9 T' L% ~
Sub 刉壺赻隅砱扽俶() '(刪除自定義屬性)
3 P* w8 H B* W5 G1 {
'Dim swApp As Object" _, I3 O( l/ @1 \
Dim swModel2 As SldWorks.ModelDoc23 {5 ~$ L" F, I! J) g9 ~
Dim vCustInfoNameArr2 As Variant1 ?& z' s' z( A" Y/ n5 |
) z/ J6 G1 f7 \* e3 _5 {$ Z- B1 j
Set swApp = Application.SldWorks2 J9 f2 z0 L3 \
Set swModel2 = swApp.ActiveDoc
8 b' l4 n! w) x/ K$ f4 k
vCustInfoNameArr2 = swModel2.GetCustomInfoNames
1 k# @/ v0 J" l$ M
If Not IsEmpty(vCustInfoNameArr2) Then
% j) s& M0 Y% `/ H
For Each vCustInfoName2 In vCustInfoNameArr2
9 n3 t; s. s* K5 u; Z
bRet = swModel2.DeleteCustomInfo(vCustInfoName2)
8 m c2 ?- P, z
Next
p- B" h; [7 q& }3 ]- p
End If
4 s1 d0 }2 T5 [& M, G" ?( y
End Sub _% C% c* Y/ W/ q5 p J
, K1 v. v8 Z. Y; U9 q
'~~~ partitionTM ~~~2 K- d4 W5 i" Q# K$ V
Sub partitionTM() 'partitionTM- `* j0 m! y4 ^; ^# t/ S
I! Y7 w2 r) \% ]
'link solidworks
- Q: a. l: u0 G2 y5 S- v) u7 }
Set swApp = Application.SldWorks/ g) X; a6 U, B$ Z0 R5 F: ]
Set Part = swApp.ActiveDoc
% `- u7 N5 M- Y7 H
Set SelMgr = Part.SelectionManager
5 I" T- v# Y1 G4 i$ V4 Y T
swApp.ActiveDoc.ActiveView.FrameState = 14 _* M2 z2 Y1 O3 A
'扢隅曹講
4 C/ O" ^) ?6 f" P: c
c = swApp.ActiveDoc.GetTitle() '錨璃靡8 J/ U6 _: e7 r1 e; I( K$ e7 d
strmat = Chr(34) + Trim("SW-Material" + "@") + c + Chr(34)
/ e/ f' D" k4 l' t& ~7 R$ a
'tempvalue = Part.CustomInfo2("", "第蹋"), m0 O3 |$ ^$ Q) a
blnretval = Part.DeleteCustomInfo2("", "測瘍")
7 D, Y/ U6 n% M$ [
blnretval = Part.DeleteCustomInfo2("", "靡備")4 C% O% j" d% _- Y8 `
blnretval = Part.DeleteCustomInfo2("", "第蹋")% t8 F& j- y% L% G
a = InStr(c, " ") - 1
7 G- K5 \" n9 o) V8 e; \
If a > 0 Then" Q; l' n- w& o/ V2 m3 t$ `
k = Left(c, a)% s( J/ U J! K
t = Left(LTrim(e), 3)
+ I; R, n$ w+ H$ }
If t = "GBT" Then
6 p, o. ^6 [% S1 b: ]- g# N
e = "GB/T" + Mid(k, 4)
) D9 W- G2 L6 i, q! ~" T! l: D
Else2 q$ E, y- t' K# f* Z% U
e = k
' y' |' e; |9 B% \' F7 w
End If# p+ l2 [' s0 g+ ], {, J: S8 p
b = Mid(c, a + 2)9 X0 e" W* Q$ H1 A& B! a/ W
t = Right(c, 7)3 Z+ T @0 H7 p8 {3 X5 n2 `; D
If t = ".SLDPRT" Or t = ".SLDASM" Then h; U! P# e3 n( j- F- D7 }! R/ _7 w
j = Len(b) - 7
! V2 k0 S; r: _; Z; E* o1 Q# N
Else
8 ^6 i# G4 l% e9 Z! t9 m d
j = Len(b), w5 l1 |9 E" A1 n4 c
End If
) }0 V8 \' L, f+ b
m = Left(b, j)
$ y$ g0 }3 s" z2 V8 Y
End If; n/ G, \4 K. K; h" w
blnretval = Part.AddCustomInfo3("", "測瘍", swCustomInfoText, e)
7 Y9 `; u& Z2 ?' a1 j! p5 Q
blnretval = Part.AddCustomInfo3("", "靡備", swCustomInfoText, m)
/ U) [* B) R1 W
blnretval = Part.AddCustomInfo3("", "第蹋", swCustomInfoText, strmat)
2 g, k$ \" @! N: R9 [6 }% Y
blnretval = Part.AddCustomInfo3("", "等笭", swCustomInfoText, " ")
5 E- [3 w% E0 e, B3 D# Q/ y* q. N
blnretval = Part.AddCustomInfo3("", "掘蛁", swCustomInfoText, " ")& f% I9 @+ K; w0 K' ^' L! e% G
% l' Y, P6 |# A3 w* r* U
End Sub# V6 s9 P5 A% l2 n- C# | {7 M9 c

复制代码

arter_2006 · 发表于 2018-11-24 15:28:59

本帖最后由 arter_2006 于 2018-11-24 15:30 编辑

ryouss 发表于 2018-11-24 13:45, F- u. ?3 t' u/ g
[Run main() 試試!]

能否把您改后的swp文件上传上来？
非常感谢您的指点，上面的内容从网页上复制、黏贴到写字板或宏文件里后，都是乱码，执行不了，非常感谢您，让您费心了。

ryouss · 发表于 2018-11-24 16:13:31

arter_2006 发表于 2018-11-24 15:28; {6 A0 A! q8 [- o4 L- i/ y$ X0 u
能否把您改后的swp文件上传上来？
) [8 z v1 I0 K$ ~非常感谢您的指点，上面的内容从网页上复制、黏贴到写字板或宏文件里 ...

远祥 · 发表于 2018-11-24 17:41:46

在原来的基础上改会方便一些。

arter_2006 · 发表于 2018-11-25 09:12:54

以下是我改过的宏，不知道哪里出了问题？附件压缩包是写字板格式的。
' ******************************************************************************
' C:\Users\admin\AppData\Local\Temp\swx8144\Macro1.swb - macro recorded on 11/22/18 by mqlu
' ******************************************************************************
Dim swApp As Object
Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long

Dim SelMgr As Object
Dim Feature As Object
Dim a As Integer
Dim b As String
Dim m As String
Dim e As String
Dim k As String
Dim t As String
Dim c As String
Dim j As Integer
Dim strmat As String
Dim tempvalue As String

Sub main() '刪除所有配置屬性
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
CurCFGname = Part.GetConfigurationNames)
CurCFGnameCount = Part.GetConfigurationCount
For i = 0 To CurCFGnameCount - 1
Set CusPropMgr = Part.Extension.CustomPropertyManager(CurCFGname(i))
Vnamearr = CusPropMgr.GetNames
If Not IsEmpty(Vnamearr) Then
      For Each Vnamearr2 In Vnamearr
         bRet = Part.DeleteCustomInfo2(CurCFGname(i), Vnamearr2)
      Next
End If
Next
Call 刪除自定義屬性
Call partitionTM

End Sub

'~~~ 刪除自定義屬性 ~~~
Sub  '刪除自定義屬性
'Dim swApp As Object
Dim swModel2 As SldWorks.ModelDoc2
Dim vCustInfoNameArr2 As Variant

Set swApp = Application.SldWorks
Set swModel2 = swApp.ActiveDoc
vCustInfoNameArr2 = swModel2.GetCustomInfoNames
  If Not IsEmpty(vCustInfoNameArr2) Then
   For Each vCustInfoName2 In vCustInfoNameArr2
      bRet = swModel2.DeleteCustomInfo(vCustInfoName2)
   Next
  End If
End Sub

'~~~ partitionTM ~~~
Sub partitionTM() 'partitionTM

'link solidworks
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
Set SelMgr = Part.SelectionManager
swApp.ActiveDoc.ActiveView.FrameState = 1
'扢隅曹講
c = swApp.ActiveDoc.GetTitle() '錨璃靡
strmat = Chr(34) + Trim("SW-Material" + "@") + c + Chr(34)
'tempvalue = Part.CustomInfo2("", "第蹋")
blnretval = Part.DeleteCustomInfo2("", "測瘍")
blnretval = Part.DeleteCustomInfo2("", "靡備")
blnretval = Part.DeleteCustomInfo2("", "第蹋")
a = InStr(c, " ") - 1
If a > 0 Then
k = Left(c, a)
t = Left(LTrim(e), 3)
If t = "GBT" Then
      e = "GB/T" + Mid(k, 4)
Else
      e = k
End If'
b = Mid(c, a + 2)
t = Right(c, 7)
If t = ".SLDPRT" Or t = ".SLDASM" Then
      j = Len(b) - 7
Else
      j = Len(b)
End If
m = Left(b, j)
End If
blnretval = Part.AddCustomInfo3("", "測瘍", swCustomInfoText, e)
blnretval = Part.AddCustomInfo3("", "靡備", swCustomInfoText, m)
blnretval = Part.AddCustomInfo3("", "第蹋", swCustomInfoText, strmat)
blnretval = Part.AddCustomInfo3("", "等笭", swCustomInfoText, " ")
blnretval = Part.AddCustomInfo3("", "掘蛁", swCustomInfoText, " ")

End Sub

ryouss · 发表于 2018-11-25 10:28:57

本帖最后由 ryouss 于 2018-11-25 10:59 编辑

arter_2006 发表于 2018-11-25 09:12
1 Z4 [9 j# f1 S% T+ h% E# X8 b以下是我改过的宏，不知道哪里出了问题？附件压缩包是写字板格式的。# Q1 ~ @, \: i* q% X2 F7 P/ |9 Z7 W
' ******************************** ...

		自动登录	找回密码
密码			注册会员

SOLIDWORKS 宏合并执行的问题

本帖子中包含更多资源

本帖子中包含更多资源

本帖子中包含更多资源

本帖子中包含更多资源

本帖子中包含更多资源