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

ryouss

就是如下的繁體字改為簡體字就是
: C* t( {4 k+ w! _9 T
2 v3 k* E. z( H
5 s; Z* M  U( N7 u

1. ' ******************************************************************************
   3 f1 q" j% r9 [! s
2. ' C:\Users\admin\AppData\Local\Temp\swx8144\Macro1.swb - macro recorded on 11/22/18 by mqlu
   " |& ~: C4 e8 k: j7 A: P
3. ' ******************************************************************************
   ) W! h" f  G9 v" c' C; C
4. Dim swApp As Object
   0 P; `$ u+ T- g/ h  J$ S3 d' b
5. Dim Part As Object
   & w6 g6 M1 D! i) D: ~8 p
6. Dim boolstatus As Boolean
   1 V$ g0 \* w& U2 M4 \1 v
7. Dim longstatus As Long, longwarnings As Long
   " r* D0 N, b1 @' u/ h+ \7 t: Q% T" d
8. 
   8 u( @0 b; E( {
9. Dim SelMgr As Object
   2 g& T/ Z) `* b, @" f3 {
10. Dim Feature As Object
    , l0 G0 Z; Z+ w3 E3 S$ J
11. Dim a As Integer
    0 \. J4 }" M( O/ ?
12. Dim b As String
    
13. Dim m As String
    
14. Dim e As String
    
15. Dim k As String
    # ^# W: z5 P" x9 @* f, a. d
16. Dim t As String
    
17. Dim c As String
    , m. M, s$ J% k8 e5 u
18. Dim j As Integer
    ! x& Q: M7 a: y9 l2 n
19. Dim strmat As String
    
20. Dim tempvalue As String
    
21. 
    % R# [( w) A2 B
22. Sub main() '刪除所有配置屬性
    ) ?* ~! B% D2 @1 ^
23. Set swApp = Application.SldWorks
      f: |# }' x7 H7 G4 P
24. Set Part = swApp.ActiveDoc
    
25. CurCFGname = Part.GetConfigurationNames
    5 B# u, J0 q. g. _3 j8 T
26. CurCFGnameCount = Part.GetConfigurationCount
      H9 T1 l) Z! t, X; {, l, X! S9 _
27. For i = 0 To CurCFGnameCount - 1
    9 E% b# b2 F2 f- @5 u
28.     Set CusPropMgr = Part.Extension.CustomPropertyManager(CurCFGname(i))
    5 W1 ]9 \) V% n4 ]
29.     Vnamearr = CusPropMgr.GetNames
    
30.     If Not IsEmpty(Vnamearr) Then
    
31.         For Each Vnamearr2 In Vnamearr
    
32.             bRet = Part.DeleteCustomInfo2(CurCFGname(i), Vnamearr2)
    4 U" r& }6 U' Y; l% g; ~" D
33.         Next
    8 a9 y5 c& p  M' C" `
34.     End If
    
35. Next
    3 Y3 M) h* ]1 ~8 g; c& V; c# q
36. Call 刪除自定義屬性
    ! _) Z9 O7 O4 d$ C; z. ~5 A9 `  K) i
37. Call partitionTM
    
38. 
    
39. End Sub
    
40. 
    
41. '~~~ 刪除自定義屬性 ~~~
    
42. Sub 刪除自定義屬性()
    
43. 'Dim swApp As Object
    
44. Dim swModel2 As SldWorks.ModelDoc2
    
45. Dim vCustInfoNameArr2 As Variant
    - a! _) h) {, K9 m+ `
46. 
    . W8 f  }! H; N5 s% X" F/ R
47. Set swApp = Application.SldWorks
    
48. Set swModel2 = swApp.ActiveDoc
    # V4 G8 x8 c$ ?( ?' _" W3 s6 X
49. vCustInfoNameArr2 = swModel2.GetCustomInfoNames
    3 V- D8 I# y  y3 z
50.   If Not IsEmpty(vCustInfoNameArr2) Then
    
51.      For Each vCustInfoName2 In vCustInfoNameArr2
    5 b$ z0 P& U% ?: T1 Y
