SOLIDWORKS 宏合并执行的问题

ryouss

就是如下的繁体字改為簡体字就是
8 h' a, K- `  b4 t8 q0 ~: d2 D

) A2 O$ J  V' {

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
   
5. Dim Part As Object
   ! X$ ]4 P1 K* L" C( F9 c& h5 p
6. Dim boolstatus As Boolean
   ( P5 O: A& q9 K. j; ?+ |2 C' P" m
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
    1 L  v7 `: n5 Q( F0 H% N
13. Dim m As String
    ) z7 Y0 t: w$ W6 g2 P% s
14. Dim e As String
    
15. Dim k As String
    1 ]) Z+ I; x7 n% b. v( r% D
16. Dim t As String
    ( [% e4 i& S' J5 {6 O# l
17. Dim c As String
    
18. Dim j As Integer
    8 {" I: _) {* K% p
19. Dim strmat As String
    
20. Dim tempvalue As String
    , M* C8 F4 _5 q( y
21. 
    
22. Sub main() '刪除所有配置屬性
    
23. Set swApp = Application.SldWorks
    $ `! Y. Q2 ], X; v
24. Set Part = swApp.ActiveDoc
    
25. CurCFGname = Part.GetConfigurationNames
    6 i, j; ?. D* K+ ~3 S
26. CurCFGnameCount = Part.GetConfigurationCount
    
27. For i = 0 To CurCFGnameCount - 1
    ) }" h$ ?' J- d) N' `
28.     Set CusPropMgr = Part.Extension.CustomPropertyManager(CurCFGname(i))
    
29.     Vnamearr = CusPropMgr.GetNames
    ' F7 w9 H0 M. B" e, z  c' t
30.     If Not IsEmpty(Vnamearr) Then
    
31.         For Each Vnamearr2 In Vnamearr
    
32.             bRet = Part.DeleteCustomInfo2(CurCFGname(i), Vnamearr2)
    
33.         Next
    * R: `. {. @, I, Z) h
34.     End If
    - ]' w5 V- P/ [3 V. s5 F' D4 w) C; q
35. Next
    
36. Call 刪除自定義屬性
    7 d6 Y! H5 `5 {& v
37. Call partitionTM
    
38. 
    
39. End Sub
    * P; a. L" s6 Q# m% d
40. 
    
41. '~~~ 刪除自定義屬性 ~~~
    
42. Sub 刪除自定義屬性()
    
43. 'Dim swApp As Object
    
44. Dim swModel2 As SldWorks.ModelDoc2
    9 \2 V& o, P- j6 y
45. Dim vCustInfoNameArr2 As Variant
    
46. 
    
47. Set swApp = Application.SldWorks
    . B) r$ A9 e( k8 m0 I5 D
48. Set swModel2 = swApp.ActiveDoc
    
49. vCustInfoNameArr2 = swModel2.GetCustomInfoNames
    0 g+ Q$ M" e0 `, O* a
50.   If Not IsEmpty(vCustInfoNameArr2) Then
    
51.      For Each vCustInfoName2 In vCustInfoNameArr2
    - D' P: Z, X8 V6 v+ w0 }  O
52.          bRet = swModel2.DeleteCustomInfo(vCustInfoName2)
    
53.       Next
    
54.   End If
    ' b) i# y5 z9 E+ _, N
55. End Sub
    7 B7 `. Y! H. n6 A1 Q
56. 
    ! ]$ \& @4 \& l
57. '~~~ partitionTM ~~~
    
58. Sub partitionTM() 'partitionTM
    
59. 
    
60. 'link solidworks
    
61. Set swApp = Application.SldWorks
    " ]! F; n. @  z
62. Set Part = swApp.ActiveDoc
    0 W) n7 h1 m" z
63. Set SelMgr = Part.SelectionManager
    7 ?3 b; s. N. J& |, f% Q, H
64. swApp.ActiveDoc.ActiveView.FrameState = 1
    ) F- f' O! N, v
65. '設定變量
    & O( M" Q( J+ \$ L+ i
66. c = swApp.ActiveDoc.GetTitle() '零件名
    % Z2 o- ?4 U. W
67. strmat = Chr(34) + Trim("SW-Material" + "@") + c + Chr(34)
    & `- V) Q6 W+ L7 H4 S/ E+ W
