SOLIDWORKS 宏合并執行的問題

arter_2006

是這樣的，想做一個宏，通過這個宏，會先后調用其它的宏，請問如何編寫？非常感謝。 , M! @2 F' k/ Y. n宏的名稱分別是： ! @1 W- B2 `7 {/ h! z刪除所有配置屬性.swp 9 w' m. Q8 u( ~2 H' i刪除自定義屬性.swp ' g( ?+ _: V1 @& b$ q1 |) ?1 ~# DpartitionTM.swp % P. x" t2 T  ?1 X3 I6 n% P8 p

/ z$ M5 z9 c$ k# a9 {* I  z

ryouss

參考

- U+ e' i! o" R4 D
/ P. S: U! {: @) U" DSub 刪除所有配置屬性()
   .
4 S+ q7 E3 l, a5 q  D   .
   .
   Call 刪除自定義屬性 '呼叫 "刪除自定義屬性" 之宏
   .
   .
& F, n' P- o. F$ O3 J; ^7 E8 h6 e8 Y$ L8 ^End Sub


Sub 刪除自定義屬性()
8 q- P4 _+ I) L" g# k" P+ l   .
   .
0 T5 j" c. p( D- B$ LEnd Sub

arter_2006

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

非常感謝您的指點，根據我的淺薄理解，我的宏如下，但不起作用：
' ******************************************************************************
% F8 `. H7 C; |# D/ E# B' C:\Users\admin\AppData\Local\Temp\swx10500\Macro1.swb - macro recorded on 11/24/18 by arter
' ******************************************************************************
Dim swApp As Object

% I( N% f( E$ H* J9 }3 F" wDim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Sub 刪除所有配置屬性()

3 E& ~+ v5 j, a( U( \" C9 W% |' N1 R7 q
$ a; i8 p+ u1 f6 d# u
    Call 刪除自定義屬性
& R4 ~4 ~7 u+ f

End Sub
" P$ ~/ o0 z5 v7 e3 K
; p7 ?2 |' z. H7 T2 E3 i3 pSub 刪除自定義屬性()
; D) C9 v: _, Q7 R* d


   Call partitionTM
: ?) Q4 c6 C% `: X3 f/ p; e

End Sub
# G4 `1 b- L7 X
& k, m+ M$ C* b7 J0 fSub partitionTM()


End Sub
# M/ \, Y& |* T) u/ Q
6 G6 D3 e- x) f0 x) p$ s$ n能否幫我改下？非常感謝。
5 x) M( S% {& L/ l, }- d1 p7 b
7 P! d, {% C. S+ {. L" e; T

arter_2006

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

ryouss

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

3 b1 f4 B8 q- D& ~/ f
3 {" P2 p- i) T- r- \( ]) ]    [Run main() 試試!]

7 K, X' ^( ]6 W3 ~: \) h
) p0 D* }2 i3 d# O

1. ' ******************************************************************************
   ) c, W" G6 v. E: K) P% v4 n  u" g- D4 t
2. ' C:\Users\admin\AppData\Local\Temp\swx8144\Macro1.swb - macro recorded on 11/22/18 by mqlu
   
3. ' ******************************************************************************
   ' N0 P) w8 J- F0 @- l7 w( n! a& P
4. Dim swApp As Object
   9 K/ Q9 c) b/ Y) x6 t. W
5. Dim Part As Object
   9 B4 b0 W" F& h2 q/ |, z# l( t, O
6. Dim boolstatus As Boolean
   
7. Dim longstatus As Long, longwarnings As Long
   
8. 
   
9. Dim SelMgr As Object
   
10. Dim Feature As Object
    
11. Dim a As Integer
    
12. Dim b As String
    
13. Dim m As String
    # m1 Y0 C( A5 m4 R% `7 U
14. Dim e As String
    
15. Dim k As String
    * J9 e' U( }( r0 k$ U2 r. N8 e6 h
16. Dim t As String
    
17. Dim c As String
    ' Z' Z+ o, P. M  r9 Q$ ?3 W4 q* a) w
18. Dim j As Integer
    
19. Dim strmat As String
    
20. Dim tempvalue As String
    
21. 
    $ \0 E' f# N" ~" V( W5 Z
