SOLIDWORKS 宏合并執行的問題

arter_2006

是這樣的，想做一個宏，通過這個宏，會先后調用其它的宏，請問如何編寫？非常感謝。 宏的名稱分別是： 刪除所有配置屬性.swp 刪除自定義屬性.swp 0 G; k5 B( C/ I& |7 [$ o4 ?! ipartitionTM.swp

" v- c: [4 d/ t* j

ryouss

參考
0 B1 g4 Q$ d& q. f3 ^. Y9 z0 ]) u

2 Z- \5 I' D; I& |Sub 刪除所有配置屬性()
   .
4 e3 p( x0 g# k8 y8 u) ~   .
& M$ `2 U, A. O0 z/ o2 T' H   .
   Call 刪除自定義屬性 '呼叫 "刪除自定義屬性" 之宏
   .
   .
  l1 E- O/ x6 E! P* l) LEnd Sub

! }. h4 _4 E6 Q0 t+ p# Y
$ f: \4 P7 R2 K- Q  D+ E0 eSub 刪除自定義屬性()
   .
$ x3 ^: H$ H6 l   .
End Sub

arter_2006

ryouss 發表于 2018-11-23 14:34
參考

非常感謝您的指點，根據我的淺薄理解，我的宏如下，但不起作用：
' ******************************************************************************
; X- }# e) R( r( W. ^7 i' C:\Users\admin\AppData\Local\Temp\swx10500\Macro1.swb - macro recorded on 11/24/18 by arter
7 Z. [8 I+ T. ]( `) H' ******************************************************************************
Dim swApp As Object
5 k+ w& Y/ m! s
Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
% M6 ~" f9 M) Z9 }# G8 n1 H& MSub 刪除所有配置屬性()
/ Y) N: P2 p7 {, V% Q! K$ X3 G
- Z1 U# c% Q7 S9 `4 N
- j4 g/ k4 A6 A! s# y2 _
    Call 刪除自定義屬性

* I6 Y9 N0 \$ i+ b( O
" }! n+ S+ q- v+ n% p. sEnd Sub

Sub 刪除自定義屬性()
* s# _5 _6 Y4 |% ?/ g
7 r% q- K  T9 Z" o4 j. ]3 Z4 Q
+ ]2 Z6 x; v$ R
4 E* u5 r6 U5 E/ b$ z! K% B+ O# R   Call partitionTM

' z- U. ?! [2 a/ E5 L  J; _
End Sub
( |$ [. k0 H# C6 `7 W9 U
Sub partitionTM()

2 p: T9 j, I4 k7 i% ~! v5 }* ?
9 S5 T0 X3 `1 A* J/ tEnd Sub
* m5 [! Y7 k8 q% }
能否幫我改下？非常感謝。

  X& @; H  x0 H" Y# ?; E

arter_2006

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

ryouss

arter_2006 發表于 2018-11-24 12:53
3 k$ ]% {$ \* {1 C4 L6 j* T不知道3個宏有沒有問題，這三個宏單獨執行的是沒問題的。上面提到的，就是想把附件壓縮包里的三個宏聯合執 ...

; y) U  T$ @. [5 {; ~  l9 ?; [% o, i
    [Run main() 試試!]
0 w# n# L8 @5 I. z
+ I( m4 k9 O8 ?  k
" y9 y/ W3 O& @

1. ' ******************************************************************************
   
2. ' C:\Users\admin\AppData\Local\Temp\swx8144\Macro1.swb - macro recorded on 11/22/18 by mqlu
   
3. ' ******************************************************************************
   
4. Dim swApp As Object
   $ O3 |( u9 u2 E" B( d" ~
5. Dim Part As Object
   - m0 ?, A+ t* T" p
6. Dim boolstatus As Boolean
   1 O9 j+ I, p- X; L2 ~$ D
7. Dim longstatus As Long, longwarnings As Long
   : ~1 g% T  P' s* \
8. 
   * ~* x- s3 X3 B. @- E: j! b  B
9. Dim SelMgr As Object
   1 P8 G1 m: x, S" i4 B
10. Dim Feature As Object
    
11. Dim a As Integer
    
12. Dim b As String
    
13. Dim m As String
    
14. Dim e As String
    1 j& f9 k: A; o3 A& A- l2 [
15. Dim k As String
    ( m8 S, N" N% c. q5 R& C1 t; j( [6 L. A
16. Dim t As String
    : F8 N1 Q! T! v( F, c/ b% S
17. Dim c As String
    ; v+ e1 y6 V: I1 X/ j2 A  w
18. Dim j As Integer
    
19. Dim strmat As String
    ( i% m7 Z! m$ m7 r5 v# S2 s4 i7 P6 t
20. Dim tempvalue As String
    & R4 d0 f. `- H) E
21. 
    
22. Sub main() '刉壺垀衄饜離扽俶(刪除所有配置屬性)
    
23. Set swApp = Application.SldWorks
    
24. Set Part = swApp.ActiveDoc
    
25. CurCFGname = Part.GetConfigurationNames
    
26. CurCFGnameCount = Part.GetConfigurationCount
    
27. For i = 0 To CurCFGnameCount - 1
    9 A! t: i( a8 b: F/ r
28.     Set CusPropMgr = Part.Extension.CustomPropertyManager(CurCFGname(i))
    
29.     Vnamearr = CusPropMgr.GetNames
    
30.     If Not IsEmpty(Vnamearr) Then
    
31.         For Each Vnamearr2 In Vnamearr
    / E( U! Y. n% f0 U$ v
32.             bRet = Part.DeleteCustomInfo2(CurCFGname(i), Vnamearr2)
    : d# p% j' K# R1 e  @
33.         Next
      X4 \0 {" n6 D$ `$ z! J
34.     End If
    
35. Next
    / i$ l* a1 U6 T) \% v4 ~
36. Call 刉壺赻隅砱扽俶 '(刪除自定義屬性)
    5 d; e* g) G+ H/ A  g6 K$ L
37. Call partitionTM
    
38. 
    ' Y5 C9 e( X, t" o' V8 }( G
39. End Sub
    % Y' O5 O3 n. i- z5 F8 p
40. 
    
41. '~~~ 刉壺赻隅砱扽俶 ~~~
    
42. Sub 刉壺赻隅砱扽俶() '(刪除自定義屬性)
    0 f8 E9 |! A- d* w; u7 c  L
43. 'Dim swApp As Object
    % o3 n0 k4 e4 @! |' M. ]! `9 F
44. Dim swModel2 As SldWorks.ModelDoc2
    " N! z/ y* F+ {& r8 e" R/ A( j
45. Dim vCustInfoNameArr2 As Variant
    
46. 
      o' q1 @3 U' L% ~- V7 k
47. Set swApp = Application.SldWorks
    
48. Set swModel2 = swApp.ActiveDoc
    0 ]0 B" T7 W: H, p
49. vCustInfoNameArr2 = swModel2.GetCustomInfoNames
    % }6 Z% O  L; Q) L9 N3 m, q
