SOLIDWORKS 宏合并执行的问题

ryouss

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

1. ' ******************************************************************************
   
2. ' C:\Users\admin\AppData\Local\Temp\swx8144\Macro1.swb - macro recorded on 11/22/18 by mqlu
   ( X& K% e( c( \$ J1 |! {
3. ' ******************************************************************************
   $ I1 z0 M7 y8 U: x
4. Dim swApp As Object
   
5. Dim Part As Object
   + f# C1 {4 V, T. L
6. Dim boolstatus As Boolean
   ) O; h. s, T1 b, a. b+ @9 e1 b
7. Dim longstatus As Long, longwarnings As Long
   4 C' G. U% W# Y$ j9 e8 P* s8 E
8. 
   
9. Dim SelMgr As Object
   8 ]2 d* B! a/ {* S
10. Dim Feature As Object
    : s2 \- b# w: E
11. Dim a As Integer
    9 ]# _, }/ x5 \' j
12. Dim b As String
    
13. Dim m As String
    
14. Dim e As String
    
15. Dim k As String
    1 E8 P4 g& B; Z! d9 }
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
    1 q2 t3 S+ b4 Z1 B
21. 
    " |' Y* }" J: J0 \2 x
22. Sub main() '刪除所有配置屬性
    & Y. ?, R( r8 p1 w- Y7 S( ]
23. Set swApp = Application.SldWorks
    ( e& w' s, L9 S+ @9 t) Z
24. Set Part = swApp.ActiveDoc
    ) n9 S6 E. D+ M( v
25. CurCFGname = Part.GetConfigurationNames
    - D" y$ h* Z/ |0 b5 [
26. CurCFGnameCount = Part.GetConfigurationCount
    
27. For i = 0 To CurCFGnameCount - 1
    
28.     Set CusPropMgr = Part.Extension.CustomPropertyManager(CurCFGname(i))
    
29.     Vnamearr = CusPropMgr.GetNames
    
30.     If Not IsEmpty(Vnamearr) Then
    3 J! D3 l' b$ T& F
31.         For Each Vnamearr2 In Vnamearr
    
32.             bRet = Part.DeleteCustomInfo2(CurCFGname(i), Vnamearr2)
    $ F( S4 K5 i$ d7 J/ u0 d% Q, Y0 e
33.         Next
    
34.     End If
    " e9 V# y; {3 U2 G
35. Next
    
36. Call 刪除自定義屬性
    - G6 }: I3 W2 u7 X; i: u2 {! I+ S
37. Call partitionTM
    
38. 
    
39. End Sub
    " A1 E0 K. B" w$ y
40. 
    
41. '~~~ 刪除自定義屬性 ~~~
    
42. Sub 刪除自定義屬性()
    2 Z+ g5 n# |6 I  l- z6 d5 {+ k
43. 'Dim swApp As Object
    7 B( w- I0 r5 C. f( |; C
44. Dim swModel2 As SldWorks.ModelDoc2
    
45. Dim vCustInfoNameArr2 As Variant
    - G" t/ q1 U" V0 m- L8 L
46. 
    
47. Set swApp = Application.SldWorks
    
48. Set swModel2 = swApp.ActiveDoc
    5 X- v/ J2 F$ F+ z
49. vCustInfoNameArr2 = swModel2.GetCustomInfoNames
    1 W1 |7 [6 f, d
50.   If Not IsEmpty(vCustInfoNameArr2) Then
    4 E6 y, ]' l2 N! \" k
51.      For Each vCustInfoName2 In vCustInfoNameArr2
    
52.          bRet = swModel2.DeleteCustomInfo(vCustInfoName2)
    
53.       Next
    " }( j9 l# j( b! P
54.   End If
    
55. End Sub
    
56. 
    8 J0 w# R: [' G0 ~! H( m
57. '~~~ partitionTM ~~~
    
58. Sub partitionTM() 'partitionTM
    + c5 G2 T. E- s( X* j& U
59. 
    ! }. q* `* V* x, l
60. 'link solidworks
    ) d4 p# V3 y! U, F( _: r& b. k
61. Set swApp = Application.SldWorks
    
62. Set Part = swApp.ActiveDoc
    5 E: E" F& t, l+ {4 j
63. Set SelMgr = Part.SelectionManager
    
64. swApp.ActiveDoc.ActiveView.FrameState = 1
    
65. '設定變量
    - Q  j. y$ _- h
66. c = swApp.ActiveDoc.GetTitle() '零件名
    
67. strmat = Chr(34) + Trim("SW-Material" + "@") + c + Chr(34)
    & F$ g/ ?1 X1 I' L$ I4 h
68. 'tempvalue = Part.CustomInfo2("", "材料")
    , b% q$ v7 f' E
69. blnretval = Part.DeleteCustomInfo2("", "代號")
    
70. blnretval = Part.DeleteCustomInfo2("", "名稱")
    3 Y+ t. k) B; Z3 i
71. blnretval = Part.DeleteCustomInfo2("", "材料")
    ' _/ K) f" p# U/ w8 f% N( B
72. a = InStr(c, " ") - 1
    
73. If a > 0 Then
    2 R0 Q5 d/ b) g4 S$ A) N' T3 v; j4 g" S
74.     k = Left(c, a)
    
75.     t = Left(LTrim(e), 3)
    
76.     If t = "GBT" Then
    - Q# T% M; |! h( v4 Y- V7 p+ p! U
77.         e = "GB/T" + Mid(k, 4)
    
78.     Else
    - l+ A9 e9 T" F# a% N1 G' w9 a5 A6 G
79.         e = k
    
80.     End If
    & h. V: d" }" D
81.     b = Mid(c, a + 2)
    
82.     t = Right(c, 7)
    2 L' }- d  D9 i9 [) n. d; M
83.     If t = ".SLDPRT" Or t = ".SLDASM" Then
    6 f0 e& _, I( n
84.         j = Len(b) - 7
    
85.     Else
    
86.         j = Len(b)
    
87.     End If
    
88.     m = Left(b, j)
    * R# z' X' ?1 m& l* Z1 i
89. End If
    
90. blnretval = Part.AddCustomInfo3("", "代號", swCustomInfoText, e)
    - E: t% t" [( G& @. h! c2 ~# O
91. blnretval = Part.AddCustomInfo3("", "名稱", swCustomInfoText, m)
    
92. blnretval = Part.AddCustomInfo3("", "材料", swCustomInfoText, strmat)
    0 K0 P) g2 t" P1 @9 f! a
93. blnretval = Part.AddCustomInfo3("", "單重", swCustomInfoText, " ")
    0 _) X3 w3 r4 g. M8 n% T% s
94. blnretval = Part.AddCustomInfo3("", "備註", swCustomInfoText, " ")
    0 P' J% s0 Q# R- d% j% S
95. 
    & P1 {! X9 D& D: K/ ?
96. End Sub

复制代码

$ g3 Z% ?, x) Z2 }" m- e0 Q

arter_2006

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

执行后无反应，属性都没改，不知道问题出在哪里？让您费心了。

' ******************************************************************************
3 w9 b2 V; |# M( q6 q  r3 l' C:\Users\admin\AppData\Local\Temp\swx8144\Macro1.swb - macro recorded on 11/22/18 by mqlu
' ******************************************************************************
, I; }7 R* v9 ]' n7 @! y0 {  [Dim swApp As Object
Dim Part As Object
/ c9 B! r6 V& C) P7 P6 v' y8 `Dim boolstatus As Boolean
; K* H6 X, u1 u6 w: z' _Dim longstatus As Long, longwarnings As Long

  F' b1 _: ^! IDim SelMgr As Object
Dim Feature As Object
Dim a As Integer
8 f8 n; N' ^2 ?6 S& A9 lDim b As String
Dim m As String
Dim e As String
Dim k As String
Dim t As String
Dim c As String
Dim j As Integer
Dim strmat As String
Dim tempvalue As String
2 e" l6 T0 L/ V- j$ P
Sub main() '刪除所有配置属性
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
CurCFGname = Part.GetConfigurationNames
CurCFGnameCount = Part.GetConfigurationCount
8 y: H6 G" o7 Y1 X$ Q2 S5 z; b/ HFor i = 0 To CurCFGnameCount - 1
& ^3 k  t; g$ @9 W# [    Set CusPropMgr = Part.Extension.CustomPropertyManager(CurCFGname(i))
    Vnamearr = CusPropMgr.GetNames
    If Not IsEmpty(Vnamearr) Then
. h, f  v8 d/ }( A        For Each Vnamearr2 In Vnamearr
3 k* f& V. o, T+ O" v            bRet = Part.DeleteCustomInfo2(CurCFGname(i), Vnamearr2)
! P. M) |$ e2 _9 ?" x% W* [* F2 {        Next
) h* F9 p: j, g  v    End If
, [$ B7 \. `1 e2 N. X1 BNext
Call 刪除自定义属性
- s  [9 E7 M% C" d# ZCall partitionTM
2 q- r8 C: @2 T; f& D
' v  J# A6 U" mEnd Sub

8 M3 t) F0 d' k'~~~ 刪除自定义属性 ~~~
3 m1 l6 G9 h1 o4 t1 tSub 刪除自定义属性()
'Dim swApp As Object
Dim swModel2 As SldWorks.ModelDoc2
Dim vCustInfoNameArr2 As Variant
* W7 ^# o/ \7 b- l
3 F, ?  W4 ~7 D9 B- V5 c; h0 `Set swApp = Application.SldWorks
) Q) [& \3 L2 Z* c1 ?9 B1 ^- lSet swModel2 = swApp.ActiveDoc
vCustInfoNameArr2 = swModel2.GetCustomInfoNames
& u' h5 t; y. ~" }+ Q/ q  If Not IsEmpty(vCustInfoNameArr2) Then
     For Each vCustInfoName2 In vCustInfoNameArr2
         bRet = swModel2.DeleteCustomInfo(vCustInfoName2)
      Next
  End If
End Sub

'~~~ partitionTM ~~~
Sub partitionTM() 'partitionTM
/ g, D  f8 k. F" ]# o  Q) t$ U
'link solidworks
Set swApp = Application.SldWorks
$ T" k* m2 w/ K: QSet Part = swApp.ActiveDoc
Set SelMgr = Part.SelectionManager
swApp.ActiveDoc.ActiveView.FrameState = 1
. d/ ~+ T' W8 g( t'设定变量
& B) h2 O3 _& f% w  |c = swApp.ActiveDoc.GetTitle() '零件名
: L+ ~/ G8 e- Z  {+ |- Nstrmat = Chr(34) + Trim("SW-Material" + "@") + c + Chr(34)
'tempvalue = Part.CustomInfo2("", "材料")
' W9 l% ?& q* [/ Y" {6 g, ^blnretval = Part.DeleteCustomInfo2("", "代号")
blnretval = Part.DeleteCustomInfo2("", "名称")
3 g  C6 u/ G$ ~9 |7 U. nblnretval = Part.DeleteCustomInfo2("", "材料")
a = InStr(c, " ") - 1
9 _5 c; O) t. c6 S% {- r. tIf a > 0 Then
    k = Left(c, a)
    t = Left(LTrim(e), 3)
    If t = "GBT" Then
" Y4 G( R! R9 O, y        e = "GB/T" + Mid(k, 4)
/ D0 F+ Z9 ^- r7 {    Else
        e = k
# W6 M" j+ r# P" `    End If
    b = Mid(c, a + 2)
    t = Right(c, 7)
8 V, b; W' H5 J0 q/ Y1 H    If t = ".SLDPRT" Or t = ".SLDASM" Then
2 e' O& q9 p$ \0 \8 b        j = Len(b) - 7
    Else
        j = Len(b)
    End If
    m = Left(b, j)
' d! N( _, ~& ]) l5 u9 Q* ]End If
. n) h9 Y+ Y3 `" J( x& z/ Lblnretval = Part.AddCustomInfo3("", "代号", swCustomInfoText, e)
' _' p' U# g2 {! ^9 |blnretval = Part.AddCustomInfo3("", "名称", swCustomInfoText, m)
) x& b) s; r( w7 e/ cblnretval = Part.AddCustomInfo3("", "材料", swCustomInfoText, strmat)
  o; _/ W0 R3 @* N0 `) _8 nblnretval = Part.AddCustomInfo3("", "单重", swCustomInfoText, " ")
blnretval = Part.AddCustomInfo3("", "备注", swCustomInfoText, " ")

; W4 c4 q% M5 ]+ c1 y( uEnd Sub
! |0 f2 `" C) s- {  d2 X

ryouss

/ @6 `, V- w& |* L2 S

arter_2006 发表于 2018-11-26 15:11
$ Q5 j8 J5 D5 H* g( L) |$ c. x/ f9 u执行后无反应，属性都没改，不知道问题出在哪里？让您费心了。

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

sw2017 測試OK
1 P) C2 m2 R8 A) x有否顯示什麼錯誤提示?
$ v6 T6 z) Q* m