22. Sub main() '刉壺垀衄饜離扽俶(刪除所有配置屬性)
    5 i( d7 A8 o, ?. H$ }7 {3 h; m5 n- d
23. Set swApp = Application.SldWorks
      W5 e- z0 z7 ?) P
24. Set Part = swApp.ActiveDoc
      J/ Q+ i8 b" X5 J
25. CurCFGname = Part.GetConfigurationNames
    
26. CurCFGnameCount = Part.GetConfigurationCount
    ! e, h% s( K8 J# N
27. For i = 0 To CurCFGnameCount - 1
    , @* P5 S5 Y$ G2 a# Z- ~
28.     Set CusPropMgr = Part.Extension.CustomPropertyManager(CurCFGname(i))
    
29.     Vnamearr = CusPropMgr.GetNames
    
30.     If Not IsEmpty(Vnamearr) Then
    
31.         For Each Vnamearr2 In Vnamearr
    % W4 G' k4 }5 Z/ f
32.             bRet = Part.DeleteCustomInfo2(CurCFGname(i), Vnamearr2)
    9 T: M( h& U& V) @
33.         Next
    $ e& e! H0 n9 F1 J) \! e
34.     End If
    
35. Next
    
36. Call 刉壺赻隅砱扽俶 '(刪除自定義屬性)
    9 d) X9 @/ L1 T
37. Call partitionTM
    
38. 
    ; v: E- d$ A& I) s% ~2 |+ z$ b
39. End Sub
    
40. 
    
41. '~~~ 刉壺赻隅砱扽俶 ~~~
    & C7 I% E) r; L- [( K! Q  w0 f4 J
42. Sub 刉壺赻隅砱扽俶() '(刪除自定義屬性)
    
43. 'Dim swApp As Object
    8 x2 ?. ^& i  r- e" c
44. Dim swModel2 As SldWorks.ModelDoc2
    
45. Dim vCustInfoNameArr2 As Variant
    
46. 
    + A8 Z% m, `$ G3 e4 j
47. Set swApp = Application.SldWorks
    
48. Set swModel2 = swApp.ActiveDoc
    
49. vCustInfoNameArr2 = swModel2.GetCustomInfoNames
    
50.   If Not IsEmpty(vCustInfoNameArr2) Then
    ) k6 K, p5 ?( v9 e
51.      For Each vCustInfoName2 In vCustInfoNameArr2
    
52.          bRet = swModel2.DeleteCustomInfo(vCustInfoName2)
    
53.       Next
    
54.   End If
    
55. End Sub
    
56. 
    
57. '~~~ partitionTM ~~~
    5 h7 _5 V# q) e5 c' d$ L$ `9 j
58. Sub partitionTM() 'partitionTM
    
59. 
    
60. 'link solidworks
    0 X, a1 b" f" R, ~
61. Set swApp = Application.SldWorks
    
62. Set Part = swApp.ActiveDoc
    
63. Set SelMgr = Part.SelectionManager
    & ]3 `0 g7 e2 Y# o+ m
64. swApp.ActiveDoc.ActiveView.FrameState = 1
    ' z1 v2 t4 |, E4 q% A
65. '扢隅曹講
    
66. c = swApp.ActiveDoc.GetTitle() '錨璃靡
    / i3 x' E6 J. o  ^1 s
67. strmat = Chr(34) + Trim("SW-Material" + "@") + c + Chr(34)
    , x3 g: j; R  ~5 _5 C
68. 'tempvalue = Part.CustomInfo2("", "第蹋")
    
69. blnretval = Part.DeleteCustomInfo2("", "測瘍")
    
70. blnretval = Part.DeleteCustomInfo2("", "靡備")
    
71. blnretval = Part.DeleteCustomInfo2("", "第蹋")
    9 R/ a/ w8 ?) v. r- T
72. a = InStr(c, " ") - 1
    
73. If a > 0 Then
    
74.     k = Left(c, a)
    - l2 i; Y7 w& I( o: u' g  ^9 f
75.     t = Left(LTrim(e), 3)
    
76.     If t = "GBT" Then
    ' t6 }7 ]7 P- g, |% m
77.         e = "GB/T" + Mid(k, 4)
    ; F# |4 |; ?' B6 B( B" n
78.     Else
    
79.         e = k
    
80.     End If
    
81.     b = Mid(c, a + 2)
    ( q. T! @: i5 t' `. {5 t
82.     t = Right(c, 7)
    
83.     If t = ".SLDPRT" Or t = ".SLDASM" Then
    
84.         j = Len(b) - 7
    
85.     Else
    7 w; J! @0 a( b8 U
86.         j = Len(b)
    # s; e( `3 H( O/ }5 n
87.     End If
    ; N+ g+ L4 F+ A3 @/ |
88.     m = Left(b, j)
    
89. End If
    1 I4 N8 O0 Q- a' G8 q0 S  e
90. blnretval = Part.AddCustomInfo3("", "測瘍", swCustomInfoText, e)
    0 Z. L3 K$ ?4 }7 j) f
91. blnretval = Part.AddCustomInfo3("", "靡備", swCustomInfoText, m)
    
92. blnretval = Part.AddCustomInfo3("", "第蹋", swCustomInfoText, strmat)
    
93. blnretval = Part.AddCustomInfo3("", "等笭", swCustomInfoText, " ")
    
94. blnretval = Part.AddCustomInfo3("", "掘蛁", swCustomInfoText, " ")
    
95. 
    + a+ X  _/ D5 n0 B
96. End Sub
    6 c/ u7 j4 F! e: F1 C

復制代碼

3 O' ~' p/ S5 W. d2 V3 }
! g5 n0 P5 m: l& y, v* `( T" S

arter_2006

& d4 e+ q) z6 `7 y/ r

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