52.          bRet = swModel2.DeleteCustomInfo(vCustInfoName2)
    5 ?$ z8 z4 g! G( ?( Z3 h& g
53.       Next
    # E' N# r0 J  U. z
54.   End If
    ) b1 ~9 m5 K& [. Y8 Y" _, N
55. End Sub
    0 M& s  P2 U* W. u! p
56. 
    
57. '~~~ partitionTM ~~~
    
58. Sub partitionTM() 'partitionTM
    3 p, E# I: x" \. i3 g% a/ u
59. 
    
60. 'link solidworks
    
61. Set swApp = Application.SldWorks
    
62. Set Part = swApp.ActiveDoc
    
63. Set SelMgr = Part.SelectionManager
    
64. swApp.ActiveDoc.ActiveView.FrameState = 1
    
65. '設定變量
    
66. c = swApp.ActiveDoc.GetTitle() '零件名
    . @& w4 s/ `* G% ~1 T2 M  A9 W
67. strmat = Chr(34) + Trim("SW-Material" + "@") + c + Chr(34)
    
68. 'tempvalue = Part.CustomInfo2("", "材料")
    9 ]% g5 t0 c; C/ d6 a; q
69. blnretval = Part.DeleteCustomInfo2("", "代號")
    
70. blnretval = Part.DeleteCustomInfo2("", "名稱")
    
71. blnretval = Part.DeleteCustomInfo2("", "材料")
    * v1 G# {+ P/ Z6 m
72. a = InStr(c, " ") - 1
    1 q( U3 U) q2 u1 [6 L# H
73. If a > 0 Then
    
74.     k = Left(c, a)
    0 U4 N$ L( ~% e8 s
75.     t = Left(LTrim(e), 3)
    
76.     If t = "GBT" Then
    
77.         e = "GB/T" + Mid(k, 4)
    8 e$ b, w$ Q+ E: q: ?
78.     Else
    8 T% k; v" K4 Z) H$ }% ?  a
79.         e = k
    ) e" v# \( C3 \# p. ]
80.     End If
    
81.     b = Mid(c, a + 2)
    ' q; Z/ [2 x/ L7 _1 X
82.     t = Right(c, 7)
    
83.     If t = ".SLDPRT" Or t = ".SLDASM" Then
    " j) S  V; n0 [8 w
84.         j = Len(b) - 7
    
85.     Else
    ( X( T( w+ [$ x! e- J6 e6 ?( I
86.         j = Len(b)
    
87.     End If
    % K# v6 z# a8 r/ j4 O: I; d7 K
88.     m = Left(b, j)
    2 B2 V3 D* v: t: ~: u/ Q/ p
89. End If
    ! S' h$ z  Z% k; I( E/ W* n
90. blnretval = Part.AddCustomInfo3("", "代號", swCustomInfoText, e)
    
91. blnretval = Part.AddCustomInfo3("", "名稱", swCustomInfoText, m)
    ' ?% h' o  w  X4 Y$ l  {" q
92. blnretval = Part.AddCustomInfo3("", "材料", swCustomInfoText, strmat)
    ; F. B- n9 h; ?5 o: i. N
93. blnretval = Part.AddCustomInfo3("", "單重", swCustomInfoText, " ")
    $ y6 L$ J/ }/ ~- M) r
94. blnretval = Part.AddCustomInfo3("", "備註", swCustomInfoText, " ")
    ) f& x& k( P: A$ P3 s
95. 
    ; |7 X4 I3 K" o" A; `  B
96. End Sub

復制代碼

, e, B& d$ }) }; R- V, Y3 ]
' @! x1 q9 D& u- U. D

8 d6 V7 ]) b: A% ^% \

arter_2006

ryouss 發(fā)表于 2018-11-25 11:32
# a; `8 ~; c: x" o( }$ d; C6 {就是如下的繁體字改為簡體字就是

. O+ f4 n9 a- S* W執(zhí)行后無反應,，屬性都沒改,，不知道問題出在哪里？讓您費心了。