$ E& O, z) J# \1 }- _8 \

+ A) c6 M2 v/ ^4 R. G$ [+ C* P2 }

arter_2006

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

ryouss

arter_2006 发表于 2018-11-26 17:00
, o% u2 @0 @, V4 q4 X4 k; L0 h& j我的是Solidworks 2018，看来可能是版本的问题了

5 x  \9 o2 K5 c! F- B8 U4 e2018 沒版本能試
1 @- N- d+ E7 W  d

arter_2006

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

非常感谢您，让您费心了。
( U) O% a- s. E  o  r& f# N

arter_2006

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

能否把您的SWP文件发上来，我刚才用solidworks 2014也试了一下，发现也不行，但是别的宏都可以。
我从网页上复制下来的都变成下面这个样子了，所以要删掉很多多出来的东西，我怀疑是不是这个原因导致的，但是校对很费时间，也难发现。
: O' d- w/ v; O& l' a
' ******************************************************************************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
' ******************************************************************************
: n% \( F) I, C+ j: _& m6 bDim swApp As Object
: i. R9 P- k0 c: U* Q2 U- o' 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 _
! n2 b/ a+ M. JDim longstatus As Long, longwarnings As Long
' o, k6 C( D  g* 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
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; `
1 h8 n4 q4 W) @2 {/ R  X1 _Dim k As String* ?4 t9 u7 n+ _
* w( k, c4 B- }/ ]! ODim t As String
/ D4 U; b' G& z2 S% R* ?6 C5 B( @3 D& DDim c As String
) {7 t9 Y! r1 H1 N! K3 d. @4 X+ d/ Q. _. p: yDim j As Integer3 N( z+ v  K2 q* v6 D
# M* W6 L  z  bDim strmat As String
0 K! a- d$ d  Q3 ^& i0 ~" F! d7 t6 p- DDim tempvalue As String
2 q" z7 P5 T( }* S% k3 g& E& r" D5 F  G0 |% Q: b, Y
- o) ?$ `2 a( G& L5 x7 Q- B3 Z( ISub main() '刪除所有配置屬性
) i2 P6 Q1 D8 x, ~7 p/ z; c8 H3 l/ z* n* R9 KSet swApp = Application.SldWorks9 g. p. p7 K6 u7 ?4 x4 W6 n
; `' @( F. v/ Z% c) Z6 KSet Part = swApp.ActiveDoc$ q6 |& ^2 b7 ~/ ]( ^0 R
+ u# A8 r) N9 n, O3 LCurCFGname = Part.GetConfigurationNames
- [5 v: x. U8 U( V* kCurCFGnameCount = Part.GetConfigurationCount
" d8 O) a# i' T6 Z& R6 O" 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))
2 Z4 X. D# V5 e/ u4 u) w. G( J! L$ ?  c% B6 }    Vnamearr = CusPropMgr.GetNames4 B$ N4 Q* X) q- [; f8 r0 ^5 {
) Q2 |! {) o& K- G3 y3 ~: B    If Not IsEmpty(Vnamearr) Then' t" n; u" h( T
        For Each Vnamearr2 In Vnamearr
: y$ S) R3 M( l6 E- n8 t& |, B: B/ V9 S4 d, F7 Z            bRet = Part.DeleteCustomInfo2(CurCFGname(i), Vnamearr2)+ h. {$ P6 Q5 M: i
0 N1 g* X% l: Z3 z; L        Next- P& E; Z$ s7 V+ a( t' E% T
$ ^) t6 }- e0 ^6 [2 H/ k! F    End If
$ A3 @6 S" n' d2 eNext
5 Y7 {' k4 _4 m( a' G$ u  P  k" k4 f; K$ vCall 刪除自定義屬性
( A- x) f" C" d8 G6 }) {# {' iCall partitionTM4 }2 o$ e' E7 t

2 @8 q. ~" b  {% q" `4 h6 {End Sub
; c% `$ e2 I! t! d" T% e; G6 r) ]# @' p
" D7 r# [' m2 U5 Z7 k9 B. 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" }
3 `$ G: ]& e& g1 i- N" M$ Z+ xDim swModel2 As SldWorks.ModelDoc2
% E5 s6 d' S+ e- N$ R# ?! f' g# o6 S, e, W4 z+ EDim vCustInfoNameArr2 As Variant7 J* i  U% A! t0 \0 D! h, V
4 Z/ K* |2 b( v. [: ~4 ~# \5 p2 |
- 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
2 L1 j0 }& O, Y& W: t! V# Z5 s; g8 P9 J( v  m% Z     For Each vCustInfoName2 In vCustInfoNameArr2- \% O7 w% [: r; T3 |5 M
: f9 i4 C( l+ I  g         bRet = swModel2.DeleteCustomInfo(vCustInfoName2)
; \: C0 `% L. v4 r3 E- K% s2 n. ?" R/ r# I! y' x7 _' X      Next9 U+ R% V2 G# P
  End If
& V, L( M& Q4 l& b0 TEnd Sub
6 M- K7 `: z' w) T+ c$ V; G
" S5 w+ `4 L8 `6 z* [1 {( P/ 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* [
Set swApp = Application.SldWorks+ w1 D3 {4 b7 ^# i5 p4 ~2 p
9 o- O: n% L. t  I, t& p% u2 Q3 fSet Part = swApp.ActiveDoc
) k" c8 Y, z+ b# A0 `9 OSet SelMgr = Part.SelectionManager% m# Z: n! Q: I/ M* d( j' c
( h; v* y+ T6 U5 z1 e0 HswApp.ActiveDoc.ActiveView.FrameState = 1& ?6 I  _. Y+ \4 m7 P" c% W/ h
9 b& {. p, l" d- y'設定變量& }. 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("", "材料")
& 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
    t = Left(LTrim(e), 3)0 |: d+ H% K1 I5 d; ^& r
    If t = "GBT" Then0 a: k4 H  }1 j) y
6 p+ U+ v* G% y9 u  p# Y6 S        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
* u/ b- W' w3 r) ]5 _    End If! C- h9 R! k; n% D6 G+ S; P
' A; @8 ^! [' P* r( x    b = Mid(c, a + 2)
3 [+ q# n. y6 a3 Y6 N9 Y1 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' \
/ C6 K6 ]: |/ E/ t+ J# M, |, S    Else& f9 y# D- W/ Y! i& w- H
        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& ]
$ n0 `, ~; M2 j- ]: n" H( h9 e( Iblnretval = Part.AddCustomInfo3("", "代號", swCustomInfoText, e)
: ]3 n- K. E! R/ w' l: 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)
* l/ ?7 k$ E8 Y# P5 Z3 J5 y! M9 Z0 O2 e0 Q6 cblnretval = Part.AddCustomInfo3("", "單重", swCustomInfoText, " ")
! _/ l5 r( v; p, p& }7 Q  V; G2 e# V. L; H; {2 wblnretval = Part.AddCustomInfo3("", "備註", swCustomInfoText, " ")
' J9 G6 z3 C" `. g* O1 M4 ]: i2 D6 }7 z- @1 t: i# Q, P, {! f% c" J- {6 u; t
End Sub

ryouss

arter_2006 发表于 2018-11-26 17:27
能否把您的SWP文件发上来，我刚才用solidworks 2014也试了一下，发现也不行，但是别的宏都可以。
我从网 ...

  ?0 b# }! ?+ [5 a( f3 H$ }附swp繁体版   
( R$ L1 ?$ x. q4 J9 f

ryouss

試試把   CurCFGname = swApp.GetConfigurationNames

改為      CurCFGname = swApp.GetConfigurationNames(swApp.ActiveDoc.GetPathName) '補加零件文件的路徑及名稱
" P7 u  \/ y' K
在沒補加 (swApp.ActiveDoc.GetPathName) 時在2012及2015版是會有提示錯誤的(如附图)
" I2 u+ h( D, F8 h' k另VBA編程在   " '  " 符號后的文字是會跳過不執行的.

( S( Q! _/ e" q

arter_2006

我试过了，改之前，改之后一个样，而且执行中没有任何错误提示。
/ ]( Y+ [) _- p5 w' ******************************************************************************
' 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
* Q/ P' W0 `; v0 }/ C, W8 yDim boolstatus As Boolean
" i0 N2 M' d1 E  P7 l+ N" N% ODim longstatus As Long, longwarnings As Long
) c5 B1 ]( w' W* b7 Z9 {
3 j( V$ I3 E& l8 @  Q& FDim SelMgr As Object
: i8 l+ o2 S, b6 [2 h3 h) Z6 ~Dim Feature As Object
Dim a As Integer
Dim b As String
Dim m As String
$ f  G0 j' X+ s$ C% vDim e As String
Dim k As String
Dim t As String
Dim c As String
  k/ h& S, I& D3 z$ [Dim j As Integer
& _( E7 e1 }3 S* `" ~# S$ u5 tDim strmat As String
! C- b* l0 ~( _) _5 ODim tempvalue As String
3 J; O5 Z  f* M9 @. P% m2 S
3 c3 P/ e) j1 pSub main() '刪除所有配置属性
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
& W$ {% H3 M6 Y5 z6 e4 K# P4 lCurCFGname = swApp.GetConfigurationNames(swApp.ActiveDoc.GetPathName) '补加零件文件的路径及名称
CurCFGnameCount = Part.GetConfigurationCount
9 q/ P$ G# z& v5 J) I. M! l4 wFor i = 0 To CurCFGnameCount - 1
    Set CusPropMgr = Part.Extension.CustomPropertyManager(CurCFGname(i))
3 g  K. |; T$ i& }    Vnamearr = CusPropMgr.GetNames
    If Not IsEmpty(Vnamearr) Then
- i5 a8 J8 e9 I' A; z$ i        For Each Vnamearr2 In Vnamearr
5 W, J- U" ^) P            bRet = Part.DeleteCustomInfo2(CurCFGname(i), Vnamearr2)
* ~" t" ^! i0 G% R% O1 _. m) P        Next
1 v. h7 V: y. O% Z: t    End If
Next
Call 刪除自定义属性
Call partitionTM
: a  v8 c3 B% V. ?8 i$ t
& o/ Y" {  A4 m4 E9 D  Q! j- |7 tEnd Sub
) x8 r9 U: x" C9 y  ^
1 v5 \0 D8 b+ f5 U$ p, o, }% P'~~~ 刪除自定义属性 ~~~
Sub 刪除自定义属性()
'Dim swApp As Object
6 B9 w  ]/ ~6 I6 l8 s) C; e; yDim swModel2 As SldWorks.ModelDoc2
- x) m& v! J3 r. p! M& |  g8 EDim vCustInfoNameArr2 As Variant
' P; X. q0 n& j
Set swApp = Application.SldWorks
Set swModel2 = swApp.ActiveDoc
vCustInfoNameArr2 = swModel2.GetCustomInfoNames
" F. S; e3 i1 q- \  If Not IsEmpty(vCustInfoNameArr2) Then
     For Each vCustInfoName2 In vCustInfoNameArr2
         bRet = swModel2.DeleteCustomInfo(vCustInfoName2)
      Next
  End If
End Sub
) f/ }  y  c# ?
$ Q) B! ]- F- C' Z'~~~ partitionTM ~~~
9 f7 g9 a$ ]) V3 A8 ^0 ]' @Sub partitionTM() 'partitionTM
) u# R/ b; F1 W# u! D5 t2 @
' M/ |* s* k6 c5 a" n2 `'link solidworks
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
0 U4 T5 W4 [7 F+ s/ r0 oSet SelMgr = Part.SelectionManager
swApp.ActiveDoc.ActiveView.FrameState = 1
'设定变量
5 t2 s1 U+ G. kc = swApp.ActiveDoc.GetTitle() '零件名
, m9 n' V( _+ C: M: x5 `strmat = Chr(34) + Trim("SW-Material" + "@") + c + Chr(34)
'tempvalue = Part.CustomInfo2("", "材料")
7 Y- d0 s; p- }blnretval = Part.DeleteCustomInfo2("", "代号")
blnretval = Part.DeleteCustomInfo2("", "名称")
blnretval = Part.DeleteCustomInfo2("", "材料")
, b* @' l- ?+ g( B, Y

a = InStr(c, " ") - 1
" s! b5 G: U8 A9 Q! SIf a > 0 Then
    k = Left(c, a)
    t = Left(LTrim(e), 3)
3 n' }- n) g# t: d) t1 T$ s
& k  |1 z4 r8 y5 X* H    If t = "GBT" Then
        e = "GB/T" + Mid(k, 4)
7 L) A9 I2 p1 l    Else
        e = k
: q( o# N8 P+ o" M    End If

    b = Mid(c, a + 2)
1 L( c& M+ `/ x9 x/ i    t = Right(c, 7)
    If t = ".SLDPRT" Or t = ".SLDASM" Then
        j = Len(b) - 7
/ X# S& F5 I5 O6 d: w% j    Else
# b" F$ R. F$ A# K4 d: o3 G/ h        j = Len(b)
) ~( A* `" h8 [( Q/ \2 P    End If
    m = Left(b, j)
& i2 B% O: f2 a& \! X) d* {5 n8 gEnd If

  u& F: `' [) z4 _. ?blnretval = Part.AddCustomInfo3("", "代号", swCustomInfoText, e)
0 o  O# l/ T& k. s" oblnretval = Part.AddCustomInfo3("", "名称", swCustomInfoText, m)
8 _! I* _0 c, P9 Y( ]/ x6 kblnretval = Part.AddCustomInfo3("", "材料", swCustomInfoText, strmat)
blnretval = Part.AddCustomInfo3("", "单重", swCustomInfoText, " ")
2 y% b/ k/ g, }# T: `7 a) _& {* eblnretval = Part.AddCustomInfo3("", "备注", swCustomInfoText, " ")

End Sub