68. 'tempvalue = Part.CustomInfo2("", "材料")
    . M2 n: n1 r5 _8 `' j9 v  i8 d
69. blnretval = Part.DeleteCustomInfo2("", "代號")
    
70. blnretval = Part.DeleteCustomInfo2("", "名稱")
    
71. blnretval = Part.DeleteCustomInfo2("", "材料")
    
72. a = InStr(c, " ") - 1
    ) u$ E, S% v3 C4 \; S0 w- a& J0 A
73. If a > 0 Then
    
74.     k = Left(c, a)
    * Z0 F: U5 f5 `% R' [
75.     t = Left(LTrim(e), 3)
    & ^# ~: h! u  b: C) ?
76.     If t = "GBT" Then
    6 a/ _) b' B! ^- b1 d
77.         e = "GB/T" + Mid(k, 4)
    ' K6 n" V; d& w% _5 U, J5 G
78.     Else
    
79.         e = k
    
80.     End If
    7 I! a& \/ a/ o+ g) P
81.     b = Mid(c, a + 2)
    
82.     t = Right(c, 7)
    9 p" E' D. e- S0 k
83.     If t = ".SLDPRT" Or t = ".SLDASM" Then
    3 {3 V. C1 S3 e' Z( Z' |! i
84.         j = Len(b) - 7
    
85.     Else
    
86.         j = Len(b)
    
87.     End If
    
88.     m = Left(b, j)
    
89. End If
    6 s3 m+ i( K' A" @& k# q- ?, b
90. blnretval = Part.AddCustomInfo3("", "代號", swCustomInfoText, e)
    9 {& I  I# s2 X3 P' f7 o% Y: G
91. blnretval = Part.AddCustomInfo3("", "名稱", swCustomInfoText, m)
      P5 ]1 B0 P4 N' P  U/ u+ n
92. blnretval = Part.AddCustomInfo3("", "材料", swCustomInfoText, strmat)
    
93. blnretval = Part.AddCustomInfo3("", "單重", swCustomInfoText, " ")
    ) i. H. F1 W! [6 e, a5 D: M% Y
94. blnretval = Part.AddCustomInfo3("", "備註", swCustomInfoText, " ")
    " y$ m  q9 A0 H$ _" @7 J- T  C
95. 
    
96. End Sub

复制代码

% `, R0 s+ Y8 ]* I
4 e$ W% G6 s3 ?

arter_2006

ryouss 发表于 2018-11-25 11:32
就是如下的繁体字改為簡体字就是

( Q. _5 |) }. m2 P5 \/ W0 v3 T& h执行后无反应，属性都没改，不知道问题出在哪里？让您费心了。
5 _/ X, M! H' k, w
8 j( e( N- u' d' ******************************************************************************
' C:\Users\admin\AppData\Local\Temp\swx8144\Macro1.swb - macro recorded on 11/22/18 by mqlu
- k  j! E5 w8 r, ^7 N2 N7 C! N5 O' ******************************************************************************
Dim swApp As Object
* M; d" G; C4 H8 g5 t9 YDim Part As Object
1 l* @! Y0 Q* [+ wDim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long

Dim SelMgr As Object
% O$ W: [7 w$ Y/ ~: EDim Feature As Object
( u% A  n3 o. M3 l/ pDim a As Integer
Dim b As String
: u8 ~- B# S" a1 o; QDim m As String
Dim e As String
8 h6 t3 o: g- d2 W  _; FDim k As String
Dim t As String
Dim c As String
0 Q0 Z9 E. U" i2 q1 lDim j As Integer
Dim strmat As String
6 `% q( u' o5 y$ V3 vDim tempvalue As String
" }: }" O  }9 X- Y
7 Q) J) p8 N4 T/ M; oSub main() '刪除所有配置属性
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
CurCFGname = Part.GetConfigurationNames
CurCFGnameCount = Part.GetConfigurationCount
For i = 0 To CurCFGnameCount - 1
9 g" D; h3 s0 Z( }/ {    Set CusPropMgr = Part.Extension.CustomPropertyManager(CurCFGname(i))
/ r! a: s6 S. R4 R( W    Vnamearr = CusPropMgr.GetNames
0 l6 p' i# A2 `    If Not IsEmpty(Vnamearr) Then
        For Each Vnamearr2 In Vnamearr
3 o1 t! I" s5 d            bRet = Part.DeleteCustomInfo2(CurCFGname(i), Vnamearr2)
0 {8 X  F% P: z: C+ W# j. L        Next
    End If
4 O; a5 f' d5 p: J5 S( j% q% kNext
) z$ F, Q. X) |Call 刪除自定义属性
3 A3 N+ ?7 `: y4 d# I8 p8 C* z  @7 eCall partitionTM

End Sub

- ~4 ~+ W5 W+ o+ t( L+ w'~~~ 刪除自定义属性 ~~~
. m# V% J: n) VSub 刪除自定义属性()
'Dim swApp As Object
* d9 A4 l  E2 r) w& B' yDim swModel2 As SldWorks.ModelDoc2
Dim vCustInfoNameArr2 As Variant
# n/ n0 C0 ~5 D+ Q( d5 H+ F: \
+ ]' i- j3 e/ E' H( HSet swApp = Application.SldWorks
Set swModel2 = swApp.ActiveDoc
vCustInfoNameArr2 = swModel2.GetCustomInfoNames
: _+ K# W+ `6 z, g. O6 x1 }& [  If Not IsEmpty(vCustInfoNameArr2) Then
     For Each vCustInfoName2 In vCustInfoNameArr2
& w  V& v# n* s8 z         bRet = swModel2.DeleteCustomInfo(vCustInfoName2)
      Next
  End If
; F. b! o  H" s7 [End Sub
- x0 c6 m( }  I
  U! @; e* J5 e+ a# r2 J'~~~ partitionTM ~~~
Sub partitionTM() 'partitionTM

'link solidworks
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
Set SelMgr = Part.SelectionManager
. l$ f; M2 G6 [+ I; [9 J/ _swApp.ActiveDoc.ActiveView.FrameState = 1
'设定变量
6 o7 [+ }3 u( y+ Q9 W8 e; a5 {c = swApp.ActiveDoc.GetTitle() '零件名
( ]/ [/ l5 _5 H; x) wstrmat = Chr(34) + Trim("SW-Material" + "@") + c + Chr(34)
0 P& r, u2 Z! M1 _3 R'tempvalue = Part.CustomInfo2("", "材料")
blnretval = Part.DeleteCustomInfo2("", "代号")
blnretval = Part.DeleteCustomInfo2("", "名称")
blnretval = Part.DeleteCustomInfo2("", "材料")
: n( e" F. b  la = InStr(c, " ") - 1
& a' f+ X$ d5 g5 i- R0 }If a > 0 Then
    k = Left(c, a)
    t = Left(LTrim(e), 3)
/ ]& _: M( S% v. j* \    If t = "GBT" Then
        e = "GB/T" + Mid(k, 4)
    Else
4 F: J. [$ a9 x& U) ?        e = k
6 q  {6 [+ c0 z, ^! a: B! p    End If
+ ?& A: U' r. i5 g% P) p3 Z! I    b = Mid(c, a + 2)
2 q( L  Q, x  ]. w! N    t = Right(c, 7)
    If t = ".SLDPRT" Or t = ".SLDASM" Then
6 k: K9 Y1 Y- U4 b5 `% \, D( J        j = Len(b) - 7
    Else
! O8 V+ L1 V" A! G        j = Len(b)
2 x: v8 I& L3 F* L0 q7 {    End If
  [2 R2 `' C' l2 m+ ^    m = Left(b, j)
End If
blnretval = Part.AddCustomInfo3("", "代号", swCustomInfoText, e)
blnretval = Part.AddCustomInfo3("", "名称", swCustomInfoText, m)
) Y: U( z. f* a" B  l# L$ nblnretval = Part.AddCustomInfo3("", "材料", swCustomInfoText, strmat)
blnretval = Part.AddCustomInfo3("", "单重", swCustomInfoText, " ")
1 g& g& F+ C: c7 K3 Ublnretval = Part.AddCustomInfo3("", "备注", swCustomInfoText, " ")
) p" n% {2 q" W% e8 e0 D
End Sub

ryouss

" W& F, ~0 ^" j1 s

arter_2006 发表于 2018-11-26 15:11
执行后无反应，属性都没改，不知道问题出在哪里？让您费心了。
/ V$ O$ [$ p* ?: p
  g5 R& E$ L, c  H" Q( L' ********************************** ...

* Y  W2 {4 C4 X* e3 U  G" E# Wsw2017 測試OK
: F- V+ S$ \0 K* M" y+ u有否顯示什麼錯誤提示?
. s4 g* I) {( ]; y1 p

$ k% F+ |7 E# V6 t( x. G9 M  H

arter_2006

我的是Solidworks 2018，看来可能是版本的问题了

ryouss

arter_2006 发表于 2018-11-26 17:00
. Q0 m, p7 x6 }2 U我的是Solidworks 2018，看来可能是版本的问题了

6 h& ?& ?! z1 `- J% F9 q& X) n2018 沒版本能試
, Y8 ?6 W# c7 W( @

arter_2006

ryouss 发表于 2018-11-26 17:05
5 I& V' t9 o: `, X9 {3 n# D; k. l2018 沒版本能試

非常感谢您，让您费心了。

arter_2006

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

能否把您的SWP文件发上来，我刚才用solidworks 2014也试了一下，发现也不行，但是别的宏都可以。
我从网页上复制下来的都变成下面这个样子了，所以要删掉很多多出来的东西，我怀疑是不是这个原因导致的，但是校对很费时间，也难发现。
' M6 H, `! I, N7 n0 C
' ******************************************************************************3 \3 X) J3 n, I6 @4 |0 x
4 G$ T( Q& ?: n" a4 ^' 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
Dim boolstatus As Boolean- I8 s/ Y$ i' W. N0 _
0 t2 j6 B3 _0 VDim longstatus As Long, longwarnings As Long
! \6 I. l) C' W1 W8 u' q( \3 d4 Y/ K1 v" N; D
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
! D% G9 I+ w, `% L. B( Y7 s$ z: N6 b! v  l! SDim a As Integer
( V" X* A; L; `- V/ a" [- G8 h. O. ^& 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+ _
Dim t As String
/ {  I' N/ v9 [6 C8 R4 u% 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
6 ?: `& h) i0 D9 |Dim strmat As String
" F! d7 t6 p- DDim tempvalue As String
3 C( Y, \( {" ]" s" Z5 m" [- q& E& r" D5 F  G0 |% Q: b, Y
% t& t# a, b! p+ m- 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
) l* f6 Q  V  r: F& g+ U* jSet Part = swApp.ActiveDoc$ q6 |& ^2 b7 ~/ ]( ^0 R
CurCFGname = Part.GetConfigurationNames
/ ]$ P' W& v0 q' }1 c9 \4 p! c- [5 v: x. U8 U( V* kCurCFGnameCount = Part.GetConfigurationCount
  c: h/ H; m8 a  j" 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
! `' A7 e% l9 f3 q! @: m        For Each Vnamearr2 In Vnamearr
9 B+ a# \$ v* c! u# A1 d& T- 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
) T+ W) r: `2 {7 H! l( `, d% q1 c    End If
8 J$ h+ |$ D+ R3 N2 {$ A3 @6 S" n' d2 eNext
  k" k4 f; K$ vCall 刪除自定義屬性
$ R& N+ W4 Y; g8 l" C6 G+ m; K4 N( A- x) f" C" d8 G6 }) {# {' iCall partitionTM4 }2 o$ e' E7 t
. ]- p. U5 s& ^0 E4 x
2 @8 q. ~" b  {% q" `4 h6 {End Sub
% e; G6 r) ]# @' p
. _. T# i5 F' `! G/ k9 x" D7 r# [' m2 U5 Z7 k9 B. O: ?'~~~ 刪除自定義屬性 ~~~
2 Y! T3 f1 O. ~: Q6 `! G2 u. ]" |4 i. ?Sub 刪除自定義屬性()
  B# r$ |5 d2 b. o4 x5 W" n+ J'Dim swApp As Object2 Q# s7 O1 ~+ I" }
+ Q* s* S- h5 ?3 F0 cDim swModel2 As SldWorks.ModelDoc2
0 P, B, ]/ @' U- V4 b! f' g# o6 S, e, W4 z+ EDim vCustInfoNameArr2 As Variant7 J* i  U% A! t0 \0 D! h, V
# J6 P0 X2 R- _
- 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 {
vCustInfoNameArr2 = swModel2.GetCustomInfoNames- N/ C9 m0 n2 t* k9 u
  If Not IsEmpty(vCustInfoNameArr2) Then
& a& O9 t& j% N4 J/ H; D% t! V# Z5 s; g8 P9 J( v  m% Z     For Each vCustInfoName2 In vCustInfoNameArr2- \% O7 w% [: r; T3 |5 M
         bRet = swModel2.DeleteCustomInfo(vCustInfoName2)
3 e! r; f- Y8 b& A1 m( [. ?" R/ r# I! y' x7 _' X      Next9 U+ R% V2 G# P
7 r" g- ]2 w4 V3 m9 i! {- p) m  End If
4 b# m4 f: G6 A  S4 M+ G: s& 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
' t# V+ w! z2 @# o3 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
  i) d, }" |. l8 l* g0 @7 Y' k4 cSet Part = swApp.ActiveDoc
0 S* I$ s+ _4 U) 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
'設定變量& }. N& d* J$ W) S
c = swApp.ActiveDoc.GetTitle() '零件名
' W6 }, n$ y; n+ L: S: y5 s. {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("", "材料")
+ 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
" q) d0 X/ D0 }! ]% }8 ?* ]    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
: ?9 j% k8 ?9 r# b* I' E    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
1 M8 Y+ w! Q, J7 {: H    b = Mid(c, a + 2)
) B7 R6 ?" H/ X1 H0 {1 a, _" o% b/ ^0 j8 S  T    t = Right(c, 7)
9 e5 H8 ?5 q# G* [$ R/ J( 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' \
) [8 X( A0 p& A    Else& f9 y# D- W/ Y! i& w- H
        j = Len(b); J( ?# E, |  ?
    End If8 @/ x5 s, N; \. _& V# V
" ^2 W' h4 Z$ j4 o& k    m = Left(b, j)
7 f$ Z! t! b" `4 Q- |; d. P: e' A' P) l4 b& \End If( o3 u- a' n" g; c4 t2 s& ]
blnretval = Part.AddCustomInfo3("", "代號", swCustomInfoText, e)
$ h% D2 x+ {0 ^9 _2 e: F  K  N' M% L5 C4 Hblnretval = Part.AddCustomInfo3("", "名稱", swCustomInfoText, m)7 a/ m( J8 q$ B) ^& B( M# Q' V
8 |! [6 x/ w6 B5 D, `( tblnretval = Part.AddCustomInfo3("", "材料", swCustomInfoText, strmat)
. s+ T* q2 n2 T7 @1 H9 Z0 O2 e0 Q6 cblnretval = Part.AddCustomInfo3("", "單重", swCustomInfoText, " ")
  S8 c* O7 L5 f4 j0 o  V; G2 e# V. L; H; {2 wblnretval = Part.AddCustomInfo3("", "備註", swCustomInfoText, " ")
: i2 D6 }7 z- @1 t: i# Q, P, {! f% c" J- {6 u; t
End Sub
* p! g" H, T0 t& o/ l: X- K

ryouss

arter_2006 发表于 2018-11-26 17:27
能否把您的SWP文件发上来，我刚才用solidworks 2014也试了一下，发现也不行，但是别的宏都可以。
8 F: f# o; \+ d" }: |# j3 t我从网 ...

: o9 D+ g: N$ U附swp繁体版   

ryouss

# T0 x7 n! }# g! P9 v
試試把   CurCFGname = swApp.GetConfigurationNames

3 [$ N+ u# ]$ @% ^, P' e改為      CurCFGname = swApp.GetConfigurationNames(swApp.ActiveDoc.GetPathName) '補加零件文件的路徑及名稱

* ~# j. n# N! K2 W+ O5 [! b在沒補加 (swApp.ActiveDoc.GetPathName) 時在2012及2015版是會有提示錯誤的(如附图)
' _* a9 g- H% A6 b; @另VBA編程在   " '  " 符號后的文字是會跳過不執行的.
1 ]$ x- R+ M% a( h5 C! a' Z& {

' t9 d1 n6 b! K8 b( \
/ `: |$ F4 p2 F& C: v4 M

arter_2006

我试过了，改之前，改之后一个样，而且执行中没有任何错误提示。
' ******************************************************************************
! s1 y7 s# }% E: r8 P, w% |' C:\Users\admin\AppData\Local\Temp\swx8144\Macro1.swb - macro recorded on 11/22/18 by mqlu
' ******************************************************************************
Dim swApp As Object
& `/ W* T3 N# K. O% MDim Part As Object
6 E" X& e+ t5 P, @5 hDim boolstatus As Boolean
7 J8 |+ e8 b4 @9 R, w% {+ n1 l9 iDim longstatus As Long, longwarnings As Long
. z1 B$ ^- E1 ~% @
Dim SelMgr As Object
2 H; t3 g- D. i% s6 r% b" W) JDim Feature As Object
3 ~2 P% g, T7 bDim a As Integer
Dim b As String
Dim m As String
Dim e As String
' ^6 V2 _9 d! V( u% b+ f. oDim k As String
- d1 x. H+ l; a4 b2 XDim t As String
$ G7 n0 Y/ Y6 v/ w4 W' z1 f3 y8 yDim c As String
- Z/ c1 P8 G; H$ J9 V" }. nDim j As Integer
Dim strmat As String
Dim tempvalue As String
2 v5 p+ p8 x; i/ M, V
Sub main() '刪除所有配置属性
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
CurCFGname = swApp.GetConfigurationNames(swApp.ActiveDoc.GetPathName) '补加零件文件的路径及名称
CurCFGnameCount = Part.GetConfigurationCount
For i = 0 To CurCFGnameCount - 1
    Set CusPropMgr = Part.Extension.CustomPropertyManager(CurCFGname(i))
% l2 J' V+ T1 G/ ?5 V' b/ p, n- z6 ^    Vnamearr = CusPropMgr.GetNames
2 R' `4 O; P% S* ^    If Not IsEmpty(Vnamearr) Then
        For Each Vnamearr2 In Vnamearr
) n  E5 q) u2 X* U' Q: D. X4 j* ?            bRet = Part.DeleteCustomInfo2(CurCFGname(i), Vnamearr2)
9 T4 a; E" i# T) C6 s        Next
7 Z( g$ w! Y9 B6 _: s, b. E+ _7 f    End If
Next
0 l, ^9 e% h# W1 I8 c6 ~' TCall 刪除自定义属性
, O% \1 X# k" _* a0 o6 q1 ^Call partitionTM

- T. H4 ?1 t1 @! {8 s" fEnd Sub
- \, c, Q7 f! e$ B/ @/ m. [
3 z, R8 v3 s$ e! v5 L'~~~ 刪除自定义属性 ~~~
# x2 {7 Y# P2 USub 刪除自定义属性()
'Dim swApp As Object
Dim swModel2 As SldWorks.ModelDoc2
# T; f" F" S/ T/ l, U6 J0 pDim vCustInfoNameArr2 As Variant
5 j5 X1 K. D4 Y
Set swApp = Application.SldWorks
9 v& w, d' i+ L# v  t* HSet swModel2 = swApp.ActiveDoc
vCustInfoNameArr2 = swModel2.GetCustomInfoNames
  If Not IsEmpty(vCustInfoNameArr2) Then
/ A% m$ f# M* C  {8 H- ~     For Each vCustInfoName2 In vCustInfoNameArr2
         bRet = swModel2.DeleteCustomInfo(vCustInfoName2)
/ b8 X+ K) q; U( K, Y' k      Next
) |% n# D2 K* v; j* i" P. |5 M3 _5 W  End If
End Sub
" A6 n" g# r( c" B
'~~~ partitionTM ~~~
Sub partitionTM() 'partitionTM

'link solidworks
# m1 U: ]  I; L; e7 n5 ESet swApp = Application.SldWorks
8 c+ r' k4 @. ]' C. G% YSet Part = swApp.ActiveDoc
Set SelMgr = Part.SelectionManager
swApp.ActiveDoc.ActiveView.FrameState = 1
'设定变量
c = swApp.ActiveDoc.GetTitle() '零件名
$ W* ~. z; R0 Q/ c% Tstrmat = Chr(34) + Trim("SW-Material" + "@") + c + Chr(34)
- A; G, [- C' ^& I5 z'tempvalue = Part.CustomInfo2("", "材料")
; ], x8 y% |9 [: R4 o: q9 hblnretval = Part.DeleteCustomInfo2("", "代号")
8 U1 Q. n1 t* B2 T. E' ]blnretval = Part.DeleteCustomInfo2("", "名称")
7 H. A- t: c) s0 \  q$ D9 iblnretval = Part.DeleteCustomInfo2("", "材料")


& n4 I3 O6 `; {! s. N! `8 {a = InStr(c, " ") - 1
& A' B8 O7 j) S+ v9 j8 |If a > 0 Then
    k = Left(c, a)
    t = Left(LTrim(e), 3)
$ L  t8 p3 d; F1 n4 t! W
    If t = "GBT" Then
        e = "GB/T" + Mid(k, 4)
    Else
        e = k
    End If

    b = Mid(c, a + 2)
5 i: F/ s) i' P- ^    t = Right(c, 7)
9 R& s# w4 q7 m3 p1 M$ ]4 }2 k    If t = ".SLDPRT" Or t = ".SLDASM" Then
& C2 c. ^% Z% o8 U' k1 c* Z        j = Len(b) - 7
    Else
        j = Len(b)
& a( T4 m2 h2 {6 x" c) x1 Q    End If
; c, Z4 N1 Y; r    m = Left(b, j)
% I; N. v3 d' j( _* wEnd If

. I1 i- u* O6 o7 L8 `5 Ublnretval = Part.AddCustomInfo3("", "代号", swCustomInfoText, e)
blnretval = Part.AddCustomInfo3("", "名称", swCustomInfoText, m)
blnretval = Part.AddCustomInfo3("", "材料", swCustomInfoText, strmat)
/ c5 Z9 F5 ?* T3 Q( S4 k& @* W! p+ Qblnretval = Part.AddCustomInfo3("", "单重", swCustomInfoText, " ")
blnretval = Part.AddCustomInfo3("", "备注", swCustomInfoText, " ")
% s4 F) |/ ~  j  Q# ~& @
End Sub