' ******************************************************************************
' 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
5 V1 ]8 P: e( u" I$ S' F
; ]* e- U& i" V+ C' ]Dim SelMgr As Object
, t+ b6 f8 j6 _* }! R* E/ _Dim Feature As Object
. j6 I: C& j/ U* Z* d! O( t3 x2 iDim a As Integer
Dim b As String
+ D8 H  W5 N2 ~: \7 K  jDim m As String
$ f8 |' P# Y- mDim e As String
8 A1 B3 x, c0 S) v) _2 @, ADim k As String
Dim t As String
" s6 X, y4 W1 x9 \Dim c As String
3 ^4 r# [  ~5 A! K+ kDim j As Integer
: D" W1 m4 B. X7 I! t5 SDim strmat As String
- K+ r7 p6 W1 Q% U8 E7 I( s9 |Dim tempvalue As String

Sub main() '刪除所有配置屬性
2 q2 t1 G) L6 X4 fSet swApp = Application.SldWorks
8 s& E, O9 z, ~, R, b+ DSet Part = swApp.ActiveDoc
CurCFGname = Part.GetConfigurationNames
* R' y7 B3 u# P8 l& MCurCFGnameCount = 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
2 n4 M5 ?  C2 @1 v% i            bRet = Part.DeleteCustomInfo2(CurCFGname(i), Vnamearr2)
4 |5 M% A7 M! O' U; E7 q1 {        Next
    End If
Next
Call 刪除自定義屬性
Call partitionTM

End Sub

7 o4 A5 `- c8 W, L/ Y'~~~ 刪除自定義屬性 ~~~
4 }& L- {1 G" t, e* P+ v7 t2 USub 刪除自定義屬性()
'Dim swApp As Object
+ ?1 m) q2 {9 o+ O7 Q, G$ k3 EDim swModel2 As SldWorks.ModelDoc2
Dim vCustInfoNameArr2 As Variant

1 v; [# v  x+ j, Q& Y( A: OSet swApp = Application.SldWorks
Set swModel2 = swApp.ActiveDoc
vCustInfoNameArr2 = swModel2.GetCustomInfoNames
/ @; Q% k; ]  n  If Not IsEmpty(vCustInfoNameArr2) Then
* o% F5 l; N' p: Y+ A7 ?4 w     For Each vCustInfoName2 In vCustInfoNameArr2
' M9 Y* A% a! U7 I1 M- m) m8 p         bRet = swModel2.DeleteCustomInfo(vCustInfoName2)
      Next
  End If
' n, u, j' b7 i( Q# e( C2 S: m0 u( SEnd Sub

'~~~ partitionTM ~~~
Sub partitionTM() 'partitionTM
9 f, c1 ?; U( y2 Q  }
! y8 @4 H5 G+ L  D'link solidworks
Set swApp = Application.SldWorks
% K& p  `/ x- v0 m# H5 C/ }Set Part = swApp.ActiveDoc
Set SelMgr = Part.SelectionManager
swApp.ActiveDoc.ActiveView.FrameState = 1
'設定變量
3 I$ k5 I7 I- @& z: c6 Bc = swApp.ActiveDoc.GetTitle() '零件名
* d" v4 w3 l* ]$ s8 |strmat = Chr(34) + Trim("SW-Material" + "@") + c + Chr(34)
'tempvalue = Part.CustomInfo2("", "材料")
9 a& M  T5 F! F# O. Q& qblnretval = Part.DeleteCustomInfo2("", "代號")
blnretval = Part.DeleteCustomInfo2("", "名稱")
blnretval = Part.DeleteCustomInfo2("", "材料")
a = InStr(c, " ") - 1
. k) c5 w2 d# T2 i' I6 \8 jIf a > 0 Then
" h1 X- e& {/ a% v    k = Left(c, a)
! D6 M% V# G6 J1 A/ I' E    t = Left(LTrim(e), 3)
- I# w. L; b1 C& L: y0 ~9 _    If t = "GBT" Then
        e = "GB/T" + Mid(k, 4)
    Else
        e = k
    End If