50.   If Not IsEmpty(vCustInfoNameArr2) Then
    3 `7 z/ r( m3 ]
51.      For Each vCustInfoName2 In vCustInfoNameArr2
    
52.          bRet = swModel2.DeleteCustomInfo(vCustInfoName2)
    ! k- i! E4 `' z, w! U+ a
53.       Next
    
54.   End If
    
55. End Sub
    
56. 
    
57. '~~~ partitionTM ~~~
    
58. Sub partitionTM() 'partitionTM
    
59. 
    
60. 'link solidworks
    ' e3 O* f  V6 p- F' n
61. Set swApp = Application.SldWorks
    4 Y9 n" N: T) f( D: A& c  E' j1 o
62. Set Part = swApp.ActiveDoc
    
63. Set SelMgr = Part.SelectionManager
    
64. swApp.ActiveDoc.ActiveView.FrameState = 1
    ' \9 e) d: k# k  Z( _! R
65. '扢隅曹講
    
66. c = swApp.ActiveDoc.GetTitle() '錨璃靡
    
67. strmat = Chr(34) + Trim("SW-Material" + "@") + c + Chr(34)
    
68. 'tempvalue = Part.CustomInfo2("", "第蹋")
    
69. blnretval = Part.DeleteCustomInfo2("", "測瘍")
    
70. blnretval = Part.DeleteCustomInfo2("", "靡備")
    * c. {5 L; ]6 s! o' C. s
71. blnretval = Part.DeleteCustomInfo2("", "第蹋")
    
72. a = InStr(c, " ") - 1
    8 g0 Q- I9 q' ?7 [& M5 W
73. If a > 0 Then
    
74.     k = Left(c, a)
    
75.     t = Left(LTrim(e), 3)
    ' U5 O/ `- f! J4 l# {
76.     If t = "GBT" Then
    
