SOLIDWORKS 宏合并執(zhí)行的問題

arter_2006

是這樣的，想做一個宏，通過這個宏，會先后調用其它的宏，請問如何編寫？非常感謝。 宏的名稱分別是： 0 f+ N; g5 M0 Z' K) S2 K9 t3 V刪除所有配置屬性.swp 刪除自定義屬性.swp partitionTM.swp

ryouss

參考
0 {! ]. s) {% L3 x, H2 ]0 C
0 f$ B& ~1 H3 R& L5 H4 ]
Sub 刪除所有配置屬性()
   .
   .
   .
* G  u  y# D& T& G# t" Y/ o7 H   Call 刪除自定義屬性 '呼叫 "刪除自定義屬性" 之宏
   .
   .
& k6 A9 P' T4 Y5 i# E* iEnd Sub

9 N; G! o! t3 d$ D
Sub 刪除自定義屬性()
: N8 q% k- c% E( O: O   .
   .
; }2 b+ e% s) R5 m7 m2 j( `: `3 KEnd Sub

arter_2006

ryouss 發(fā)表于 2018-11-23 14:34
% E9 L; A" h! N( g參考

) L9 l. x; i% b% w6 g  s3 L非常感謝您的指點，根據我的淺薄理解，我的宏如下，但不起作用：
# y- z' n0 Q; ?! Y- N% L/ E( o, M' ******************************************************************************
' C:\Users\admin\AppData\Local\Temp\swx10500\Macro1.swb - macro recorded on 11/24/18 by arter
' ******************************************************************************
/ i: g( J% z4 u! DDim swApp As Object

) f5 Z/ {+ T0 N+ v: nDim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Sub 刪除所有配置屬性()
) X' V. K4 z5 f9 ~% g# |
) u, y6 ~( D6 J3 Y! M) Q

+ |- F, Z. v1 I7 s& h1 I6 W    Call 刪除自定義屬性

& h+ L/ L6 p1 a+ |! a9 B+ F
End Sub
/ j, `2 U2 y; b/ F' J
! k) m& H  j/ h) ASub 刪除自定義屬性()

$ k( D( u4 d# P( i7 ^* Z) D
  x9 k$ G. f4 L/ {
   Call partitionTM
' ]& ]; N8 u, j! F" t/ P  j

# n' N+ ^  g( A  u  i& a( E! REnd Sub

Sub partitionTM()
0 U% @/ ]" K  o' J2 F% W

) V+ l+ I  [3 k% _7 D) @End Sub

能否幫我改下？非常感謝。
  F6 G) O* p4 P1 Y1 P' M8 |
. l' H1 `  ~9 y( L

arter_2006

不知道3個宏有沒有問題，這三個宏單獨執(zhí)行的是沒問題的。上面提到的，就是想把附件壓縮包里的三個宏聯合執(zhí)行。

ryouss

arter_2006 發(fā)表于 2018-11-24 12:53
不知道3個宏有沒有問題，這三個宏單獨執(zhí)行的是沒問題的。上面提到的，就是想把附件壓縮包里的三個宏聯合執(zhí) ...

+ L/ y) O2 r+ z5 V# f. P
    [Run main() 試試!]
6 u" V* k% ^. m' r: V/ ~# }
6 W1 H) f8 U  K' F# D

1. ' ******************************************************************************
   
2. ' C:\Users\admin\AppData\Local\Temp\swx8144\Macro1.swb - macro recorded on 11/22/18 by mqlu
   
3. ' ******************************************************************************
   * r, N# R  T) }9 I( Z* Y. K$ ~
4. Dim swApp As Object
   
5. Dim Part As Object
   
6. Dim boolstatus As Boolean
   
7. Dim longstatus As Long, longwarnings As Long
   ; e8 R! s- ~/ c/ F; z' }- |4 c
8. 
   
9. Dim SelMgr As Object
   0 O# v- E( n& Z* H- |% S
10. Dim Feature As Object
    