0 v3 v7 {5 y* p: D# Z+ C! `    b = Mid(c, a + 2)
8 [/ t$ n3 x0 e: l. V5 c7 q' G# T    t = Right(c, 7)
    If t = ".SLDPRT" Or t = ".SLDASM" Then
        j = Len(b) - 7
    Else
        j = Len(b)
2 W( `4 N* V. I    End If
    m = Left(b, j)
End If
blnretval = Part.AddCustomInfo3("", "代號", swCustomInfoText, e)
6 ]/ K4 |2 U+ C+ c. Rblnretval = Part.AddCustomInfo3("", "名稱", swCustomInfoText, m)
blnretval = Part.AddCustomInfo3("", "材料", swCustomInfoText, strmat)
blnretval = Part.AddCustomInfo3("", "單重", swCustomInfoText, " ")
blnretval = Part.AddCustomInfo3("", "備注", swCustomInfoText, " ")
; W7 g+ r1 x" x$ ~3 ?, O
End Sub

ryouss

arter_2006 發(fā)表于 2018-11-26 15:11
* j: _: v2 m1 u3 C# O$ i執(zhí)行后無反應,，屬性都沒改,，不知道問題出在哪里？讓您費心了,。

' ********************************** ...

sw2017 測試OK
有否顯示什麼錯誤提示?
+ G8 {( s/ r% Z: i

4 J- Z, K! F% q6 v; Q" D

arter_2006

我的是Solidworks 2018,，看來可能是版本的問題了

ryouss

arter_2006 發(fā)表于 2018-11-26 17:00
( [* G. n; W5 m8 q2 d4 ~我的是Solidworks 2018,，看來可能是版本的問題了

' s& g8 B; Q- i2018 沒版本能試
7 E$ R4 a, v: u

arter_2006

ryouss 發(fā)表于 2018-11-26 17:05
2018 沒版本能試

非常感謝您，讓您費心了,。
: b( g+ F% ^& H3 u" T% j" N8 d

arter_2006

ryouss 發(fā)表于 2018-11-26 17:05
2018 沒版本能試

4 M! N9 y9 `( J, k能否把您的SWP文件發(fā)上來,，我剛才用solidworks 2014也試了一下，發(fā)現(xiàn)也不行,，但是別的宏都可以,。
" {+ r+ n0 i5 A. f; t/ i" N4 t) l我從網頁上復制下來的都變成下面這個樣子了，所以要刪掉很多多出來的東西,，我懷疑是不是這個原因導致的,，但是校對很費時間，也難發(fā)現(xiàn),。

: d: H4 D4 T; j+ I7 H' ******************************************************************************3 \3 X) J3 n, I6 @4 |0 x
# \7 B3 g# \* U1 I1 f9 Y' C:\Users\admin\AppData\Local\Temp\swx8144\Macro1.swb - macro recorded on 11/22/18 by mqlu' a$ M. \3 S6 C, S! A1 C
. q# y5 G6 V& B* [' ******************************************************************************
; T8 m' \! o, }' E: n% \( F) I, C+ j: _& m6 bDim swApp As Object
' e* i- B# F; m% [6 c9 t+ \0 }Dim Part As Object! t9 ?1 q2 c' K2 l9 ^4 X" G
4 }$ q, T: I, w6 ^: c# T1 GDim boolstatus As Boolean- I8 s/ Y$ i' W. N0 _
Dim longstatus As Long, longwarnings As Long
1 W8 u' q( \3 d4 Y/ K1 v" N; D
2 O4 L* _1 ~* I  E# W3 J( R9 \8 _3 m& \) d/ \Dim SelMgr As Object
  G) H* [# t( N4 a2 k* y, m9 Z: S& D4 E8 I: d4 K4 q9 f0 e& f5 HDim Feature As Object
6 ~+ @+ Z3 l6 L4 q" B7 s$ z: N6 b! v  l! SDim a As Integer
4 c" q) n1 T  `, F" Q% r& P" q% F6 [5 U$ N  F7 l5 _1 iDim b As String/ a) E' o9 v7 y0 L) H; T4 a/ J& Z% M
Dim m As String+ ?/ w( `) D: S9 x
, d+ W7 Q6 l$ C* m1 y7 P) \Dim e As String" t" l1 k  K7 K8 U: @# s; `
+ w4 A$ _) ~& g8 F" }Dim k As String* ?4 t9 u7 n+ _
Dim t As String
% R* ?6 C5 B( @3 D& DDim c As String
! K3 d. @4 X+ d/ Q. _. p: yDim j As Integer3 N( z+ v  K2 q* v6 D
$ V: G) d* y1 q! G& B- I0 }Dim strmat As String
( s- K! C) [& |, m0 ^& P" F! d7 t6 p- DDim tempvalue As String
2 O8 G2 u7 o' u) a& E& r" D5 F  G0 |% Q: b, Y
7 t- S5 V  M( {8 a8 J5 L- o) ?$ `2 a( G& L5 x7 Q- B3 Z( ISub main() '刪除所有配置屬性
6 H" `4 y; ]$ F0 [+ P; c8 H3 l/ z* n* R9 KSet swApp = Application.SldWorks9 g. p. p7 K6 u7 ?4 x4 W6 n
% F. e5 x1 S* j# c# l0 pSet Part = swApp.ActiveDoc$ q6 |& ^2 b7 ~/ ]( ^0 R
* {9 T( S# z. wCurCFGname = Part.GetConfigurationNames
- [5 v: x. U8 U( V* kCurCFGnameCount = Part.GetConfigurationCount
" c- O# J: c, c5 w7 Y0 T. @for i = 0 To CurCFGnameCount - 1& {$ V* E/ x+ ~. V
    Set CusPropMgr = Part.Extension.CustomPropertyManager(CurCFGname(i))
. G( J! L$ ?  c% B6 }    Vnamearr = CusPropMgr.GetNames4 B$ N4 Q* X) q- [; f8 r0 ^5 {
    If Not IsEmpty(Vnamearr) Then' t" n; u" h( T
        For Each Vnamearr2 In Vnamearr
+ H0 Q2 E" Q8 @- w3 P" A: z# y6 ~- n8 t& |, B: B/ V9 S4 d, F7 Z            bRet = Part.DeleteCustomInfo2(CurCFGname(i), Vnamearr2)+ h. {$ P6 Q5 M: i
        Next- P& E; Z$ s7 V+ a( t' E% T
+ ]: J( _/ y; w2 \    End If
1 e- o$ Q4 u- [  @$ w9 l$ A3 @6 S" n' d2 eNext
, O/ H* m3 P5 k' B/ }4 N; _  k" k4 f; K$ vCall 刪除自定義屬性
' K9 c! n& @" p( A- x) f" C" d8 G6 }) {# {' iCall partitionTM4 }2 o$ e' E7 t
. W+ e$ V& F- \4 k
2 @8 q. ~" b  {% q" `4 h6 {End Sub
% e; G6 r) ]# @' p
" D7 r# [' m2 U5 Z7 k9 B. O: ?'~~~ 刪除自定義屬性 ~~~
: Q6 `! G2 u. ]" |4 i. ?Sub 刪除自定義屬性()
$ G9 G; m) ^  U8 \5 x  D  B# r$ |5 d2 b. o4 x5 W" n+ J'Dim swApp As Object2 Q# s7 O1 ~+ I" }
' ]3 p& [& e8 MDim swModel2 As SldWorks.ModelDoc2
! f' g# o6 S, e, W4 z+ EDim vCustInfoNameArr2 As Variant7 J* i  U% A! t0 \0 D! h, V

- K" x+ X- v- E% b! h6 i* p! ], |9 USet swApp = Application.SldWorks
3 `4 {* k/ t# T5 z) r1 l6 J4 S  i4 [' W6 ]0 I* U0 V' O' B+ NSet swModel2 = swApp.ActiveDoc3 u) Z+ D2 D4 z; M# d4 {
( {9 g4 t2 x% P: [' H" xvCustInfoNameArr2 = swModel2.GetCustomInfoNames- N/ C9 m0 n2 t* k9 u
9 Z$ K% W. ]( q0 D: \  If Not IsEmpty(vCustInfoNameArr2) Then
- Z$ ?) ~7 J% O. H! V# Z5 s; g8 P9 J( v  m% Z     For Each vCustInfoName2 In vCustInfoNameArr2- \% O7 w% [: r; T3 |5 M
         bRet = swModel2.DeleteCustomInfo(vCustInfoName2)
. ?" R/ r# I! y' x7 _' X      Next9 U+ R% V2 G# P
! G% D* M- I; }5 [% ^! C. W8 ]  End If
" b/ v6 |, V7 @' G: I% Y% I& V, L( M& Q4 l& b0 TEnd Sub
3 Z2 [; |" F3 m2 Z1 U# {6 M- K7 `: z' w) T+ c$ V; G
/ j9 |  ?( U5 a+ K'~~~ partitionTM ~~~7 O3 t. l4 R1 [+ ]3 K  G+ M
. A0 {- R% c% y, MSub partitionTM() 'partitionTM( j# ]! b. Q, G0 M9 E4 f8 B2 J
* E, c! W& L, {  D4 l  q% l; E) x# ~4 [& t0 {8 [
'link solidworks( C, c- [# N+ Z* [
Set swApp = Application.SldWorks+ w1 D3 {4 b7 ^# i5 p4 ~2 p
" F: A. ~  _! }Set Part = swApp.ActiveDoc
; A9 A! n- M1 h1 {' C+ v5 L$ D) k" c8 Y, z+ b# A0 `9 OSet SelMgr = Part.SelectionManager% m# Z: n! Q: I/ M* d( j' c
! l8 O& E: ^- w4 I1 w9 T! r2 IswApp.ActiveDoc.ActiveView.FrameState = 1& ?6 I  _. Y+ \4 m7 P" c% W/ h
3 ^" w. o: S4 X# Y  @5 D9 i'設定變量& }. N& d* J$ W) S
c = swApp.ActiveDoc.GetTitle() '零件名
. {8 L5 ~" z0 y# g! I" Estrmat = Chr(34) + Trim("SW-Material" + "@") + c + Chr(34). w+ f3 v( W- `* D! G! v. z
'tempvalue = Part.CustomInfo2("", "材料")
3 K. C5 C3 C+ f( T5 c6 B1 v; C& U; y& P! d9 n  V  X0 H+ J1 Yblnretval = Part.DeleteCustomInfo2("", "代號")3 w1 A4 Q. Z1 \, x1 N/ e; R
blnretval = Part.DeleteCustomInfo2("", "名稱"). }" r" K0 E! E
& Y- d: I3 ]1 X* V7 @# m) k2 w6 oblnretval = Part.DeleteCustomInfo2("", "材料")
" q; N& n: b& d' V  v+ U) d- F; R- ]4 V0 e- k2 J; Sa = InStr(c, " ") - 1
" v0 S% D. r) K$ `' iIf a > 0 Then
0 D& _% k+ M" K3 ~    k = Left(c, a)0 D( T  G4 u* @' Z: h# g5 h) k
' h8 t5 h' y2 @/ g1 @    t = Left(LTrim(e), 3)0 |: d+ H% K1 I5 d; ^& r
* N0 \, g- G- _' g, z& U( z5 \    If t = "GBT" Then0 a: k4 H  }1 j) y
        e = "GB/T" + Mid(k, 4)0 C& x4 F4 D' ], i* s8 T
    Else
! W2 i7 C- b( f1 H* X4 B; P        e = k& O7 M7 ]$ E: v$ n5 ]  ?0 p$ z
    End If! C- h9 R! k; n% D6 G+ S; P
    b = Mid(c, a + 2)
, `9 k& a) g- h+ j9 ?1 a, _" o% b/ ^0 j8 S  T    t = Right(c, 7)
0 Y- A& M4 `# s  y" `& G. A( H6 S2 ?' U+ d5 X" f: a    If t = ".SLDPRT" Or t = ".SLDASM" Then
( m# n+ r. ]5 p& Q/ I! e        j = Len(b) - 7: f; _- _+ L% W8 E) q2 `; Z9 B' \
; L# G  q  ]/ h$ i    Else& f9 y# D- W/ Y! i& w- H
4 ^9 u4 ]% K0 h: d. T5 O        j = Len(b); J( ?# E, |  ?
    End If8 @/ x5 s, N; \. _& V# V
    m = Left(b, j)
. P: e' A' P) l4 b& \End If( o3 u- a' n" g; c4 t2 s& ]
blnretval = Part.AddCustomInfo3("", "代號", swCustomInfoText, e)
: F  K  N' M% L5 C4 Hblnretval = Part.AddCustomInfo3("", "名稱", swCustomInfoText, m)7 a/ m( J8 q$ B) ^& B( M# Q' V
3 f0 T' L2 J( V7 Cblnretval = Part.AddCustomInfo3("", "材料", swCustomInfoText, strmat)
9 Z0 O2 e0 Q6 cblnretval = Part.AddCustomInfo3("", "單重", swCustomInfoText, " ")
  o( _& h8 F9 Z/ m/ `  V; G2 e# V. L; H; {2 wblnretval = Part.AddCustomInfo3("", "備註", swCustomInfoText, " ")
# r2 b1 @/ H, k. r, T: i2 D6 }7 z- @1 t: i# Q, P, {! f% c" J- {6 u; t
' [' R4 e' ]6 n$ ^End Sub

$ x; [, @2 W7 F5 g

ryouss

arter_2006 發(fā)表于 2018-11-26 17:27
能否把您的SWP文件發(fā)上來,，我剛才用solidworks 2014也試了一下，發(fā)現(xiàn)也不行,，但是別的宏都可以,。
我從網 ...

附swp繁體版   
0 m4 Y# E, q+ J- C

ryouss

1 c& H9 G# ]9 ?; }- g, M
; Y2 v' I1 M; ~5 A7 c! l. [$ |  N/ v試試把   CurCFGname = swApp.GetConfigurationNames

* c+ P) t# B9 y! k4 l, B改為      CurCFGname = swApp.GetConfigurationNames(swApp.ActiveDoc.GetPathName) '補加零件文件的路徑及名稱
/ q6 _  d  B# ?; `
0 F% q* ]' Q, D, e! K( d6 A在沒補加 (swApp.ActiveDoc.GetPathName) 時在2012及2015版是會有提示錯誤的(如附圖)
另VBA編程在   " '  " 符號后的文字是會跳過不執(zhí)行的.

arter_2006

我試過了，改之前,，改之后一個樣,，而且執(zhí)行中沒有任何錯誤提示。
' ******************************************************************************
8 w! Z  O  Z. `% G  d0 z5 X' C:\Users\admin\AppData\Local\Temp\swx8144\Macro1.swb - macro recorded on 11/22/18 by mqlu
' ******************************************************************************
Dim swApp As Object
8 D" X, C, T9 S) [+ qDim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
, F; }: O5 s' h8 M3 p! \: G
7 |! j8 D7 ~- b  |. YDim SelMgr As Object
Dim Feature As Object
Dim a As Integer
& j$ |/ w) P0 y" W$ ?7 p2 N2 XDim b As String
/ c2 f* o$ m: F# x# d& `Dim m As String
Dim e As String
Dim k As String
Dim t As String
Dim c As String
Dim j As Integer
, d$ a; N- d6 z! R3 TDim strmat As String
7 G4 [; f( U( P8 QDim tempvalue As String

# ?# K% H$ b( E$ X  {$ f6 y* D2 ?Sub main() '刪除所有配置屬性
Set swApp = Application.SldWorks
8 C7 F3 g+ O" vSet Part = swApp.ActiveDoc
CurCFGname = swApp.GetConfigurationNames(swApp.ActiveDoc.GetPathName) '補加零件文件的路徑及名稱
CurCFGnameCount = Part.GetConfigurationCount
. x; H/ G0 F+ l$ V+ n1 hFor i = 0 To CurCFGnameCount - 1
    Set CusPropMgr = Part.Extension.CustomPropertyManager(CurCFGname(i))
& d4 @/ {) M# w( J- g: @    Vnamearr = CusPropMgr.GetNames
6 X# ?. O2 J* C! Y" N' V) W    If Not IsEmpty(Vnamearr) Then
7 z1 p. h& e$ n) g! c        For Each Vnamearr2 In Vnamearr
            bRet = Part.DeleteCustomInfo2(CurCFGname(i), Vnamearr2)
        Next
- y( y6 [3 Z3 d( |. N    End If
Next
- K- a; D3 j/ J& w, _Call 刪除自定義屬性
1 i3 s5 r+ d1 }Call partitionTM
" M$ M) c' X$ R  t6 ~
4 S) v% {# {  K# _1 x+ v$ I4 T# \End Sub

6 \: |3 O! N6 f" O3 i( Q'~~~ 刪除自定義屬性 ~~~
2 q& \0 @3 G1 ~! ^5 I* _1 d- ^Sub 刪除自定義屬性()
. t8 d( h- V. M$ k* i'Dim swApp As Object
+ Z0 l0 ~  Y7 K3 s4 ^6 ODim swModel2 As SldWorks.ModelDoc2
& G+ t3 C2 {; T. O% s" L& f" Z, aDim vCustInfoNameArr2 As Variant

2 V6 n  M" X- h# b5 L6 X7 ySet swApp = Application.SldWorks
Set swModel2 = swApp.ActiveDoc
vCustInfoNameArr2 = swModel2.GetCustomInfoNames
7 \" i" s0 \; b0 R. [  If Not IsEmpty(vCustInfoNameArr2) Then
     For Each vCustInfoName2 In vCustInfoNameArr2
         bRet = swModel2.DeleteCustomInfo(vCustInfoName2)
7 J! e5 _+ |& a: Y" ~( S& \3 O      Next
  End If
( L' Z) d! m% m2 wEnd Sub

5 k) I  V1 ^3 F9 b  W, e'~~~ partitionTM ~~~
  @2 O: c* D) K8 sSub partitionTM() 'partitionTM

* B% k" e4 @1 e7 K'link solidworks
Set swApp = Application.SldWorks
6 [4 l! J5 o+ n" B. w6 X* |Set Part = swApp.ActiveDoc
& l4 Z0 R9 L) HSet SelMgr = Part.SelectionManager
swApp.ActiveDoc.ActiveView.FrameState = 1
'設定變量
c = swApp.ActiveDoc.GetTitle() '零件名
strmat = Chr(34) + Trim("SW-Material" + "@") + c + Chr(34)
8 K, b' \/ A' I- d! w% {) E'tempvalue = Part.CustomInfo2("", "材料")
blnretval = Part.DeleteCustomInfo2("", "代號")
1 }7 F6 J) K) d' P4 bblnretval = Part.DeleteCustomInfo2("", "名稱")
blnretval = Part.DeleteCustomInfo2("", "材料")


* ~, g, `) F% A0 N; [  \6 {( |a = InStr(c, " ") - 1
4 [! t( K6 s- W8 u9 XIf a > 0 Then
    k = Left(c, a)
    t = Left(LTrim(e), 3)

    If t = "GBT" Then
0 H4 m. P: @. X4 n( C0 |: h        e = "GB/T" + Mid(k, 4)
    Else
$ Z6 ~1 |8 W  q6 j4 J9 h) m        e = k
8 _* y& K: \. V; \3 y+ R    End If
# l% T1 c% p$ d+ q  |4 \
5 @1 J+ b1 ?8 T# y4 V    b = Mid(c, a + 2)
    t = Right(c, 7)
    If t = ".SLDPRT" Or t = ".SLDASM" Then
        j = Len(b) - 7
    Else
. t+ y$ ?( }7 q6 x( N        j = Len(b)
    End If
    m = Left(b, j)
End If

; J0 m; c. Z1 gblnretval = Part.AddCustomInfo3("", "代號", swCustomInfoText, e)
9 d% S' @& D/ V! N: u. Iblnretval = Part.AddCustomInfo3("", "名稱", swCustomInfoText, m)
0 Y, y+ K3 g! ?+ c, Y1 Yblnretval = Part.AddCustomInfo3("", "材料", swCustomInfoText, strmat)
9 I" K0 h' Z, P  F9 k2 p0 M, Zblnretval = Part.AddCustomInfo3("", "單重", swCustomInfoText, " ")
blnretval = Part.AddCustomInfo3("", "備注", swCustomInfoText, " ")

+ F' e, I" O# T3 o; [5 dEnd Sub