77.         e = "GB/T" + Mid(k, 4)
    ) O9 W3 L0 k$ R- d2 p) ]
78.     Else
    
79.         e = k
    
80.     End If
    & u" X; x+ h6 W6 @& ?) o
81.     b = Mid(c, a + 2)
    ! U" x5 o# u2 d9 z- O1 @- k
82.     t = Right(c, 7)
    
83.     If t = ".SLDPRT" Or t = ".SLDASM" Then
    
84.         j = Len(b) - 7
    * M* j; ?! i* U: D6 s" _8 Q
85.     Else
    + y7 a4 \( ~' J
86.         j = Len(b)
    
87.     End If
    
88.     m = Left(b, j)
    
89. End If
    
90. blnretval = Part.AddCustomInfo3("", "測瘍", swCustomInfoText, e)
    
91. blnretval = Part.AddCustomInfo3("", "靡備", swCustomInfoText, m)
    
92. blnretval = Part.AddCustomInfo3("", "第蹋", swCustomInfoText, strmat)
    ; D; p: ~% {# C6 r9 v
93. blnretval = Part.AddCustomInfo3("", "等笭", swCustomInfoText, " ")
    ! a, C( Z7 S" X# a( b( N. J
94. blnretval = Part.AddCustomInfo3("", "掘蛁", swCustomInfoText, " ")
    6 Z& n/ W; K1 v3 a; M
95. 
    2 v7 Q! V# i  W
96. End Sub
    

復制代碼

, `* l) l; o# j7 |. Q

arter_2006

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

0 z9 @# z5 g/ `  n" y能否把您改后的swp文件上傳上來？
  k, w8 Z' l1 f' e4 z$ [+ o: U1 k非常感謝您的指點，上面的內容從網頁上復制、黏貼到寫字板或宏文件里后，都是亂碼，執行不了，非常感謝您，讓您費心了。
( R. h) J4 F. `4 L3 e& [+ ]2 V, ], d
/ |' F  N7 g" o  v" @# x2 U

ryouss

arter_2006 發表于 2018-11-24 15:28
/ T! j: l9 a5 n9 r8 ~- D5 e能否把您改后的swp文件上傳上來？
非常感謝您的指點，上面的內容從網頁上復制、黏貼到寫字板或宏文件里 ...

遠祥

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

arter_2006

以下是我改過的宏，不知道哪里出了問題？附件壓縮包是寫字板格式的。
; f( B4 D/ y" e5 Y: H9 R' ******************************************************************************
  k4 @2 Z+ j( E  _' C:\Users\admin\AppData\Local\Temp\swx8144\Macro1.swb - macro recorded on 11/22/18 by mqlu
' ******************************************************************************
5 k  G/ n! P  d( ~# g9 \Dim swApp As Object
Dim Part As Object
- ^* Q! ]$ E3 _Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long

; Q% w4 W1 _: Q- a4 EDim SelMgr As Object
# l+ m% r2 _7 O% W. A! aDim Feature As Object
Dim a As Integer
Dim b As String
Dim m As String
Dim e As String
2 `# D: g# D" D! IDim k As String
Dim t As String
( ~6 L( f) @8 g3 J/ h4 o6 ]Dim c As String
3 @1 t' c7 P+ \4 o3 _4 SDim j As Integer
# L% M3 f8 V7 |. ]7 J; m. LDim strmat As String
7 \# I4 f! |) T7 c; ^4 S9 e  C; BDim tempvalue As String
2 v/ C; I6 h  k
Sub main() '刪除所有配置屬性
2 M( ^9 ^% y3 Q: z8 Y0 GSet swApp = Application.SldWorks
1 `( R/ {% a" z1 \* kSet Part = swApp.ActiveDoc
3 V: l# U5 Q" ~( wCurCFGname = Part.GetConfigurationNames)
0 z2 K1 [/ Z( P3 B$ QCurCFGnameCount = Part.GetConfigurationCount
For i = 0 To CurCFGnameCount - 1
    Set CusPropMgr = Part.Extension.CustomPropertyManager(CurCFGname(i))
1 @. t; c4 ]$ E  x2 X: F    Vnamearr = CusPropMgr.GetNames
    If Not IsEmpty(Vnamearr) Then
        For Each Vnamearr2 In Vnamearr
( Y1 l. L0 W9 W* P/ B            bRet = Part.DeleteCustomInfo2(CurCFGname(i), Vnamearr2)
$ e7 Q7 |6 g: s7 P. d+ D9 M$ e6 F        Next
    End If
Next
Call 刪除自定義屬性
Call partitionTM
! t/ j( J9 k7 f' i% d  U6 E  ^. }
& @# ?  t1 K- S" N) V# vEnd Sub

4 I! F0 @. k* G0 }) ~; d2 t( i'~~~ 刪除自定義屬性 ~~~
Sub  '刪除自定義屬性
'Dim swApp As Object
: Q7 J7 l. f/ k  {! V/ q; d8 ADim swModel2 As SldWorks.ModelDoc2
Dim vCustInfoNameArr2 As Variant

Set swApp = Application.SldWorks
Set swModel2 = swApp.ActiveDoc
, G9 C0 e' d# d) V8 ~) MvCustInfoNameArr2 = swModel2.GetCustomInfoNames
  If Not IsEmpty(vCustInfoNameArr2) Then
/ l- T5 T) s7 p. T  g3 }     For Each vCustInfoName2 In vCustInfoNameArr2
* e. o1 z* I" L6 A2 l9 P         bRet = swModel2.DeleteCustomInfo(vCustInfoName2)
  Q, x" C2 t- T  ?* e" x      Next
  End If
End Sub

'~~~ partitionTM ~~~
Sub partitionTM() 'partitionTM
# E2 r- i2 T' e! a# _; {# H7 U
& x" \4 o- q; ~/ S$ G: i, n7 M'link solidworks
Set swApp = Application.SldWorks
( A8 a8 r- `8 D; b( R6 LSet Part = swApp.ActiveDoc
. @* [  @1 j" l0 {1 y. VSet SelMgr = Part.SelectionManager
* ?" M' }  d: R1 cswApp.ActiveDoc.ActiveView.FrameState = 1
'扢隅曹講
2 O# l4 ]  q( wc = swApp.ActiveDoc.GetTitle() '錨璃靡
strmat = Chr(34) + Trim("SW-Material" + "@") + c + Chr(34)
6 x% A9 R8 A, b3 q) {' J% ^'tempvalue = Part.CustomInfo2("", "第蹋")
blnretval = Part.DeleteCustomInfo2("", "測瘍")
# G! E& ~: i8 g) P5 x9 b4 vblnretval = Part.DeleteCustomInfo2("", "靡備")
blnretval = Part.DeleteCustomInfo2("", "第蹋")
a = InStr(c, " ") - 1
If a > 0 Then
0 \( R( g, v: q1 n5 ^# y4 b    k = Left(c, a)
5 S7 q3 `9 ^/ B; Y% l    t = Left(LTrim(e), 3)
8 o8 Z/ a+ ]9 b) Z1 @# J9 E    If t = "GBT" Then
        e = "GB/T" + Mid(k, 4)
) R2 F2 N/ ~+ V8 O% @9 ?    Else
4 E: \, r5 }+ N) x- r        e = k
    End If'
& D) i8 _0 k: d1 W4 f/ R" K* l( b    b = Mid(c, a + 2)
% C. O- D2 I% k' |& N& X1 O    t = Right(c, 7)
9 a  ]! x, L+ [  ^# G    If t = ".SLDPRT" Or t = ".SLDASM" Then
        j = Len(b) - 7
    Else
        j = Len(b)
1 q2 f" C6 b2 V4 a1 K/ E/ @    End If
    m = Left(b, j)
End If
blnretval = Part.AddCustomInfo3("", "測瘍", swCustomInfoText, e)
blnretval = Part.AddCustomInfo3("", "靡備", swCustomInfoText, m)
blnretval = Part.AddCustomInfo3("", "第蹋", swCustomInfoText, strmat)
$ N# A7 H6 A3 L- n7 M! o# w; J9 t$ Dblnretval = Part.AddCustomInfo3("", "等笭", swCustomInfoText, " ")
blnretval = Part.AddCustomInfo3("", "掘蛁", swCustomInfoText, " ")
! O3 a; _7 j  q
7 [6 q! r4 j( Y# C, uEnd Sub

ryouss

1 j; J5 B. V( s' g: ~, U  R% w) W

arter_2006 發表于 2018-11-25 09:12
9 A0 R) Z+ s6 Y( b. u以下是我改過的宏，不知道哪里出了問題？附件壓縮包是寫字板格式的。
' ******************************** ...

0 A; E9 L2 M5 B
" ~/ h# ^  w( J6 t+ p