11. Dim a As Integer
    9 k( l+ X  `/ a3 K) v
12. Dim b As String
    
13. Dim m As String
    ! i4 }/ Q3 z2 A' P
14. Dim e As String
    7 _* W" c3 ?" G
15. Dim k As String
    
16. Dim t As String
    ' Y, z7 w1 Y! v: [! t4 z
17. Dim c As String
    - j* C/ k4 q' f
18. Dim j As Integer
    $ Z5 R1 @+ }+ b3 W% c/ i! k- S
19. Dim strmat As String
    
20. Dim tempvalue As String
      s6 g! _4 o7 L  ]8 n* {) N( i
21. 
    
22. Sub main() '刉壺垀衄饜離扽俶(刪除所有配置屬性)
    9 k9 f& E# ~& {, d! O* `
23. Set swApp = Application.SldWorks
    
24. Set Part = swApp.ActiveDoc
    % d1 r8 H  s) W; K9 `( @+ u
25. CurCFGname = Part.GetConfigurationNames
    ' v2 j* A" a& z7 ~
26. CurCFGnameCount = Part.GetConfigurationCount
    0 A1 b6 Z& B# L4 y
27. For i = 0 To CurCFGnameCount - 1
    
28.     Set CusPropMgr = Part.Extension.CustomPropertyManager(CurCFGname(i))
    2 B) `+ A- }$ r% X) q
29.     Vnamearr = CusPropMgr.GetNames
    / H2 s( s( _# n
30.     If Not IsEmpty(Vnamearr) Then
    7 {( W, q6 U+ _/ t1 D5 c4 t/ t- O
31.         For Each Vnamearr2 In Vnamearr
      r! ]9 d, V( k) A
32.             bRet = Part.DeleteCustomInfo2(CurCFGname(i), Vnamearr2)
    2 p) e( I1 i- v# Q& L
33.         Next
    ) K, U. e6 S* h! X! ~+ ^
34.     End If
    
35. Next
    5 d! Y- x* p# T) c+ _, A3 s
36. Call 刉壺赻隅砱扽俶 '(刪除自定義屬性)
    
37. Call partitionTM
    - U. R9 }, d9 i& p. ^& E
38. 
    , p% C! r' V+ u" x$ ]
39. End Sub
    5 X6 n: S) B6 {2 Q: M( Z2 o
40. 
    
41. '~~~ 刉壺赻隅砱扽俶 ~~~
    & P9 Y" O( y5 l
42. Sub 刉壺赻隅砱扽俶() '(刪除自定義屬性)
    
43. 'Dim swApp As Object
    + O; x' A! V! W2 `0 d6 R$ K
44. Dim swModel2 As SldWorks.ModelDoc2
    / Y2 h$ t4 c5 v6 k7 F+ L' G
45. Dim vCustInfoNameArr2 As Variant
    
46. 
    0 a* |4 J+ R4 g, W8 M4 P
47. Set swApp = Application.SldWorks
    
48. Set swModel2 = swApp.ActiveDoc
    ; ^# L# W9 J" ?5 @, r
49. vCustInfoNameArr2 = swModel2.GetCustomInfoNames
    * w+ C  i5 q0 A2 y$ x; o; \- N
50.   If Not IsEmpty(vCustInfoNameArr2) Then
    : \2 V! p! I/ Y; o# H
51.      For Each vCustInfoName2 In vCustInfoNameArr2
    / z+ p& ]8 q$ j# C, D
52.          bRet = swModel2.DeleteCustomInfo(vCustInfoName2)
    " V3 V9 O8 l% i
53.       Next
    
54.   End If
    
55. End Sub
    , M. `  p) Z7 t. \$ W" q
56. 
    
57. '~~~ partitionTM ~~~
    
58. Sub partitionTM() 'partitionTM
    ( s$ q# H& X& h" T
59. 
    , R. w0 c2 I* y/ |+ _' t* f
60. 'link solidworks
    
61. Set swApp = Application.SldWorks
    $ H* |' ~. K3 N+ ?# m) w
62. Set Part = swApp.ActiveDoc
    
63. Set SelMgr = Part.SelectionManager
    4 E. P% r6 A; `: D! k% {5 T
64. swApp.ActiveDoc.ActiveView.FrameState = 1
    1 J1 E- c. i4 ]+ a% l) H+ Z+ s9 i
65. '扢隅曹講
    ! O3 T- \0 ]* _3 N% o: w5 L( F
66. c = swApp.ActiveDoc.GetTitle() '錨璃靡
    
67. strmat = Chr(34) + Trim("SW-Material" + "@") + c + Chr(34)
    
68. 'tempvalue = Part.CustomInfo2("", "第蹋")
    / J) y- ^/ @+ \+ j9 z- z
