SOLIDWORKS 宏合并執行的問題

ryouss

就是如下的繁體字改為簡體字就是

  C7 p  R% V4 Q$ E+ O

1. ' ******************************************************************************
   
2. ' C:\Users\admin\AppData\Local\Temp\swx8144\Macro1.swb - macro recorded on 11/22/18 by mqlu
   6 k" j, e! k& v: o3 v/ |* m
3. ' ******************************************************************************
   
4. Dim swApp As Object
   
5. Dim Part As Object
   
6. Dim boolstatus As Boolean
   
7. Dim longstatus As Long, longwarnings As Long
   
8. 
   ; r- _1 l! q3 m- F) r: J
9. Dim SelMgr As Object
   , Y1 d- i9 U5 Q7 }/ _4 E# I' Y+ _4 k
10. Dim Feature As Object
    ! S. {; a6 N: S) J4 b# B
11. Dim a As Integer
      ]0 q' L% i! B0 \" N+ a
12. Dim b As String
    . C9 ^  j( X+ C9 o% V
13. Dim m As String
    # W8 G3 b2 p- M! e9 q
14. Dim e As String
    
15. Dim k As String
    
16. Dim t As String
    / [4 R  B; v! g+ Z% i* I! r
17. Dim c As String
    
18. Dim j As Integer
    $ L) T; |; e( i
19. Dim strmat As String
    1 Q8 W2 B& v" k$ z3 a4 q+ s, z
20. Dim tempvalue As String
    
21. 
    
22. Sub main() '刪除所有配置屬性
    + d: F' K3 y$ j& B! K
23. Set swApp = Application.SldWorks
      u, H$ l6 u/ Z' Z
24. Set Part = swApp.ActiveDoc
    
25. CurCFGname = Part.GetConfigurationNames
    7 P  i+ e: I$ P; ~
26. CurCFGnameCount = Part.GetConfigurationCount
    1 {- I1 @& P& i
27. For i = 0 To CurCFGnameCount - 1
    
28.     Set CusPropMgr = Part.Extension.CustomPropertyManager(CurCFGname(i))
    7 f0 C% A" N% T/ S' M
29.     Vnamearr = CusPropMgr.GetNames
    
30.     If Not IsEmpty(Vnamearr) Then
    : x( s- y6 T, H+ f7 |4 e* l
31.         For Each Vnamearr2 In Vnamearr
    
32.             bRet = Part.DeleteCustomInfo2(CurCFGname(i), Vnamearr2)
    
33.         Next
    
34.     End If
    $ \8 L3 C- `1 M$ u
35. Next
    " \6 A: Z2 b- |
36. Call 刪除自定義屬性
    
37. Call partitionTM
    # q! C. F6 W: l
38. 
    
39. End Sub
    * a$ @! t" A$ l9 K3 e; m( W. J
40. 
    1 [' Y4 V- [% |! I
41. '~~~ 刪除自定義屬性 ~~~
    
42. Sub 刪除自定義屬性()
    ' b+ G8 p0 T3 `" h
43. 'Dim swApp As Object
    
44. Dim swModel2 As SldWorks.ModelDoc2
    
45. Dim vCustInfoNameArr2 As Variant
    
46. 
    5 O  N# \- H& m8 t% N4 m
47. Set swApp = Application.SldWorks
    
48. Set swModel2 = swApp.ActiveDoc
    
49. vCustInfoNameArr2 = swModel2.GetCustomInfoNames
    ' h1 ?8 Y2 ?5 [% Q8 n8 i
50.   If Not IsEmpty(vCustInfoNameArr2) Then
    + Q/ F$ w% i$ }
51.      For Each vCustInfoName2 In vCustInfoNameArr2
    
52.          bRet = swModel2.DeleteCustomInfo(vCustInfoName2)
    
53.       Next
    
54.   End If
    
55. End Sub
    + u: ?8 U) d2 B8 E: c! J
56. 
    ! x$ p% U4 F$ c' Q0 C: C2 j" d
57. '~~~ partitionTM ~~~
    
58. Sub partitionTM() 'partitionTM
    + B$ H! P8 N. k$ `: P1 j7 H( J7 F* i
59. 
    
60. 'link solidworks
    0 [7 X: j# B+ o7 X
61. Set swApp = Application.SldWorks
    % F! I4 J, u. Q) N& b
62. Set Part = swApp.ActiveDoc
    % o$ V1 U6 N2 `8 `- S
63. Set SelMgr = Part.SelectionManager
    
64. swApp.ActiveDoc.ActiveView.FrameState = 1
    # f9 Z8 \% [7 m6 ?" P
65. '設定變量
    
66. c = swApp.ActiveDoc.GetTitle() '零件名
    2 r% Y# F* |& _" h* c3 X/ f
67. strmat = Chr(34) + Trim("SW-Material" + "@") + c + Chr(34)
    
68. 'tempvalue = Part.CustomInfo2("", "材料")
    + K2 A4 X* d' U. g8 s4 |
69. blnretval = Part.DeleteCustomInfo2("", "代號")
    / M! z* r; ~4 J& \- W1 u
70. blnretval = Part.DeleteCustomInfo2("", "名稱")
    % K/ q0 g7 g; F4 f8 N. y4 b. y
71. blnretval = Part.DeleteCustomInfo2("", "材料")
    5 Z  A# R% P! A
72. a = InStr(c, " ") - 1
    
73. If a > 0 Then
    / r9 e) o, g. y$ k4 u( ~; c/ v
74.     k = Left(c, a)
    : D7 h. L' Q$ J8 f+ T( z% h
75.     t = Left(LTrim(e), 3)
    5 H  ^" R8 a  p7 I" e2 D
76.     If t = "GBT" Then
    
77.         e = "GB/T" + Mid(k, 4)
    
78.     Else
    
79.         e = k
    
80.     End If
    
81.     b = Mid(c, a + 2)
    
82.     t = Right(c, 7)
    7 [8 U. w1 ~6 |& i; a
83.     If t = ".SLDPRT" Or t = ".SLDASM" Then
    5 u. ^; N3 z/ _" B4 L! _2 `; T: {
84.         j = Len(b) - 7
    
85.     Else
    
86.         j = Len(b)
    
87.     End If
    $ m0 y% k( U5 ]1 M9 ?) y* c% d
88.     m = Left(b, j)
    ) M* F7 q' O3 @3 Z4 \- {
89. End If
    
90. blnretval = Part.AddCustomInfo3("", "代號", swCustomInfoText, e)
    
91. blnretval = Part.AddCustomInfo3("", "名稱", swCustomInfoText, m)
    / d9 G) n: g+ {( L4 g" L5 r' l
92. blnretval = Part.AddCustomInfo3("", "材料", swCustomInfoText, strmat)
    
93. blnretval = Part.AddCustomInfo3("", "單重", swCustomInfoText, " ")
    
94. blnretval = Part.AddCustomInfo3("", "備註", swCustomInfoText, " ")
    
95. 
    
96. End Sub

復制代碼

! c, X  R  q( Z+ v1 B0 J
+ U" p: C  p' G
  Z, F; ^" W6 n1 X4 m

arter_2006

ryouss 發表于 2018-11-25 11:32
/ `5 j" M  Z$ C9 m0 _; V就是如下的繁體字改為簡體字就是

$ {1 `6 {1 \/ @' C/ m* h% s3 \執行后無反應，屬性都沒改，不知道問題出在哪里？讓您費心了。
  a" g' W$ m- `; [
' ******************************************************************************
: n* `* b6 s& Y+ |) l* g1 e" R' 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
! V" e4 V$ c* r9 X7 ]( CDim boolstatus As Boolean
) z4 P' e9 I1 H  n( ], QDim longstatus As Long, longwarnings As Long
: n4 O  ?: I7 g% t# \1 h
- _# G5 P& E0 P( n) F/ W! mDim SelMgr As Object
Dim Feature As Object
Dim a As Integer
* V- m5 o  W. J' F$ xDim b As String
: M0 S5 u! d6 r2 v7 B$ r) H; V) D( aDim m As String
( ?& _8 _! X4 ]8 p& w3 [3 sDim e As String
Dim k As String
Dim t As String
0 f1 d( h9 m3 v8 lDim c As String
" D! ?2 e/ F9 p1 ]Dim j As Integer
5 S4 a5 s6 y0 T1 T0 [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))
! u2 U9 E, {; U( X    Vnamearr = CusPropMgr.GetNames
7 e9 h4 d4 c0 k    If Not IsEmpty(Vnamearr) Then
        For Each Vnamearr2 In Vnamearr
! P; \0 H5 a8 n            bRet = Part.DeleteCustomInfo2(CurCFGname(i), Vnamearr2)
+ ]5 v& Z* Q3 t1 y  V' y( V% D        Next
( m  ?* N0 B+ ^' a- U# L' S    End If
Next
Call 刪除自定義屬性
/ I4 n6 M0 d6 F3 A& `0 iCall partitionTM
! u: T& f1 h6 A5 a6 a
( ]5 K) h1 `- E6 ?) H7 t4 A& gEnd Sub

9 z" ~  e3 y; Y+ c'~~~ 刪除自定義屬性 ~~~
Sub 刪除自定義屬性()
: G6 ]% @6 f1 O'Dim swApp As Object
& M# Y3 P6 n' e/ JDim swModel2 As SldWorks.ModelDoc2
$ O5 P. R* R7 J& P" RDim vCustInfoNameArr2 As Variant
! S% W( w5 C  X* E/ M
Set swApp = Application.SldWorks
: y3 A0 G0 w8 pSet swModel2 = swApp.ActiveDoc
vCustInfoNameArr2 = swModel2.GetCustomInfoNames
# U, R# C; V# v5 R9 E  If Not IsEmpty(vCustInfoNameArr2) Then
     For Each vCustInfoName2 In vCustInfoNameArr2
4 f3 h' q  o1 `0 S7 }         bRet = swModel2.DeleteCustomInfo(vCustInfoName2)
      Next
  End If
! |1 P+ I3 a3 K6 `$ G) P, _End Sub

: C, N- ?( |6 K$ }% @/ A'~~~ partitionTM ~~~
Sub partitionTM() 'partitionTM
/ j- \9 U6 f) O( d+ Q! H7 W1 o
'link solidworks
: X( H3 W1 d& J! ESet swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
1 q$ P* r1 ~8 Y9 q7 {- v% dSet SelMgr = Part.SelectionManager
swApp.ActiveDoc.ActiveView.FrameState = 1
'設定變量
) n; S! d5 J9 W3 v) c* B# P7 Bc = swApp.ActiveDoc.GetTitle() '零件名
strmat = Chr(34) + Trim("SW-Material" + "@") + c + Chr(34)
% a0 b+ A" n, b) q# X'tempvalue = Part.CustomInfo2("", "材料")
0 f3 I! P1 L9 D& Kblnretval = Part.DeleteCustomInfo2("", "代號")
8 _$ N0 n" ?1 v: ]4 y8 J8 H, Dblnretval = Part.DeleteCustomInfo2("", "名稱")
blnretval = Part.DeleteCustomInfo2("", "材料")
a = InStr(c, " ") - 1
, L) g/ T, r; U! NIf a > 0 Then
    k = Left(c, a)
6 ?6 d. H' o+ i. o6 e    t = Left(LTrim(e), 3)
6 `* m1 N5 h& U" B( k! V    If t = "GBT" Then
' }8 u4 f3 d$ T) Q        e = "GB/T" + Mid(k, 4)
8 B1 j, e5 l3 _' d+ r5 a& ]6 g    Else
        e = k
: u' e5 {" S% \% e% P    End If
0 d* i8 m" {1 ]( q  r9 J) |* ~    b = Mid(c, a + 2)
    t = Right(c, 7)
    If t = ".SLDPRT" Or t = ".SLDASM" Then
$ n' d" t' I, X' E' J        j = Len(b) - 7
    Else
2 {- q, Q! `( J( V. U        j = Len(b)
& ?5 G+ ~' e8 T    End If
    m = Left(b, j)
End If
. Y% M* ]$ r$ `- |8 A& Lblnretval = Part.AddCustomInfo3("", "代號", swCustomInfoText, e)
blnretval = Part.AddCustomInfo3("", "名稱", swCustomInfoText, m)
blnretval = Part.AddCustomInfo3("", "材料", swCustomInfoText, strmat)
6 g8 x* T/ R* Xblnretval = Part.AddCustomInfo3("", "單重", swCustomInfoText, " ")
blnretval = Part.AddCustomInfo3("", "備注", swCustomInfoText, " ")
; Z+ k7 o' K) |) [, U* _& k3 x
  r$ ]; e* a& \' i. }: jEnd Sub

ryouss

arter_2006 發表于 2018-11-26 15:11
: C8 X6 o: E! m+ g$ J8 \執行后無反應，屬性都沒改，不知道問題出在哪里？讓您費心了。
6 f1 R( w4 p) P
- v! R1 [) s# C& E1 B& D' ********************************** ...

sw2017 測試OK
有否顯示什麼錯誤提示?
7 C% V; `; f+ k



. e+ C2 M% A% S; ]; g5 J1 W  q

arter_2006

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

ryouss

arter_2006 發表于 2018-11-26 17:00
我的是Solidworks 2018，看來可能是版本的問題了

  g9 e0 U0 o. G  U6 v2018 沒版本能試
& m5 }- g; q- s( e, c4 V6 u: O2 X

arter_2006

ryouss 發表于 2018-11-26 17:05
- b0 A9 x2 _: Z# b4 F2018 沒版本能試

非常感謝您，讓您費心了。
( o3 j# D# G# T' z

arter_2006

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

- N1 |0 Y# b! j; c! Q能否把您的SWP文件發上來，我剛才用solidworks 2014也試了一下，發現也不行，但是別的宏都可以。
5 L. W# Q5 [6 y8 m; _5 ?我從網頁上復制下來的都變成下面這個樣子了，所以要刪掉很多多出來的東西，我懷疑是不是這個原因導致的，但是校對很費時間，也難發現。
( W+ }  L/ Z2 v$ X
4 j) o' J% a- M! M' w# K# S' ******************************************************************************3 \3 X) J3 n, I6 @4 |0 x
' 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
) t- U5 I% T8 }' ******************************************************************************
: n% \( F) I, C+ j: _& m6 bDim swApp As Object
, ]8 F' M+ A  K, T7 r/ C: M# w' e* i- B# F; m% [6 c9 t+ \0 }Dim Part As Object! t9 ?1 q2 c' K2 l9 ^4 X" G
Dim boolstatus As Boolean- I8 s/ Y$ i' W. N0 _
4 N! A- T" n' ~: KDim longstatus As Long, longwarnings As Long
1 W8 u' q( \3 d4 Y/ K1 v" N; D
& G  w4 y, C  E( m0 Y5 ]3 J( R9 \8 _3 m& \) d/ \Dim SelMgr As Object
: S& D4 E8 I: d4 K4 q9 f0 e& f5 HDim Feature As Object
7 s$ z: N6 b! v  l! SDim a As Integer
& 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
Dim e As String" t" l1 k  K7 K8 U: @# s; `
5 S/ e# g3 z. E1 jDim k As String* ?4 t9 u7 n+ _
6 d8 @) }2 |" m  r$ U8 g0 N1 xDim t As String
7 E1 E4 Z- |6 e  \% R* ?6 C5 B( @3 D& DDim c As String
2 p* p; C# v0 ?. b0 g6 F! ~7 C1 u) k7 H; y! K3 d. @4 X+ d/ Q. _. p: yDim j As Integer3 N( z+ v  K2 q* v6 D
Dim strmat As String
" F! d7 t6 p- DDim tempvalue As String
( _; \; V8 z/ |, X# J, B; K& E& r" D5 F  G0 |% Q: b, Y
- o) ?$ `2 a( G& L5 x7 Q- B3 Z( ISub main() '刪除所有配置屬性
3 `; @, L0 d' k' o% k; c8 H3 l/ z* n* R9 KSet swApp = Application.SldWorks9 g. p. p7 K6 u7 ?4 x4 W6 n
' P$ y1 L* [* w& `7 gSet Part = swApp.ActiveDoc$ q6 |& ^2 b7 ~/ ]( ^0 R
0 b5 |1 D& W' z- cCurCFGname = Part.GetConfigurationNames
$ k& F  Q6 |) ~3 ]6 P- [5 v: x. U8 U( V* kCurCFGnameCount = Part.GetConfigurationCount
) ?1 z! D* c; N/ h6 D+ C4 C" w" c- O# J: c, c5 w7 Y0 T. @for i = 0 To CurCFGnameCount - 1& {$ V* E/ x+ ~. V
+ Z6 U# a9 W$ o9 I    Set CusPropMgr = Part.Extension.CustomPropertyManager(CurCFGname(i))
; B- M- A4 H5 p: s1 S. U4 O5 ~; Y3 M. G( J! L$ ?  c% B6 }    Vnamearr = CusPropMgr.GetNames4 B$ N4 Q* X) q- [; f8 r0 ^5 {
2 O0 w# C. J; U6 N' K. P! f    If Not IsEmpty(Vnamearr) Then' t" n; u" h( T
        For Each Vnamearr2 In Vnamearr
) C. H8 f  C9 s. J8 m$ r- n8 t& |, B: B/ V9 S4 d, F7 Z            bRet = Part.DeleteCustomInfo2(CurCFGname(i), Vnamearr2)+ h. {$ P6 Q5 M: i
* v3 g( G) r, G        Next- P& E; Z$ s7 V+ a( t' E% T
    End If
; `' p* i0 q0 }) _! G$ A3 @6 S" n' d2 eNext
6 \5 }; |3 E) Y9 J9 r  k" k4 f; K$ vCall 刪除自定義屬性
( A- x) f" C" d8 G6 }) {# {' iCall partitionTM4 }2 o$ e' E7 t
5 a3 g1 X  h  \5 o& {( T  \4 Q
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 刪除自定義屬性()
' T3 x+ ?' x8 [' \  B# r$ |5 d2 b. o4 x5 W" n+ J'Dim swApp As Object2 Q# s7 O1 ~+ I" }
Dim swModel2 As SldWorks.ModelDoc2
+ R) v( a9 O% D2 S; q! f' g# o6 S, e, W4 z+ EDim vCustInfoNameArr2 As Variant7 J* i  U% A! t0 \0 D! h, V
2 ]2 C5 \2 _2 E3 D& r7 h
- K" x+ X- v- E% b! h6 i* p! ], |9 USet swApp = Application.SldWorks
4 S  i4 [' W6 ]0 I* U0 V' O' B+ NSet swModel2 = swApp.ActiveDoc3 u) Z+ D2 D4 z; M# d4 {
% i9 L4 s4 U( Q) {vCustInfoNameArr2 = swModel2.GetCustomInfoNames- N/ C9 m0 n2 t* k9 u
+ E7 n, h' t5 \: l  {% M/ m$ H  If Not IsEmpty(vCustInfoNameArr2) Then
7 m8 G; {; r3 I- k" t5 u+ M" H# n! V# Z5 s; g8 P9 J( v  m% Z     For Each vCustInfoName2 In vCustInfoNameArr2- \% O7 w% [: r; T3 |5 M
6 n, C+ u9 ~( d( L7 J1 `0 ]         bRet = swModel2.DeleteCustomInfo(vCustInfoName2)
4 w; O; U2 T- z' O. ?" R/ r# I! y' x7 _' X      Next9 U+ R% V2 G# P
, i9 X' I) }" s  End If
& V, L( M& Q4 l& b0 TEnd Sub
6 M- K7 `: z' w) T+ c$ V; G
/ j9 |  ?( U5 a+ K'~~~ partitionTM ~~~7 O3 t. l4 R1 [+ ]3 K  G+ M
Sub partitionTM() 'partitionTM( j# ]! b. Q, G0 M9 E4 f8 B2 J
% l; E) x# ~4 [& t0 {8 [
'link solidworks( C, c- [# N+ Z* [
% x$ Q5 m# X) Q9 `Set swApp = Application.SldWorks+ w1 D3 {4 b7 ^# i5 p4 ~2 p
9 G9 T! g' T8 Z5 W* [& B9 q2 _Set Part = swApp.ActiveDoc
) k" c8 Y, z+ b# A0 `9 OSet SelMgr = Part.SelectionManager% m# Z: n! Q: I/ M* d( j' c
$ O( j4 K) J' [$ E. e  {swApp.ActiveDoc.ActiveView.FrameState = 1& ?6 I  _. Y+ \4 m7 P" c% W/ h
'設定變量& }. N& d* J$ W) S
c = swApp.ActiveDoc.GetTitle() '零件名
; h3 T0 [- o7 L$ ^+ ?. {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("", "材料")
& 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
blnretval = Part.DeleteCustomInfo2("", "材料")
2 `$ t9 h! l5 x+ T% j/ E9 E/ l+ U) d- F; R- ]4 V0 e- k2 J; Sa = InStr(c, " ") - 1
, f: l; ?. G9 j  N4 c" 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
$ S1 h7 G5 C& D    t = Left(LTrim(e), 3)0 |: d+ H% K1 I5 d; ^& r
    If t = "GBT" Then0 a: k4 H  }1 j) y
. N0 J4 n- ^; C- J& h) ?" B0 R+ h        e = "GB/T" + Mid(k, 4)0 C& x4 F4 D' ], i* s8 T
& p, s' V9 h& I1 d& k    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)
1 a, _" o% b/ ^0 j8 S  T    t = Right(c, 7)
( 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' \
9 Q5 Y  c  R7 ?+ H4 f  Q6 G    Else& f9 y# D- W/ Y! i& w- H
        j = Len(b); J( ?# E, |  ?
+ f" H8 ]. U! J1 K" Y! s    End If8 @/ x5 s, N; \. _& V# V
( Z/ L8 M7 V+ w( Z    m = Left(b, j)
0 J6 Y4 B4 D& @  D. P: e' A' P) l4 b& \End If( o3 u- a' n" g; c4 t2 s& ]
blnretval = Part.AddCustomInfo3("", "代號", swCustomInfoText, e)
3 E6 K" I; z& T" x$ o3 _3 ]% H6 g: F  K  N' M% L5 C4 Hblnretval = Part.AddCustomInfo3("", "名稱", swCustomInfoText, m)7 a/ m( J8 q$ B) ^& B( M# Q' V
blnretval = Part.AddCustomInfo3("", "材料", swCustomInfoText, strmat)
9 Z0 O2 e0 Q6 cblnretval = Part.AddCustomInfo3("", "單重", swCustomInfoText, " ")
% i8 g& r% N6 a& a/ Z# s5 z  V; G2 e# V. L; H; {2 wblnretval = Part.AddCustomInfo3("", "備註", swCustomInfoText, " ")
; y0 U* J& T4 O" ]. ^) u9 b$ j: i2 D6 }7 z- @1 t: i# Q, P, {! f% c" J- {6 u; t
End Sub
1 G$ ^' E+ }9 i- k$ k0 n
, }- p2 y; J% I  l( Z) F

ryouss

arter_2006 發表于 2018-11-26 17:27
# m& G3 N% h; y% n: P能否把您的SWP文件發上來，我剛才用solidworks 2014也試了一下，發現也不行，但是別的宏都可以。
: Z1 t3 D& v# U  ?+ n7 M7 ~我從網 ...

附swp繁體版   

ryouss

試試把   CurCFGname = swApp.GetConfigurationNames
7 G& @- B; o* ]% _8 C; y
7 g" |' M! E& S- _( h改為      CurCFGname = swApp.GetConfigurationNames(swApp.ActiveDoc.GetPathName) '補加零件文件的路徑及名稱

在沒補加 (swApp.ActiveDoc.GetPathName) 時在2012及2015版是會有提示錯誤的(如附圖)
另VBA編程在   " '  " 符號后的文字是會跳過不執行的.
& X. y) s. w6 K' W% y( H: D$ ?

8 S# ]( l) V0 P8 ]* R1 X

arter_2006

我試過了，改之前，改之后一個樣，而且執行中沒有任何錯誤提示。
) \' C0 l# w) j8 w  m' ******************************************************************************
' C:\Users\admin\AppData\Local\Temp\swx8144\Macro1.swb - macro recorded on 11/22/18 by mqlu
: p, y6 B2 J! C' ******************************************************************************
Dim swApp As Object
7 ^1 I; h8 u; Z- sDim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
6 i6 {  W# u1 v, Y- ?  O
% f. x, C& ?4 P) p" nDim SelMgr As Object
. V$ b2 d( c) o) b/ l) T* g2 F* U: HDim Feature As Object
Dim a As Integer
Dim b As String
Dim m As String
6 Q: A8 {7 {, eDim e As String
Dim k As String
Dim t As String
Dim c As String
0 P  ]6 Q* n- @9 o$ eDim j As Integer
5 m6 X  y+ s9 Y8 f7 `6 eDim strmat As String
; I1 O3 n* n; P% T' b2 RDim tempvalue As String
) h5 c' ^0 x7 A$ w5 ~
Sub main() '刪除所有配置屬性
# \$ f% \, I! x( J) Y0 B4 uSet swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
% q7 W. n: Y. h% D2 n: Z* q! e5 `5 ~CurCFGname = swApp.GetConfigurationNames(swApp.ActiveDoc.GetPathName) '補加零件文件的路徑及名稱
/ j/ F3 t: |1 G5 N4 zCurCFGnameCount = Part.GetConfigurationCount
: S) Q, j, B% OFor i = 0 To CurCFGnameCount - 1
    Set CusPropMgr = Part.Extension.CustomPropertyManager(CurCFGname(i))
7 z) i4 C( G' u8 M3 n% K7 H# L    Vnamearr = CusPropMgr.GetNames
    If Not IsEmpty(Vnamearr) Then
        For Each Vnamearr2 In Vnamearr
; G8 q. \& t$ V            bRet = Part.DeleteCustomInfo2(CurCFGname(i), Vnamearr2)
* v) ^3 o9 ]6 n$ d+ @        Next
7 H1 y/ A* V. m& R/ Q+ Y    End If
) H8 D7 ~8 i- q' }. L2 |Next
Call 刪除自定義屬性
Call partitionTM
8 u% v8 `' v# `( g' G7 C, S
End Sub

' f* Q) X( S# F- `& T9 w, p5 H$ z'~~~ 刪除自定義屬性 ~~~
6 D, M9 q. a+ }. g; m- _) ASub 刪除自定義屬性()
2 `# s% N# n, e3 y. ]8 b+ G'Dim swApp As Object
Dim swModel2 As SldWorks.ModelDoc2
( k3 F$ B  m% v, T9 X+ K' y; L* DDim vCustInfoNameArr2 As Variant

Set swApp = Application.SldWorks
Set swModel2 = swApp.ActiveDoc
8 x9 e; W) k7 @* f' B+ n, w9 q. xvCustInfoNameArr2 = swModel2.GetCustomInfoNames
  If Not IsEmpty(vCustInfoNameArr2) Then
     For Each vCustInfoName2 In vCustInfoNameArr2
1 s3 U7 ~7 J& n( T6 ?8 O         bRet = swModel2.DeleteCustomInfo(vCustInfoName2)
; V: f) V) x4 p% }8 S      Next
- f1 _+ V. s' e% o! R) v, }2 t& S  End If
End Sub
& }' }$ P' a( v+ S7 m$ }% h0 n
'~~~ partitionTM ~~~
Sub partitionTM() 'partitionTM
/ i# u4 c+ k$ H$ ?: r
5 R) s/ s( ~8 E7 N% Q3 V'link solidworks
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
! f: D+ C$ R1 D4 j. q1 m* fSet SelMgr = Part.SelectionManager
: Q- X; R% ~4 G+ g* pswApp.ActiveDoc.ActiveView.FrameState = 1
'設定變量
c = swApp.ActiveDoc.GetTitle() '零件名
; v) y' h5 @. N, P0 k8 astrmat = Chr(34) + Trim("SW-Material" + "@") + c + Chr(34)
; y$ p& g) u* d' N, b$ Z'tempvalue = Part.CustomInfo2("", "材料")
blnretval = Part.DeleteCustomInfo2("", "代號")
blnretval = Part.DeleteCustomInfo2("", "名稱")
blnretval = Part.DeleteCustomInfo2("", "材料")

1 X4 ~7 P2 [  b" y
a = InStr(c, " ") - 1
: k% I% u5 s. n- C; d( ?If a > 0 Then
$ ?: G6 I* q8 `+ z' |    k = Left(c, a)
+ D9 O2 |5 j, n! h; m- R/ U    t = Left(LTrim(e), 3)
* p! x. Z2 V* f, s, p
: H5 C5 X, m3 e    If t = "GBT" Then
        e = "GB/T" + Mid(k, 4)
    Else
        e = k
. H7 T  f1 K* Q6 ^    End If

    b = Mid(c, a + 2)
    t = Right(c, 7)
/ c4 W3 T4 Z6 C# f" d    If t = ".SLDPRT" Or t = ".SLDASM" Then
        j = Len(b) - 7
    Else
$ C0 j/ d2 a5 P        j = Len(b)
1 w9 ~/ G- e0 Q    End If
1 H: ^$ h7 L  ]9 G- B# j/ V# y    m = Left(b, j)
6 l. B$ a" J8 O$ j/ d. J# x+ B, L5 wEnd If
" x, R& X" l% {4 j3 O: }
blnretval = Part.AddCustomInfo3("", "代號", swCustomInfoText, e)
blnretval = Part.AddCustomInfo3("", "名稱", swCustomInfoText, m)
blnretval = Part.AddCustomInfo3("", "材料", swCustomInfoText, strmat)
blnretval = Part.AddCustomInfo3("", "單重", swCustomInfoText, " ")
blnretval = Part.AddCustomInfo3("", "備注", swCustomInfoText, " ")
7 H# E3 b7 _  v# L% p9 F
End Sub