能否把您改后的swp文件上傳上來？
0 _* @2 {; g# _* I非常感謝您的指點，上面的內容從網頁上復制、黏貼到寫字板或宏文件里后，都是亂碼，執行不了，非常感謝您，讓您費心了。

% Q  u% T6 S: G$ f9 w

ryouss

arter_2006 發表于 2018-11-24 15:28
7 }$ k" _, j% p* T/ q能否把您改后的swp文件上傳上來？
非常感謝您的指點，上面的內容從網頁上復制、黏貼到寫字板或宏文件里 ...

% d$ y# k! H, t8 t3 z

遠祥

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

arter_2006

以下是我改過的宏，不知道哪里出了問題？附件壓縮包是寫字板格式的。
' ******************************************************************************
' C:\Users\admin\AppData\Local\Temp\swx8144\Macro1.swb - macro recorded on 11/22/18 by mqlu
' ?) Y" i4 |& s) w3 e' ******************************************************************************
Dim swApp As Object
; z# ^' A0 Y# J: t$ KDim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long

Dim SelMgr As Object
! s6 _: K0 u3 K: r( m; p, \- ]: {Dim Feature As Object
/ _2 I, X; N2 d( _1 p0 L0 eDim a As Integer
Dim b As String
6 M: x5 L0 r5 g4 W+ U$ |5 nDim m As String
1 N; Q! a4 ]3 h3 X5 TDim e As String
Dim k As String
Dim t As String
Dim c As String
" [! R& J4 n2 hDim j As Integer
# y7 e6 m5 m( K* f5 ^9 ADim strmat As String
Dim tempvalue As String

; U! g! N# `( {0 N& O  s5 OSub main() '刪除所有配置屬性
Set swApp = Application.SldWorks
) g+ p' l8 Q8 v& i7 [2 rSet Part = swApp.ActiveDoc
CurCFGname = Part.GetConfigurationNames)
CurCFGnameCount = Part.GetConfigurationCount
For i = 0 To CurCFGnameCount - 1
. Z2 Q' V+ ?( z& X' x4 a7 j    Set CusPropMgr = Part.Extension.CustomPropertyManager(CurCFGname(i))
    Vnamearr = CusPropMgr.GetNames
    If Not IsEmpty(Vnamearr) Then
        For Each Vnamearr2 In Vnamearr
- e4 D+ [6 \3 C% X6 L, d            bRet = Part.DeleteCustomInfo2(CurCFGname(i), Vnamearr2)
. ~3 N2 _4 z7 C, }. E9 X! J* C& h        Next
    End If