69. blnretval = Part.DeleteCustomInfo2("", "測瘍")
    0 Z+ r# I$ P! I6 v
70. blnretval = Part.DeleteCustomInfo2("", "靡備")
    
71. blnretval = Part.DeleteCustomInfo2("", "第蹋")
    7 ]& D9 g0 E( D
72. a = InStr(c, " ") - 1
    
73. If a > 0 Then
    
74.     k = Left(c, a)
    
75.     t = Left(LTrim(e), 3)
      M8 m# K1 E, m0 x2 V
76.     If t = "GBT" Then
    / X8 i/ ]- E! h- i+ n
77.         e = "GB/T" + Mid(k, 4)
    ; @1 J, u1 y$ Z$ O) S: o
78.     Else
    
79.         e = k
    
80.     End If
      w+ T2 u3 \: H5 a5 v
81.     b = Mid(c, a + 2)
    
82.     t = Right(c, 7)
    
83.     If t = ".SLDPRT" Or t = ".SLDASM" Then
    
84.         j = Len(b) - 7
    
85.     Else
    
86.         j = Len(b)
    
87.     End If
    
88.     m = Left(b, j)
    2 C9 e  v2 \9 j! |2 H6 b0 {7 @
89. End If
    
90. blnretval = Part.AddCustomInfo3("", "測瘍", swCustomInfoText, e)
    6 O2 D+ Y, J) M8 e
91. blnretval = Part.AddCustomInfo3("", "靡備", swCustomInfoText, m)
    % i. c8 {$ e+ E
92. blnretval = Part.AddCustomInfo3("", "第蹋", swCustomInfoText, strmat)
    
93. blnretval = Part.AddCustomInfo3("", "等笭", swCustomInfoText, " ")
    , D1 ]" L2 u/ }6 h3 Z
94. blnretval = Part.AddCustomInfo3("", "掘蛁", swCustomInfoText, " ")
    
95. 
    4 L- }) W! `& i( X" c
96. End Sub
    

復制代碼

arter_2006

ryouss 發(fā)表于 2018-11-24 13:45
[Run main() 試試!]

; z. U0 r1 e! k/ Z3 w能否把您改后的swp文件上傳上來？
! F$ H! b& X, m7 o. {9 y2 F7 Y& K! F非常感謝您的指點，上面的內容從網頁上復制、黏貼到寫字板或宏文件里后，都是亂碼，執(zhí)行不了，非常感謝您，讓您費心了。

ryouss

arter_2006 發(fā)表于 2018-11-24 15:28
( t& K+ `) U* i能否把您改后的swp文件上傳上來？
5 ?3 `9 x0 R5 \3 G( \+ [9 h- W7 M非常感謝您的指點，上面的內容從網頁上復制、黏貼到寫字板或宏文件里 ...

/ L$ K% [9 ]- ?& E  p4 e# c

遠祥

在原來的基礎上改會方便一些。

arter_2006

以下是我改過的宏，不知道哪里出了問題？附件壓縮包是寫字板格式的。
' ******************************************************************************
' 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
: Z6 ^7 d7 U7 mDim boolstatus As Boolean
2 i+ n! E+ J2 R9 S) eDim longstatus As Long, longwarnings As Long
9 X. a# W- O) H( y
Dim SelMgr As Object
' I' b0 b5 z; @$ f  e& XDim Feature As Object
Dim a As Integer
% P' h1 O' u0 S* u+ DDim b As String
3 f! N$ K$ Y# o; O" M6 WDim m As String
9 C4 A1 Y5 {" j6 }2 cDim e As String
Dim k As String
Dim t As String
Dim c As String
7 U, B( O' s1 Y  {& Y! O2 XDim j As Integer
" A  O# [$ c  D) h9 jDim strmat As String
Dim tempvalue As String
; k; v/ \) B2 T7 M
Sub main() '刪除所有配置屬性
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
CurCFGname = Part.GetConfigurationNames)
7 G. Z8 n9 _' x' t! q- F3 v$ mCurCFGnameCount = Part.GetConfigurationCount
For i = 0 To CurCFGnameCount - 1
0 O2 ~, |( S/ t    Set CusPropMgr = Part.Extension.CustomPropertyManager(CurCFGname(i))
    Vnamearr = CusPropMgr.GetNames
    If Not IsEmpty(Vnamearr) Then
1 P! A: [% Q5 T! G" z        For Each Vnamearr2 In Vnamearr
6 f4 B/ R5 }, }$ c$ E3 {' j            bRet = Part.DeleteCustomInfo2(CurCFGname(i), Vnamearr2)
8 s1 ]) N" g1 d. F( A& t8 N6 h        Next
    End If
Next
' S% N* ^% e  vCall 刪除自定義屬性
. ^- [1 N1 W- e! H( n' @; MCall partitionTM
( U* G6 b# ?! O& |2 b
End Sub
5 \+ B; ?! Q1 B9 n  Q- z& j' S
9 C3 F% {& S' |$ L. k8 }9 Q2 X'~~~ 刪除自定義屬性 ~~~
Sub  '刪除自定義屬性
+ k* E: N/ v# V* W) ], f& D2 e'Dim swApp As Object
/ E7 s6 A, ?$ C2 R3 Z7 _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
% U* @" k, Y. H* E     For Each vCustInfoName2 In vCustInfoNameArr2
         bRet = swModel2.DeleteCustomInfo(vCustInfoName2)
; ]$ x) E& R2 C2 D4 d      Next
  End If
) I0 ~8 \8 O5 b8 P5 w- y8 gEnd Sub

7 K. x/ M  E$ o% _4 w/ \'~~~ partitionTM ~~~
Sub partitionTM() 'partitionTM

'link solidworks
- \  T# c5 @7 C/ `* u, dSet swApp = Application.SldWorks
  M9 F0 L% d! U  t; WSet Part = swApp.ActiveDoc
