SOLIDWORKS 宏合并執行的問題

ryouss

就是如下的繁體字改為簡體字就是
3 {8 Y. }6 c( C, F" e! x
# h0 [& i! M6 t& u. G1 z

1. ' ******************************************************************************
   ' ]4 o- I# T9 i
2. ' C:\Users\admin\AppData\Local\Temp\swx8144\Macro1.swb - macro recorded on 11/22/18 by mqlu
   
3. ' ******************************************************************************
   
4. Dim swApp As Object
   
5. Dim Part As Object
   + Z* A9 J9 R! T! T  P; k- `+ M
6. Dim boolstatus As Boolean
   7 j: }8 g$ y3 U. K- y! x+ H( S
7. Dim longstatus As Long, longwarnings As Long
   
8. 
   - m9 [. A3 a/ k0 e) W
9. Dim SelMgr As Object
   
10. Dim Feature As Object
    ) N" _6 f$ k2 O+ c3 H! j
11. Dim a As Integer
    
12. Dim b As String
    $ R* _1 G0 ?8 ^, h; Z9 p- y. j
13. Dim m As String
    
14. Dim e As String
    
15. Dim k As String
    
16. Dim t As String
    
17. Dim c As String
    
18. Dim j As Integer
    
19. Dim strmat As String
    
20. Dim tempvalue As String
    . {% a  c) y8 u* S( o1 i# F" c$ o
21. 
    / A# ?, S6 K1 `7 k
22. Sub main() '刪除所有配置屬性
    
23. Set swApp = Application.SldWorks
    
24. Set Part = swApp.ActiveDoc
    
25. CurCFGname = Part.GetConfigurationNames
    0 k2 `* }- P- I9 f' _  K' w; B5 G
26. CurCFGnameCount = Part.GetConfigurationCount
    0 _( U; |3 u7 M( G
27. For i = 0 To CurCFGnameCount - 1
    ) r1 Q+ m4 x) M
28.     Set CusPropMgr = Part.Extension.CustomPropertyManager(CurCFGname(i))
    
29.     Vnamearr = CusPropMgr.GetNames
    
30.     If Not IsEmpty(Vnamearr) Then
    
31.         For Each Vnamearr2 In Vnamearr
    , Y2 E1 n% Z+ R
32.             bRet = Part.DeleteCustomInfo2(CurCFGname(i), Vnamearr2)
    
33.         Next
    . d8 o! m' z, V8 Z8 b5 b7 {. g
34.     End If
    
35. Next
    
36. Call 刪除自定義屬性
    $ q( R4 p) O7 a9 |( i) d
37. Call partitionTM
    
38. 
    0 Y7 o6 X6 U, I6 J; b! i, i
39. End Sub
    6 `/ R: Z* \- @8 h
40. 
    ( K8 |& l  s* A; B3 @' Z
41. '~~~ 刪除自定義屬性 ~~~
    & D. k9 L; g& L
42. Sub 刪除自定義屬性()
    
43. 'Dim swApp As Object
    
44. Dim swModel2 As SldWorks.ModelDoc2
    
45. Dim vCustInfoNameArr2 As Variant
    $ G9 B& k0 U8 S6 n  O9 J
46. 
    & X9 `6 U  u  Y' H1 I& r6 r
47. Set swApp = Application.SldWorks
    7 |4 J8 I, W4 C$ h- G
48. Set swModel2 = swApp.ActiveDoc
    8 e- F+ y  E7 U2 H' e$ J2 L
49. vCustInfoNameArr2 = swModel2.GetCustomInfoNames
    7 I. O5 r# r: W9 C& h% F6 u5 r
50.   If Not IsEmpty(vCustInfoNameArr2) Then
    4 X6 G1 U" C  X) s
51.      For Each vCustInfoName2 In vCustInfoNameArr2
    8 Z, F1 |8 c- b8 K0 J
52.          bRet = swModel2.DeleteCustomInfo(vCustInfoName2)
    
53.       Next
    * U9 o+ d$ i$ V4 S1 }
54.   End If
    5 O0 c! K# N9 v4 D' Q$ F* G
55. End Sub
    
56. 
    
57. '~~~ partitionTM ~~~
    8 K: K8 ]% f, ~9 `% r& }8 {
58. Sub partitionTM() 'partitionTM
    
59. 
    3 d. L& Z( H+ r, f
60. 'link solidworks
    8 g9 R1 Q- I' h$ B
61. Set swApp = Application.SldWorks
    
62. Set Part = swApp.ActiveDoc
    2 y5 H+ J2 X; \% A- N0 K
63. Set SelMgr = Part.SelectionManager
    * E6 ?' p% a1 [; b* y2 d7 X4 |5 R2 g
64. swApp.ActiveDoc.ActiveView.FrameState = 1
    
65. '設定變量
    
66. c = swApp.ActiveDoc.GetTitle() '零件名
    
67. strmat = Chr(34) + Trim("SW-Material" + "@") + c + Chr(34)
    
68. 'tempvalue = Part.CustomInfo2("", "材料")
    # I- s. q( E, s2 e& s4 G
69. blnretval = Part.DeleteCustomInfo2("", "代號")
    
70. blnretval = Part.DeleteCustomInfo2("", "名稱")
    
71. blnretval = Part.DeleteCustomInfo2("", "材料")
    6 N6 O. j' K+ ]4 K
72. a = InStr(c, " ") - 1
    & j; [+ K. [, g  ?
73. If a > 0 Then
    
74.     k = Left(c, a)
    % R# B$ v+ o) c6 R2 U# z+ k
75.     t = Left(LTrim(e), 3)
    . j3 p1 Y$ L; G8 h
76.     If t = "GBT" Then
    3 m; ?9 Y9 s- l/ C
77.         e = "GB/T" + Mid(k, 4)
    , m, B0 o1 ~: V# ?$ L
78.     Else
    ; W* ]( @" B4 `$ q6 X2 @: k9 u
79.         e = k
    
80.     End If
    / V0 I+ F  z% J" @9 n# V
81.     b = Mid(c, a + 2)
    
82.     t = Right(c, 7)
    , ]; U3 x$ z3 `( u2 z9 ~
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)
    
89. End If
    
90. blnretval = Part.AddCustomInfo3("", "代號", swCustomInfoText, e)
    - X" q* ^9 {2 L7 G% B. s$ r& f
91. blnretval = Part.AddCustomInfo3("", "名稱", swCustomInfoText, m)
    / V7 {; s- q0 z( f
92. blnretval = Part.AddCustomInfo3("", "材料", swCustomInfoText, strmat)
    
93. blnretval = Part.AddCustomInfo3("", "單重", swCustomInfoText, " ")
    
94. blnretval = Part.AddCustomInfo3("", "備註", swCustomInfoText, " ")
    ; k9 ]! d) E" m4 p! Y/ N- }$ A" i
95. 
    7 d0 R9 h/ ?1 q5 S7 ^
96. End Sub

復制代碼

1 N2 i3 P. {: v8 A9 ]
- D. a% n3 o& v& `

arter_2006

ryouss 發表于 2018-11-25 11:32
) h, ^( M$ B& J4 W就是如下的繁體字改為簡體字就是

- S6 K# Z, s. {+ L2 W1 [執行后無反應，屬性都沒改，不知道問題出在哪里？讓您費心了。

' ******************************************************************************
' C:\Users\admin\AppData\Local\Temp\swx8144\Macro1.swb - macro recorded on 11/22/18 by mqlu
' ******************************************************************************
Dim swApp As Object
9 d# D9 {. C/ [Dim Part As Object
# V; h, z4 |  L7 |# pDim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
. h3 G  H7 J$ F1 f- H
Dim SelMgr As Object
Dim Feature As Object
Dim a As Integer
Dim b As String
Dim m As String
Dim e As String
Dim k As String
7 W0 Y6 A6 V4 r4 H& p% g0 ?3 [% RDim t As String
Dim c As String
Dim j As Integer
Dim strmat As String
% A% F8 L! Y# V+ Q6 _/ zDim tempvalue As String
3 i3 O( m( Y& w/ h% |: b* A, f
6 G( S! {& Q7 V9 hSub main() '刪除所有配置屬性
8 F0 `' ^% g2 p2 k# T4 J% oSet swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
& Z$ z3 v9 Z; n7 |0 F. aCurCFGname = Part.GetConfigurationNames
CurCFGnameCount = Part.GetConfigurationCount
For i = 0 To CurCFGnameCount - 1
3 A& S+ A/ W' \4 Q& s    Set CusPropMgr = Part.Extension.CustomPropertyManager(CurCFGname(i))
& b" v5 W6 U' p' E' q0 o    Vnamearr = CusPropMgr.GetNames
* L& o( s- f5 o4 |( a" F" r; m    If Not IsEmpty(Vnamearr) Then
0 ^; K4 @( X& s$ L8 }8 X4 U" |: ]        For Each Vnamearr2 In Vnamearr
% M- G# P$ g: J8 c1 q8 p9 \( N            bRet = Part.DeleteCustomInfo2(CurCFGname(i), Vnamearr2)
0 P  t7 _% e, U$ P- E2 W7 ]        Next
1 B' r7 r3 \7 m/ E    End If
  Q0 s- K: \2 ]; Y, HNext
. E- `+ P( d% f$ V, q( T+ m( JCall 刪除自定義屬性
Call partitionTM
7 O3 `2 @( U0 V* S; Z
End Sub
$ g' t8 P% M4 Q* r
'~~~ 刪除自定義屬性 ~~~
4 q9 A/ b+ p+ H/ \0 x9 fSub 刪除自定義屬性()
' \5 j2 y  Z4 X6 @) R8 v. l/ i9 |'Dim swApp As Object
! K7 d# l* D. b" q5 L' k5 cDim swModel2 As SldWorks.ModelDoc2
Dim vCustInfoNameArr2 As Variant
. n- j( J9 a- S; M
Set swApp = Application.SldWorks
Set swModel2 = swApp.ActiveDoc
" o( F7 y% |' B5 M* j- i- KvCustInfoNameArr2 = swModel2.GetCustomInfoNames
# Y9 z( J  H" U  If Not IsEmpty(vCustInfoNameArr2) Then
; ]# W, s5 h2 e     For Each vCustInfoName2 In vCustInfoNameArr2
         bRet = swModel2.DeleteCustomInfo(vCustInfoName2)
      Next
$ z: u# n8 `4 Z1 s8 E$ \; j  End If
9 S# U: b# p( P+ fEnd Sub

'~~~ partitionTM ~~~
1 E9 l7 ?5 j- z7 p8 `9 sSub partitionTM() 'partitionTM
' u0 M. u7 V' O
'link solidworks
Set swApp = Application.SldWorks
9 S% {8 a9 t, s6 {% w, {& L5 X5 @Set Part = swApp.ActiveDoc
Set SelMgr = Part.SelectionManager
swApp.ActiveDoc.ActiveView.FrameState = 1
* j$ v& L( A- g$ q'設定變量
3 |4 S2 b$ I# j$ d: mc = swApp.ActiveDoc.GetTitle() '零件名
& ?: V, L; a* J$ }) q* @7 m" Sstrmat = Chr(34) + Trim("SW-Material" + "@") + c + Chr(34)
  m5 f5 ^7 Q2 H'tempvalue = Part.CustomInfo2("", "材料")
blnretval = Part.DeleteCustomInfo2("", "代號")
blnretval = Part.DeleteCustomInfo2("", "名稱")
blnretval = Part.DeleteCustomInfo2("", "材料")
a = InStr(c, " ") - 1
) a: P+ W6 n, Z/ P* pIf a > 0 Then
  L  G( K& ]# O, G5 M    k = Left(c, a)
    t = Left(LTrim(e), 3)
    If t = "GBT" Then
7 ]: q) F$ y/ b% ?: z/ s- Z" Z        e = "GB/T" + Mid(k, 4)
    Else
6 S+ S% v+ S9 C0 o: Y- j        e = k
7 A# [: Z1 r7 N% b; o# @# _. Q3 K    End If
    b = Mid(c, a + 2)
    t = Right(c, 7)
    If t = ".SLDPRT" Or t = ".SLDASM" Then
        j = Len(b) - 7
    Else
        j = Len(b)
/ w( V! p; p/ w. \- }    End If
2 H8 b! g9 u8 \0 M$ X1 i# G% i# u" Y4 d" \    m = Left(b, j)
6 u3 q- K- ^2 C) v) mEnd If
1 ?$ m8 A+ u8 s" iblnretval = Part.AddCustomInfo3("", "代號", swCustomInfoText, e)
blnretval = Part.AddCustomInfo3("", "名稱", swCustomInfoText, m)
% k) P% U9 m+ Z( z6 sblnretval = Part.AddCustomInfo3("", "材料", swCustomInfoText, strmat)
blnretval = Part.AddCustomInfo3("", "單重", swCustomInfoText, " ")
blnretval = Part.AddCustomInfo3("", "備注", swCustomInfoText, " ")

' f' h3 I  [) k* [7 bEnd Sub
% J* b' P& k: f9 P4 \

ryouss

arter_2006 發表于 2018-11-26 15:11
  E: d! v3 T6 R執行后無反應，屬性都沒改，不知道問題出在哪里？讓您費心了。

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

; i9 X! l- n- p! l5 Bsw2017 測試OK
7 A7 J8 J+ m& @* t有否顯示什麼錯誤提示?


/ Y: r* ?: Q, M
. X  v1 B' ^3 X: y! _/ O
6 j, m4 f" v  h* u) `9 N

arter_2006

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

ryouss

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

2018 沒版本能試

arter_2006

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

非常感謝您，讓您費心了。
$ K2 K' ^' H3 `8 `

arter_2006

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

能否把您的SWP文件發上來，我剛才用solidworks 2014也試了一下，發現也不行，但是別的宏都可以。
我從網頁上復制下來的都變成下面這個樣子了，所以要刪掉很多多出來的東西，我懷疑是不是這個原因導致的，但是校對很費時間，也難發現。
: F# W' B0 D2 K1 v$ ^$ U# X
2 ~* P7 s6 A9 |: p. W) e' ******************************************************************************3 \3 X) J3 n, I6 @4 |0 x
# I) I9 R9 K* }/ K9 ~" r' 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
' ******************************************************************************
: 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
# {. \) ]1 a1 D) z$ t8 Q0 z* |Dim boolstatus As Boolean- I8 s/ Y$ i' W. N0 _
Dim longstatus As Long, longwarnings As Long
# |) J5 E$ W/ x, O1 W8 u' q( \3 d4 Y/ K1 v" N; D
1 X6 f; J- a  I; c* p  v& a: q/ z3 J( R9 \8 _3 m& \) d/ \Dim SelMgr As Object
: S& D4 E8 I: d4 K4 q9 f0 e& f5 HDim Feature As Object
' w1 L+ K8 R7 ~5 `$ t9 Y7 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; `
Dim k As String* ?4 t9 u7 n+ _
0 V/ J$ I5 |8 S3 sDim t As String
; R+ Y7 {/ ^) L3 _- E; z! q3 ^1 ?% 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
# o4 {1 v) z. W( S& f3 KDim strmat As String
" F! d7 t6 p- DDim tempvalue As String
4 ^  d) [% T1 b7 S; b" x1 O& E& r" D5 F  G0 |% Q: b, Y
! H4 ~- N, C: E6 Y7 ]- c/ T- o) ?$ `2 a( G& L5 x7 Q- B3 Z( ISub main() '刪除所有配置屬性
; c8 H3 l/ z* n* R9 KSet swApp = Application.SldWorks9 g. p. p7 K6 u7 ?4 x4 W6 n
Set Part = swApp.ActiveDoc$ q6 |& ^2 b7 ~/ ]( ^0 R
CurCFGname = Part.GetConfigurationNames
- [5 v: x. U8 U( V* kCurCFGnameCount = Part.GetConfigurationCount
5 @' H: f6 B' D2 u; A! K" c- O# J: c, c5 w7 Y0 T. @for i = 0 To CurCFGnameCount - 1& {$ V* E/ x+ ~. V
4 g+ M1 d+ Q2 v9 q/ j  A/ G  b    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
3 G4 w6 r; V0 l# R        For Each Vnamearr2 In Vnamearr
- n8 t& |, B: B/ V9 S4 d, F7 Z            bRet = Part.DeleteCustomInfo2(CurCFGname(i), Vnamearr2)+ h. {$ P6 Q5 M: i
& z7 q& l; H- b1 l7 d        Next- P& E; Z$ s7 V+ a( t' E% T
; U" F0 e1 s) m. i$ U    End If
1 ~( z2 ~* a' M9 N% }) S8 U$ A3 @6 S" n' d2 eNext
; _1 G8 U: P) n! I  k" k4 f; K$ vCall 刪除自定義屬性
; F! _, X/ P; ^. y4 k( A- x) f" C" d8 G6 }) {# {' iCall partitionTM4 }2 o$ e' E7 t
/ x8 O9 W3 f6 |% q: ?) _5 W
2 @8 q. ~" b  {% q" `4 h6 {End Sub
% e; G6 r) ]# @' p
: ?; w, |* S# G0 L- Z" D7 r# [' m2 U5 Z7 k9 B. O: ?'~~~ 刪除自定義屬性 ~~~
1 {& c0 }1 q; ~: Q6 `! G2 u. ]" |4 i. ?Sub 刪除自定義屬性()
: b) R% U/ H1 X% e% A, D  B# r$ |5 d2 b. o4 x5 W" n+ J'Dim swApp As Object2 Q# s7 O1 ~+ I" }
Dim swModel2 As SldWorks.ModelDoc2
! f' g# o6 S, e, W4 z+ EDim vCustInfoNameArr2 As Variant7 J* i  U% A! t0 \0 D! h, V
$ N: D+ l5 G+ O- w  d
- K" x+ X- v- E% b! h6 i* p! ], |9 USet swApp = Application.SldWorks
. o1 [* i# z5 [3 O5 f" m6 Q4 S  i4 [' W6 ]0 I* U0 V' O' B+ NSet swModel2 = swApp.ActiveDoc3 u) Z+ D2 D4 z; M# d4 {
6 g) r- Z! r- e5 ]1 A5 EvCustInfoNameArr2 = swModel2.GetCustomInfoNames- N/ C9 m0 n2 t* k9 u
  If Not IsEmpty(vCustInfoNameArr2) Then
! V# Z5 s; g8 P9 J( v  m% Z     For Each vCustInfoName2 In vCustInfoNameArr2- \% O7 w% [: r; T3 |5 M
         bRet = swModel2.DeleteCustomInfo(vCustInfoName2)
9 V& R- P0 Z0 w3 i8 ]+ J3 N$ ~3 ^. ?" R/ r# I! y' x7 _' X      Next9 U+ R% V2 G# P
  End If
3 O& M. P* u- n: u7 Y/ T: w. l& V, L( M& Q4 l& b0 TEnd Sub
0 l( n5 T3 G0 m# Z% p7 _6 M- K7 `: z' w) T+ c$ V; G
/ j9 |  ?( U5 a+ K'~~~ partitionTM ~~~7 O3 t. l4 R1 [+ ]3 K  G+ M
$ v7 v* n' T, V# R% c) U" c  Q+ XSub partitionTM() 'partitionTM( j# ]! b. Q, G0 M9 E4 f8 B2 J
% l; E) x# ~4 [& t0 {8 [
'link solidworks( C, c- [# N+ Z* [
3 q, |4 D, K. {. zSet swApp = Application.SldWorks+ w1 D3 {4 b7 ^# i5 p4 ~2 p
8 O% F( N, Z, V/ }5 ^! {Set Part = swApp.ActiveDoc
* ~4 l) U* L) y) i! y9 O) k" c8 Y, z+ b# A0 `9 OSet SelMgr = Part.SelectionManager% m# Z: n! Q: I/ M* d( j' c
swApp.ActiveDoc.ActiveView.FrameState = 1& ?6 I  _. Y+ \4 m7 P" c% W/ h
1 x' K6 Q/ C! R$ _: ^'設定變量& }. N& d* J$ W) S
c = swApp.ActiveDoc.GetTitle() '零件名
% [) F, V( g7 ?+ Q3 b+ o. {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("", "材料")
! A+ U4 o! n9 U2 d& 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("", "材料")
: K6 W" v" W, u  J/ M% r+ U) d- F; R- ]4 V0 e- k2 J; Sa = InStr(c, " ") - 1
" v0 S% D. r) K$ `' iIf a > 0 Then
) _% y8 H- s; p1 |0 l1 i" T0 D& _% k+ M" K3 ~    k = Left(c, a)0 D( T  G4 u* @' Z: h# g5 h) k
' k( u- R/ i& [4 u& g5 {    t = Left(LTrim(e), 3)0 |: d+ H% K1 I5 d; ^& r
    If t = "GBT" Then0 a: k4 H  }1 j) y
        e = "GB/T" + Mid(k, 4)0 C& x4 F4 D' ], i* s8 T
; u! Q% w  f1 q+ y    Else
% I# w9 Z' |9 P+ F; g/ ~2 f, c' E2 b! 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
5 h( y1 w# d! X' [+ y8 l( `    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
6 X3 E7 s( J; V  U6 ~9 q( m# n+ r. ]5 p& Q/ I! e        j = Len(b) - 7: f; _- _+ L% W8 E) q2 `; Z9 B' \
    Else& f9 y# D- W/ Y! i& w- H
" I. B2 \$ u& |1 B3 M: b2 w2 t$ H        j = Len(b); J( ?# E, |  ?
    End If8 @/ x5 s, N; \. _& V# V
( ~# b" h  `. h8 F/ R    m = Left(b, j)
$ o5 I/ Y( A! O3 X8 }6 H. P: e' A' P) l4 b& \End If( o3 u- a' n" g; c4 t2 s& ]
: u( D* h, z0 N1 q4 k" l4 S6 @( vblnretval = 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
blnretval = Part.AddCustomInfo3("", "材料", swCustomInfoText, strmat)
6 X. z  k* y$ W0 y! V& M' Z9 Z0 O2 e0 Q6 cblnretval = Part.AddCustomInfo3("", "單重", swCustomInfoText, " ")
4 g; K5 x: a# ^' s9 l- N  V; G2 e# V. L; H; {2 wblnretval = Part.AddCustomInfo3("", "備註", swCustomInfoText, " ")
; l& t  w3 B( g# E( [1 m: i2 D6 }7 z- @1 t: i# Q, P, {! f% c" J- {6 u; t
, z9 X( S* X& a3 [6 \6 IEnd Sub

! o5 U1 p2 x7 V1 G# H

ryouss

arter_2006 發表于 2018-11-26 17:27
1 S. `7 i: N, T4 T  _+ b能否把您的SWP文件發上來，我剛才用solidworks 2014也試了一下，發現也不行，但是別的宏都可以。
8 Z9 P! R5 |: H我從網 ...

* }3 `9 v; r3 m1 \2 L5 u4 k附swp繁體版   
" K' p' W# q4 |& z$ t# y

ryouss

試試把   CurCFGname = swApp.GetConfigurationNames
3 N; P+ n% H" C( {6 c" P/ R
& ?2 m- j" _& e改為      CurCFGname = swApp.GetConfigurationNames(swApp.ActiveDoc.GetPathName) '補加零件文件的路徑及名稱

在沒補加 (swApp.ActiveDoc.GetPathName) 時在2012及2015版是會有提示錯誤的(如附圖)
# Q' k' ^8 z4 m) y7 w另VBA編程在   " '  " 符號后的文字是會跳過不執行的.

3 J1 \2 N$ x+ Y% M1 L
7 W1 n. }7 s: J3 ^0 X

arter_2006

我試過了，改之前，改之后一個樣，而且執行中沒有任何錯誤提示。
9 [: A! ?* t2 r/ {/ Z' ******************************************************************************
& z- i' ?$ u; |0 t/ |0 q/ f0 V' C:\Users\admin\AppData\Local\Temp\swx8144\Macro1.swb - macro recorded on 11/22/18 by mqlu
5 d4 F& u% l2 U, t' ******************************************************************************
) Q# |2 c% {+ ^Dim swApp As Object
Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
4 f& z9 c$ P! u8 m) R
4 M% l: ]2 e/ hDim SelMgr As Object
Dim Feature As Object
Dim a As Integer
Dim b As String
/ g; l" U7 k! K& lDim m As String
Dim e As String
, u4 {6 B" U* x( [0 ]Dim k As String
Dim t As String
Dim c As String
" R; _5 J7 P( Y" Z/ O5 E' vDim j As Integer
" c/ u; J1 J2 A' k& i: V- H0 |Dim strmat As String
Dim tempvalue As String

' w" i* {2 y& ?! GSub main() '刪除所有配置屬性
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
CurCFGname = swApp.GetConfigurationNames(swApp.ActiveDoc.GetPathName) '補加零件文件的路徑及名稱
3 A+ Q3 S) S$ q. _CurCFGnameCount = Part.GetConfigurationCount
- i+ X9 A& U# E! FFor i = 0 To CurCFGnameCount - 1
) S2 T9 N( z; H    Set CusPropMgr = Part.Extension.CustomPropertyManager(CurCFGname(i))
    Vnamearr = CusPropMgr.GetNames
+ A5 p! s# ?5 z! ^    If Not IsEmpty(Vnamearr) Then
6 F. Q% d& q( C        For Each Vnamearr2 In Vnamearr
7 m( H& L0 S; n; D/ o+ L            bRet = Part.DeleteCustomInfo2(CurCFGname(i), Vnamearr2)
        Next
& V+ a8 c1 o, P" w& `* _    End If
Next
Call 刪除自定義屬性
. g5 D2 p+ G% f* z: {Call partitionTM
* o3 r7 O6 T2 r% b$ Q
End Sub
' _' i# h% d" V6 P2 A
'~~~ 刪除自定義屬性 ~~~
Sub 刪除自定義屬性()
'Dim swApp As Object
, k0 g3 M+ M* m% oDim swModel2 As SldWorks.ModelDoc2
+ V' J  Y8 }/ l  cDim vCustInfoNameArr2 As Variant
; N' U8 M' d% T" `3 a$ d5 ?
0 ]1 A; j& f# s6 mSet swApp = Application.SldWorks
8 b# U! B* @4 R% o* {. K- {Set swModel2 = swApp.ActiveDoc
* ]9 _* I( Y/ O% K, K3 YvCustInfoNameArr2 = swModel2.GetCustomInfoNames
  If Not IsEmpty(vCustInfoNameArr2) Then
1 B+ a( D; Y8 Y     For Each vCustInfoName2 In vCustInfoNameArr2
         bRet = swModel2.DeleteCustomInfo(vCustInfoName2)
3 e! q0 I2 a; E0 d  u* `      Next
: t" n2 [- s# ~1 w. H$ n  End If
# {7 h; t' r' Y; H. fEnd Sub
$ k% ?0 V; h+ N( U/ G1 e% U
'~~~ partitionTM ~~~
2 W% j6 P* r) O3 R( c3 v9 t2 uSub partitionTM() 'partitionTM

& U# |% G# @) O: L+ J8 u'link solidworks
Set swApp = Application.SldWorks
$ @1 w/ \# [  c$ S8 BSet Part = swApp.ActiveDoc
! \4 F4 T3 Z# x" C+ kSet SelMgr = Part.SelectionManager
* c+ c$ ]/ J. X" G; GswApp.ActiveDoc.ActiveView.FrameState = 1
'設定變量
c = swApp.ActiveDoc.GetTitle() '零件名
strmat = Chr(34) + Trim("SW-Material" + "@") + c + Chr(34)
'tempvalue = Part.CustomInfo2("", "材料")
% X" U4 r5 B) R1 a4 P) a+ Eblnretval = Part.DeleteCustomInfo2("", "代號")
blnretval = Part.DeleteCustomInfo2("", "名稱")
blnretval = Part.DeleteCustomInfo2("", "材料")


: u/ o2 ~% K8 R& _a = InStr(c, " ") - 1
If a > 0 Then
    k = Left(c, a)
2 D* i5 Q! w, O" N( B) n0 T    t = Left(LTrim(e), 3)
2 Y/ Y  \4 M+ [! i7 X0 p% e
    If t = "GBT" Then
: o. W( p0 |% k; a$ l        e = "GB/T" + Mid(k, 4)
    Else
        e = k
    End If

1 s4 L: D* p; W7 ]    b = Mid(c, a + 2)
; S9 G0 j+ m, H( K8 U* i( D    t = Right(c, 7)
    If t = ".SLDPRT" Or t = ".SLDASM" Then
        j = Len(b) - 7
3 l  y% o# i9 B4 [1 ~+ V" `    Else
        j = Len(b)
; ]1 X8 N- f) U9 ~  H    End If
    m = Left(b, j)
End If
# q' k; B3 v: O
blnretval = Part.AddCustomInfo3("", "代號", swCustomInfoText, e)
5 Q( X5 F4 ?% S6 @; `& ]blnretval = Part.AddCustomInfo3("", "名稱", swCustomInfoText, m)
blnretval = Part.AddCustomInfo3("", "材料", swCustomInfoText, strmat)
9 o" J8 A7 r$ Z: E# V* w% y+ iblnretval = Part.AddCustomInfo3("", "單重", swCustomInfoText, " ")
* o# f+ h0 S. F* `5 v" F2 u: I1 j! xblnretval = Part.AddCustomInfo3("", "備注", swCustomInfoText, " ")
" N2 ]# z2 ^* Y1 ^  m
End Sub