Next
Call 刪除自定義屬性
1 q" O; ~- @8 Q: ACall partitionTM
5 f) s6 q: F7 S4 `0 C# s6 x
End Sub
, E6 b- B# B0 K4 J. {
'~~~ 刪除自定義屬性 ~~~
& r# p, ?, Z8 ISub  '刪除自定義屬性
% |0 n' O; F5 y$ z'Dim swApp As Object
Dim swModel2 As SldWorks.ModelDoc2
0 e4 ]# q0 W9 @) [6 L& q: UDim vCustInfoNameArr2 As Variant
7 g# j$ f4 f. B. D* }
Set swApp = Application.SldWorks
Set swModel2 = swApp.ActiveDoc
0 C& i/ L& E2 Q6 B* yvCustInfoNameArr2 = swModel2.GetCustomInfoNames
  If Not IsEmpty(vCustInfoNameArr2) Then
% L$ d. K: i; |7 Y1 i4 V* u     For Each vCustInfoName2 In vCustInfoNameArr2
% P; t. e) m9 t& h+ u         bRet = swModel2.DeleteCustomInfo(vCustInfoName2)
4 G! g( f+ l* K( }      Next
  End If
4 J1 n" O/ g; S! B- L& Y. KEnd Sub

'~~~ partitionTM ~~~
Sub partitionTM() 'partitionTM
2 [5 F7 D8 K# W, V
! v) P6 W3 K2 U# Y'link solidworks
Set swApp = Application.SldWorks
) x3 }/ l, P# p0 J- i% eSet Part = swApp.ActiveDoc
Set SelMgr = Part.SelectionManager
swApp.ActiveDoc.ActiveView.FrameState = 1
'扢隅曹講
c = swApp.ActiveDoc.GetTitle() '錨璃靡
  j5 |, z, F- A' ^strmat = Chr(34) + Trim("SW-Material" + "@") + c + Chr(34)
; V4 I/ I% a8 J' M! q, i- l! v* a'tempvalue = Part.CustomInfo2("", "第蹋")
blnretval = Part.DeleteCustomInfo2("", "測瘍")
blnretval = Part.DeleteCustomInfo2("", "靡備")
# V1 h6 v: `  y7 |; Hblnretval = Part.DeleteCustomInfo2("", "第蹋")
a = InStr(c, " ") - 1
If a > 0 Then
% V5 m% u4 _: L$ y    k = Left(c, a)
    t = Left(LTrim(e), 3)
' J. {& c; _9 g. U. v$ ]/ R4 w    If t = "GBT" Then
        e = "GB/T" + Mid(k, 4)
    Else
# s5 b2 X; O- u+ j- @& v        e = k
    End If'
) h1 T0 {# K% x# d8 r    b = Mid(c, a + 2)
    t = Right(c, 7)
( a  ~* U) r1 S0 ]8 M+ x    If t = ".SLDPRT" Or t = ".SLDASM" Then
& k$ z- R9 Y( s% Z0 _0 C# \' z1 X        j = Len(b) - 7
    Else
        j = Len(b)
. \1 h" r0 K' q* w  T' N    End If
5 P/ ?. s# p) l* L# _    m = Left(b, j)
' a) y0 E$ B8 p' {3 ~! oEnd If
5 z7 g- Y# M6 X! a) M! J) tblnretval = Part.AddCustomInfo3("", "測瘍", swCustomInfoText, e)
7 B* p5 l! _- X4 e2 pblnretval = Part.AddCustomInfo3("", "靡備", swCustomInfoText, m)
blnretval = Part.AddCustomInfo3("", "第蹋", swCustomInfoText, strmat)
( T# A* G2 k; _% Q3 F& R/ S% q9 sblnretval = Part.AddCustomInfo3("", "等笭", swCustomInfoText, " ")
blnretval = Part.AddCustomInfo3("", "掘蛁", swCustomInfoText, " ")

End Sub

ryouss

arter_2006 發表于 2018-11-25 09:12
# a* ~0 b- A" g% V0 d, n0 b' H- `: \以下是我改過的宏，不知道哪里出了問題？附件壓縮包是寫字板格式的。
' ******************************** ...

1 @9 q# O' G9 }1 u+ I
# O- C3 t, D5 ]3 y9 i2 G+ l


, K5 O3 v  Q6 C4 c% h+ q