Set SelMgr = Part.SelectionManager
swApp.ActiveDoc.ActiveView.FrameState = 1
'扢隅曹講
7 M4 q) h7 O6 mc = swApp.ActiveDoc.GetTitle() '錨璃靡
strmat = Chr(34) + Trim("SW-Material" + "@") + c + Chr(34)
'tempvalue = Part.CustomInfo2("", "第蹋")
  H; ^* D2 c# o0 P+ P0 zblnretval = Part.DeleteCustomInfo2("", "測瘍")
. R# o( r5 i% ]- A3 j) f( Xblnretval = Part.DeleteCustomInfo2("", "靡備")
blnretval = Part.DeleteCustomInfo2("", "第蹋")
& {. g/ F% B. ]. U, ja = InStr(c, " ") - 1
7 s4 }; e) v! }If a > 0 Then
    k = Left(c, a)
# q4 E( z4 J% V. s    t = Left(LTrim(e), 3)
- b, D; p: b0 R' z* G# w/ L; p    If t = "GBT" Then
        e = "GB/T" + Mid(k, 4)
3 w( D9 K! g8 p5 m! V, s    Else
2 X& v; `7 E) `2 f$ _/ m        e = k
5 J* t) u1 \# G8 |, |+ d    End If'
    b = Mid(c, a + 2)
    t = Right(c, 7)
0 ^1 P" Z( M& u    If t = ".SLDPRT" Or t = ".SLDASM" Then
        j = Len(b) - 7
    Else
3 d# d9 [% C, _9 R        j = Len(b)
    End If
    m = Left(b, j)
End If
2 S$ V' c$ |0 H9 E% pblnretval = Part.AddCustomInfo3("", "測瘍", swCustomInfoText, e)
' h6 s  I0 a: }) Dblnretval = Part.AddCustomInfo3("", "靡備", swCustomInfoText, m)
) ~  P! g* n3 q2 e  Hblnretval = Part.AddCustomInfo3("", "第蹋", swCustomInfoText, strmat)
9 u8 C/ h& M  c, ublnretval = Part.AddCustomInfo3("", "等笭", swCustomInfoText, " ")
' L) K* m% ^! @% i" `+ m) cblnretval = Part.AddCustomInfo3("", "掘蛁", swCustomInfoText, " ")
+ M2 z( ~$ U8 n
7 I- w- K7 g  i( yEnd Sub

ryouss

1 \' @6 A5 Z, q" M& M6 [% ?1 Q

arter_2006 發(fā)表于 2018-11-25 09:12
' S3 l( g! U: a. M+ j以下是我改過的宏，不知道哪里出了問題？附件壓縮包是寫字板格式的。
' ******************************** ...

2 i) Y/ O6 ^" m5 ~' t& a, [
/ C4 m0 V& y" J' D
- z& D! u; h) [! P- A! G# V