SOLIDWORKS 宏合并执行的问题

ryouss

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


% G; z+ [- B+ B0 Q0 {

1. ' ******************************************************************************
   3 g* W$ x0 I+ x5 e0 D" u
2. ' C:\Users\admin\AppData\Local\Temp\swx8144\Macro1.swb - macro recorded on 11/22/18 by mqlu
   
3. ' ******************************************************************************
   8 b! h) H& W! H: c# Z
4. Dim swApp As Object
   ) _  l1 E# v4 Z. R* d- R6 a+ q# ?
5. Dim Part As Object
   
6. Dim boolstatus As Boolean
   % \. l. p1 ?1 ]# A! q6 I! s) P3 q9 H3 x
7. Dim longstatus As Long, longwarnings As Long
   ) r' R5 @$ P' D5 w
8. 
   3 e# ~4 B; R% v
9. Dim SelMgr As Object
   
10. Dim Feature As Object
    
11. Dim a As Integer
    
12. Dim b As String
    
13. Dim m As String
    / d0 C$ V8 R8 w2 i3 N
14. Dim e As String
    , d" t  j; Z: P5 @9 S6 b/ T
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
    + |, X  P) j1 R& _
21. 
    9 b: M* d/ W$ y$ k- I" J
22. Sub main() '刪除所有配置屬性
    1 h2 p6 R' d+ f
23. Set swApp = Application.SldWorks
    
24. Set Part = swApp.ActiveDoc
    
25. CurCFGname = Part.GetConfigurationNames
    
26. CurCFGnameCount = Part.GetConfigurationCount
    
27. For i = 0 To CurCFGnameCount - 1
    
28.     Set CusPropMgr = Part.Extension.CustomPropertyManager(CurCFGname(i))
    9 [  T* v+ l' L, M
29.     Vnamearr = CusPropMgr.GetNames
    : @% a6 p  @/ g& M7 c
30.     If Not IsEmpty(Vnamearr) Then
    ) g6 J1 J% c* c) \( S. a( {
31.         For Each Vnamearr2 In Vnamearr
    
32.             bRet = Part.DeleteCustomInfo2(CurCFGname(i), Vnamearr2)
    
33.         Next
    
34.     End If
    
35. Next
    $ b3 P5 o/ J8 P: I# ^
36. Call 刪除自定義屬性
    . i8 ~( N: d/ T4 s5 h, Q
37. Call partitionTM
    ! K+ Q# g9 C& p4 X# x( W
38. 
    
39. End Sub
    9 F! ]$ Z, G( X% L9 Z( B2 k
40. 
    6 W" |6 V$ k' y. \! T
41. '~~~ 刪除自定義屬性 ~~~
    ( _) r# q6 x1 @2 _# y. o; N& r: S
42. Sub 刪除自定義屬性()
    
43. 'Dim swApp As Object
    
44. Dim swModel2 As SldWorks.ModelDoc2
    
45. Dim vCustInfoNameArr2 As Variant
    
46. 
    $ a! J  g' @; N* S
47. Set swApp = Application.SldWorks
    1 g/ c" U( ]+ m  t4 k9 s  |5 D
48. Set swModel2 = swApp.ActiveDoc
    8 _" d% d# ^$ c4 P& @
49. vCustInfoNameArr2 = swModel2.GetCustomInfoNames
    # b: q' Q4 Q: {* b9 V
50.   If Not IsEmpty(vCustInfoNameArr2) Then
    
51.      For Each vCustInfoName2 In vCustInfoNameArr2
    % Z4 f& g7 E7 W
52.          bRet = swModel2.DeleteCustomInfo(vCustInfoName2)
    * U" D% x% l# Y( ]6 {
53.       Next
    
54.   End If
    ; e2 G2 j/ K7 f9 D! t+ s) p
55. End Sub
    ! p% ]/ `3 K# Q; J: ~; H
56. 
    
57. '~~~ partitionTM ~~~
    
58. Sub partitionTM() 'partitionTM
    % H4 ~5 |" ?/ J, q2 B2 l0 A
59. 
    
60. 'link solidworks
    
61. Set swApp = Application.SldWorks
    7 ^- ^& ~' d+ n1 j+ H8 L0 y5 i
62. Set Part = swApp.ActiveDoc
    3 J0 F" Z! A) w: E
63. Set SelMgr = Part.SelectionManager
    / Y9 U% [: ~/ S  D/ {' m+ E3 x
64. swApp.ActiveDoc.ActiveView.FrameState = 1
    
65. '設定變量
    
66. c = swApp.ActiveDoc.GetTitle() '零件名
    
67. strmat = Chr(34) + Trim("SW-Material" + "@") + c + Chr(34)
    ! ~# x* K- _; t0 v) R5 W
68. 'tempvalue = Part.CustomInfo2("", "材料")
    
69. blnretval = Part.DeleteCustomInfo2("", "代號")
    
70. blnretval = Part.DeleteCustomInfo2("", "名稱")
    8 W+ `+ }: a4 d3 g0 D5 b
71. blnretval = Part.DeleteCustomInfo2("", "材料")
    
72. a = InStr(c, " ") - 1
    
73. If a > 0 Then
    
74.     k = Left(c, a)
    
75.     t = Left(LTrim(e), 3)
    
76.     If t = "GBT" Then
    
77.         e = "GB/T" + Mid(k, 4)
    
78.     Else
    6 A: ~6 C; ]( y% E! l# h
79.         e = k
    
80.     End If
    2 ~' y5 H4 B+ w3 m/ S3 b8 ]2 N. K
81.     b = Mid(c, a + 2)
    
82.     t = Right(c, 7)
    * g7 t* [/ [$ [+ p  J
83.     If t = ".SLDPRT" Or t = ".SLDASM" Then
    9 U( [, `# a7 C+ e
84.         j = Len(b) - 7
    9 W) {. x/ j3 U5 x5 c
85.     Else
    
86.         j = Len(b)
    6 N6 w. i8 T0 D5 i3 a) c
87.     End If
    3 I9 e! M1 n5 i
88.     m = Left(b, j)
    
89. End If
    
90. blnretval = Part.AddCustomInfo3("", "代號", swCustomInfoText, e)
    
91. blnretval = Part.AddCustomInfo3("", "名稱", swCustomInfoText, m)
    * F3 H% m* Q7 ?& j1 d( C! J- ~
92. blnretval = Part.AddCustomInfo3("", "材料", swCustomInfoText, strmat)
    
93. blnretval = Part.AddCustomInfo3("", "單重", swCustomInfoText, " ")
    
94. blnretval = Part.AddCustomInfo3("", "備註", swCustomInfoText, " ")
    " }) j! A+ I4 q: F* ?
95. 
    
96. End Sub

复制代码

1 h9 U/ S/ ^- O: c2 o
2 A. I+ ]* W" `( `& q
1 M/ L2 l9 g& v
) ]7 o, h3 y$ y3 ^

arter_2006

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

" M( q7 m" E$ Z: Y" b执行后无反应，属性都没改，不知道问题出在哪里？让您费心了。
6 m7 D1 ^) H$ {3 D5 N1 r) }
  X/ X6 i) \4 h$ k: Z' ******************************************************************************
5 n+ j7 R2 u/ a2 j. w! g' C:\Users\admin\AppData\Local\Temp\swx8144\Macro1.swb - macro recorded on 11/22/18 by mqlu
' ******************************************************************************
Dim swApp As Object
: ]" p# p, E0 _6 M: r% b8 ODim Part As Object
. Z5 X- A4 b- b+ f* ^/ ?Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
9 d. Q# O% K+ {2 C9 m' E" r
' j3 Y  p, ^  R  E. ~Dim SelMgr As Object
% D0 B* y; t; I7 EDim Feature As Object
! @6 ~9 O* E/ }" DDim a As Integer
2 h) }1 j6 X4 @0 S8 f. c1 S. yDim b As String
9 M  Q# A2 U0 O4 U- `Dim m As String
7 S& ]* t; B& S* F7 NDim e As String
Dim k As String
Dim t As String
5 H4 v) D9 j  r0 P, w) A) a4 H2 m2 sDim c As String
Dim j As Integer
; {- A/ O/ d" }; r9 }Dim strmat As String
1 K8 v' H* e% iDim tempvalue As String

Sub main() '刪除所有配置属性
+ O3 e* m  |0 w- x; n7 j9 T$ KSet swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
CurCFGname = Part.GetConfigurationNames
; a  M6 n$ }( \6 ~, i4 `' [2 rCurCFGnameCount = Part.GetConfigurationCount
For i = 0 To CurCFGnameCount - 1
    Set CusPropMgr = Part.Extension.CustomPropertyManager(CurCFGname(i))
4 V# Y- n& Y% k  }    Vnamearr = CusPropMgr.GetNames
    If Not IsEmpty(Vnamearr) Then
        For Each Vnamearr2 In Vnamearr
            bRet = Part.DeleteCustomInfo2(CurCFGname(i), Vnamearr2)
        Next
    End If
* B1 e( M0 k9 c. j0 {Next
. u3 M7 ~! F$ K; p5 v. s# s7 T2 YCall 刪除自定义属性
( n1 d" p7 I! q+ q6 m  A- L& ZCall partitionTM

! ^7 i- f9 ^) zEnd Sub

'~~~ 刪除自定义属性 ~~~
) z3 u9 k# ]: E$ ?Sub 刪除自定义属性()
- j" E, R1 F: v'Dim swApp As Object
Dim swModel2 As SldWorks.ModelDoc2
& \! s; `$ A/ V$ E) ^Dim vCustInfoNameArr2 As Variant
* y' F3 ?3 {8 U  t9 x
; u3 m+ g  W' E$ l! RSet swApp = Application.SldWorks
+ `2 I1 l! ^- n- @/ }Set swModel2 = swApp.ActiveDoc
vCustInfoNameArr2 = swModel2.GetCustomInfoNames
  If Not IsEmpty(vCustInfoNameArr2) Then
     For Each vCustInfoName2 In vCustInfoNameArr2
' }% `! ]3 x+ {! y4 H9 h: g1 ]         bRet = swModel2.DeleteCustomInfo(vCustInfoName2)
1 k/ u! s! C: T3 z) u      Next
5 m+ Q" R, D& F4 v( i+ u) D  End If
End Sub
' s2 b- X* V8 O) |3 I; n
6 ^( i8 f( [" x1 Q1 O3 ^9 J7 P5 e) o'~~~ partitionTM ~~~
Sub partitionTM() 'partitionTM

* @4 A2 [. Q+ h% j, _'link solidworks
4 d! r4 @' ~* [% G8 F, tSet swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
# f) }1 |/ w! W: G1 }Set SelMgr = Part.SelectionManager
: c# f5 t3 \0 C8 QswApp.ActiveDoc.ActiveView.FrameState = 1
3 O& B2 y0 n7 ^) T$ L+ K" @: @'设定变量
1 I6 n  b# q: ]( ?; C( {c = swApp.ActiveDoc.GetTitle() '零件名
strmat = Chr(34) + Trim("SW-Material" + "@") + c + Chr(34)
* E9 K4 q* o; k9 P% T* z+ X'tempvalue = Part.CustomInfo2("", "材料")
1 c" I& s4 ^# ?1 ^: w" qblnretval = Part.DeleteCustomInfo2("", "代号")
  ?/ e1 ]3 p$ h- Rblnretval = Part.DeleteCustomInfo2("", "名称")
blnretval = Part.DeleteCustomInfo2("", "材料")
a = InStr(c, " ") - 1
If a > 0 Then
- c* g0 n/ s  ?    k = Left(c, a)
    t = Left(LTrim(e), 3)
    If t = "GBT" Then
        e = "GB/T" + Mid(k, 4)
6 Q7 r) \) `: m4 j, ?* x    Else
        e = k
% q6 {4 n5 h7 ?1 X* z% n; M6 n    End If
3 C5 {; t. t7 J$ a0 n3 g    b = Mid(c, a + 2)
    t = Right(c, 7)
    If t = ".SLDPRT" Or t = ".SLDASM" Then
        j = Len(b) - 7
2 E" s2 k$ C6 j( L- E    Else
        j = Len(b)
2 e! `* x) N0 @    End If
    m = Left(b, j)
End If
; W" U% u0 a7 i' q8 gblnretval = Part.AddCustomInfo3("", "代号", swCustomInfoText, e)
blnretval = Part.AddCustomInfo3("", "名称", swCustomInfoText, m)
blnretval = Part.AddCustomInfo3("", "材料", swCustomInfoText, strmat)
% S; P1 G" b# b7 e+ Z% tblnretval = Part.AddCustomInfo3("", "单重", swCustomInfoText, " ")
" w. Z. ]. Q$ }7 m, H% Kblnretval = Part.AddCustomInfo3("", "备注", swCustomInfoText, " ")
4 _# C) U: |  \1 S
- n5 M  L: U& {End Sub

ryouss

arter_2006 发表于 2018-11-26 15:11
# X3 O% [/ U8 w1 I* j执行后无反应，属性都没改，不知道问题出在哪里？让您费心了。

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

sw2017 測試OK
有否顯示什麼錯誤提示?
0 M( Y, y; i8 k
. H: S2 _# D+ i# Y$ i3 [0 k. i& a
  V3 L) e  x. F+ W: G

arter_2006

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

ryouss

arter_2006 发表于 2018-11-26 17:00
% W% e$ x+ _5 E3 i我的是Solidworks 2018，看来可能是版本的问题了

- G6 n) ]( G: S7 ^2018 沒版本能試

arter_2006

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

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

arter_2006

ryouss 发表于 2018-11-26 17:05
" }* Z- n3 _! Z; F- G4 e2018 沒版本能試

能否把您的SWP文件发上来，我刚才用solidworks 2014也试了一下，发现也不行，但是别的宏都可以。
$ o6 M, z- l% a/ c我从网页上复制下来的都变成下面这个样子了，所以要删掉很多多出来的东西，我怀疑是不是这个原因导致的，但是校对很费时间，也难发现。

3 M' s/ C5 b1 t! S3 {- t( o. l8 F' ******************************************************************************3 \3 X) J3 n, I6 @4 |0 x
; v7 ~, i! M/ N' 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
4 g& p' f2 P* M" P& j- z' ******************************************************************************
: 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
# {" d9 K# |8 T/ i# r  M, pDim boolstatus As Boolean- I8 s/ Y$ i' W. N0 _
Dim longstatus As Long, longwarnings As Long
7 P4 M3 E8 v- x( K1 W8 u' q( \3 d4 Y/ K1 v" N; D
: `" }" X: f0 ^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
( J' ~$ I" B) Z+ \7 s$ z: N6 b! v  l! SDim a As Integer
  x1 w6 R' L) H' D& 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
* ?% n8 W1 \9 t6 E+ `5 Y+ {: @Dim m As String+ ?/ w( `) D: S9 x
Dim e As String" t" l1 k  K7 K8 U: @# s; `
1 ^8 Z" k, T% b: F$ l% hDim k As String* ?4 t9 u7 n+ _
& O' n& M6 k( v; a5 tDim t As String
: _7 f5 Y) f3 O7 R# T4 M0 B4 L% 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
Dim strmat As String
# R% D& Q8 V' s! }7 k" F! d7 t6 p- DDim tempvalue As String
/ V0 g3 C2 C' w  b, b- d# R& E& r" D5 F  G0 |% Q: b, Y
- o) ?$ `2 a( G& L5 x7 Q- B3 Z( ISub main() '刪除所有配置屬性
5 n. ~2 n- @  o; c8 H3 l/ z* n* R9 KSet swApp = Application.SldWorks9 g. p. p7 K6 u7 ?4 x4 W6 n
3 g; o; ?3 d4 b- q! O  o$ B3 i( b$ ~Set Part = swApp.ActiveDoc$ q6 |& ^2 b7 ~/ ]( ^0 R
CurCFGname = Part.GetConfigurationNames
- [5 v: x. U8 U( V* kCurCFGnameCount = Part.GetConfigurationCount
' g. ^/ U" o4 a/ P7 w( {" c- O# J: c, c5 w7 Y0 T. @for i = 0 To CurCFGnameCount - 1& {$ V* E/ x+ ~. V
+ {; I+ Z2 U% o1 d    Set CusPropMgr = Part.Extension.CustomPropertyManager(CurCFGname(i))
# H- N5 @3 q/ L& D# {; E2 I( p. G( J! L$ ?  c% B6 }    Vnamearr = CusPropMgr.GetNames4 B$ N4 Q* X) q- [; f8 r0 ^5 {
- K( b( \! q9 a4 \7 e( S- ]    If Not IsEmpty(Vnamearr) Then' t" n; u" h( T
        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
        Next- P& E; Z$ s7 V+ a( t' E% T
    End If
/ D& ~0 [2 T" E1 X7 v% N4 D$ A3 @6 S" n' d2 eNext
  k" k4 f; K$ vCall 刪除自定義屬性
! b, Z9 t1 O/ y. v' t: `/ ~' @( A- x) f" C" d8 G6 }) {# {' iCall partitionTM4 }2 o$ e' E7 t

2 @8 q. ~" b  {% q" `4 h6 {End Sub
% e; G6 r) ]# @' p
6 j9 Z4 b$ b* ^! `" 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" }
Dim swModel2 As SldWorks.ModelDoc2
+ Q1 H5 ?' |% \0 K( B! f' g# o6 S, e, W4 z+ EDim vCustInfoNameArr2 As Variant7 J* i  U% A! t0 \0 D! h, V
& X! a/ y/ t0 G3 {. ^8 E9 \
- Y: |! o3 c" M( e1 R6 x- 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
! V# Z5 s; g8 P9 J( v  m% Z     For Each vCustInfoName2 In vCustInfoNameArr2- \% O7 w% [: r; T3 |5 M
' k- k3 j2 ]: Q8 D         bRet = swModel2.DeleteCustomInfo(vCustInfoName2)
6 M$ [5 Z9 R3 F% h5 a& }. ?" R/ r# I! y' x7 _' X      Next9 U+ R% V2 G# P
, i% q  p, t( x* P) Z2 X  End If
/ Q! {! w) ^# L) `9 O& V, L( M& Q4 l& b0 TEnd Sub
6 M- K7 `: z' w) T+ c$ V; G
" f: B: f% F7 k3 Q4 A/ {! B/ j9 |  ?( U5 a+ K'~~~ partitionTM ~~~7 O3 t. l4 R1 [+ ]3 K  G+ M
9 O$ Q8 C. }: y6 J# USub partitionTM() 'partitionTM( j# ]! b. Q, G0 M9 E4 f8 B2 J
6 @9 h. v1 @/ v  v0 X; F% l; E) x# ~4 [& t0 {8 [
'link solidworks( C, c- [# N+ Z* [
Set swApp = Application.SldWorks+ w1 D3 {4 b7 ^# i5 p4 ~2 p
Set Part = swApp.ActiveDoc
) 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
! @9 f  A9 B4 X/ |" b' E- J7 n'設定變量& }. 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
! ^1 c  |3 W6 |0 g; ^'tempvalue = Part.CustomInfo2("", "材料")
8 f& r% m! M/ t' y& 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
" y2 e. r2 H) S+ }0 V" 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
        e = "GB/T" + Mid(k, 4)0 C& x4 F4 D' ], i* s8 T
) }0 ]. q+ K  |: V    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)
! t0 }5 u# Q; H# J3 C* k( H6 S2 ?' U+ d5 X" f: a    If t = ".SLDPRT" Or t = ".SLDASM" Then
2 k4 c" _" {; x; F1 f( 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
        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
blnretval = Part.AddCustomInfo3("", "材料", swCustomInfoText, strmat)
9 Z0 O2 e0 Q6 cblnretval = Part.AddCustomInfo3("", "單重", swCustomInfoText, " ")
  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

9 G( e+ G% I% h$ v3 W

ryouss

arter_2006 发表于 2018-11-26 17:27
- k- F1 x6 j1 U, m  k( O能否把您的SWP文件发上来，我刚才用solidworks 2014也试了一下，发现也不行，但是别的宏都可以。
3 V8 U! I7 j8 s# d( q1 X8 y我从网 ...

9 k4 Q# S! s$ u: {附swp繁体版   
" f" l) r4 n, E: M

ryouss

試試把   CurCFGname = swApp.GetConfigurationNames
  z, `# }. l7 L) |0 c7 N
改為      CurCFGname = swApp.GetConfigurationNames(swApp.ActiveDoc.GetPathName) '補加零件文件的路徑及名稱
3 Z) a6 p) `! a% r  h
在沒補加 (swApp.ActiveDoc.GetPathName) 時在2012及2015版是會有提示錯誤的(如附图)
另VBA編程在   " '  " 符號后的文字是會跳過不執行的.

1 w( g" B/ u8 g& r5 X0 G

arter_2006

我试过了，改之前，改之后一个样，而且执行中没有任何错误提示。
' ******************************************************************************
' C:\Users\admin\AppData\Local\Temp\swx8144\Macro1.swb - macro recorded on 11/22/18 by mqlu
6 ]' g, N. e, i' ******************************************************************************
Dim swApp As Object
# V4 p! I6 p2 G8 F7 @* l. A- IDim Part As Object
Dim boolstatus As Boolean
) ]) z# {1 h; h8 _6 B9 o1 BDim longstatus As Long, longwarnings As Long

Dim SelMgr As Object
Dim Feature As Object
8 y8 s7 Y) g9 Y5 ]! L# _! ^Dim a As Integer
4 j- g; {- {. q0 kDim b As String
' l8 d% T1 E, c5 v' D( @Dim m As String
7 S7 N5 Q+ c& m1 J! DDim e As String
- R3 J& ^3 {0 \% J! k. ^Dim k As String
1 {0 R' V% Q6 R7 t- s7 }Dim t As String
Dim c As String
Dim j As Integer
7 Q. \; f3 J) A4 eDim strmat As String
Dim tempvalue As String
0 b+ F  Y* z# B; i- o1 a( c  y- q* I
Sub main() '刪除所有配置属性
Set swApp = Application.SldWorks
+ H0 l$ W: K( i' A+ mSet Part = swApp.ActiveDoc
CurCFGname = swApp.GetConfigurationNames(swApp.ActiveDoc.GetPathName) '补加零件文件的路径及名称
- q8 `7 n8 N2 F- A2 H4 JCurCFGnameCount = Part.GetConfigurationCount
4 c2 r7 S* V0 ]' P6 kFor i = 0 To CurCFGnameCount - 1
$ S1 v2 O8 r9 d/ {$ F  E    Set CusPropMgr = Part.Extension.CustomPropertyManager(CurCFGname(i))
    Vnamearr = CusPropMgr.GetNames
% M7 |% y9 K+ x! @5 A9 X    If Not IsEmpty(Vnamearr) Then
        For Each Vnamearr2 In Vnamearr
; W' n. j- d$ H            bRet = Part.DeleteCustomInfo2(CurCFGname(i), Vnamearr2)
        Next
- r3 Q4 p/ y9 W& E    End If
Next
Call 刪除自定义属性
Call partitionTM
2 i0 E5 n/ M* _1 c, p" [
6 q7 f' `! i( w7 ?0 D8 S! G. e+ V3 VEnd Sub

" {$ l- s( q7 l+ c2 e/ U" H. @'~~~ 刪除自定义属性 ~~~
  p2 e9 R( ~, Y3 SSub 刪除自定义属性()
6 X, p+ M  `; T4 _- l' ^; C'Dim swApp As Object
Dim swModel2 As SldWorks.ModelDoc2
  z) P) S6 p5 e* t, x3 g0 R, RDim vCustInfoNameArr2 As Variant
" h! f! m% q+ l7 A0 z& h: {
Set swApp = Application.SldWorks
Set swModel2 = swApp.ActiveDoc
vCustInfoNameArr2 = swModel2.GetCustomInfoNames
0 O+ b& E) K. W$ d+ u" P( [3 a  If Not IsEmpty(vCustInfoNameArr2) Then
     For Each vCustInfoName2 In vCustInfoNameArr2
         bRet = swModel2.DeleteCustomInfo(vCustInfoName2)
0 ^  Q# p4 E% F( ~: a  [7 |( c# ^      Next
- A0 y% a% f) Y# E) \  End If
End Sub
$ h* U; R' g0 ?
4 T! C1 @' o' q6 D* y7 U# b& z5 w$ _'~~~ partitionTM ~~~
Sub partitionTM() 'partitionTM
0 J7 q; x- C- I
'link solidworks
Set swApp = Application.SldWorks
2 U. ]1 [% N5 S5 o9 f' ESet Part = swApp.ActiveDoc
( Q" G0 |( W  S! cSet SelMgr = Part.SelectionManager
swApp.ActiveDoc.ActiveView.FrameState = 1
9 i0 L/ ?6 W" M. R+ ['设定变量
c = swApp.ActiveDoc.GetTitle() '零件名
9 ?; q+ q/ A6 ?5 T8 ostrmat = Chr(34) + Trim("SW-Material" + "@") + c + Chr(34)
# v% w  e7 g3 F- c6 b9 H; p1 l- J'tempvalue = Part.CustomInfo2("", "材料")
: h7 _+ @; y1 P8 H' C* d9 wblnretval = Part.DeleteCustomInfo2("", "代号")
. u* ~6 m$ C5 B. F) rblnretval = Part.DeleteCustomInfo2("", "名称")
blnretval = Part.DeleteCustomInfo2("", "材料")
* l( q1 z5 j5 `" \% k
  R5 ^; d, z& l! _$ g
$ M3 Y2 n1 C" B9 x. z% c* B3 na = InStr(c, " ") - 1
If a > 0 Then
    k = Left(c, a)
3 i! i+ P# T0 y0 E( D% A6 K' O8 P9 k    t = Left(LTrim(e), 3)
$ z) a1 k2 }" _0 J' y3 Y
1 Q' j: Y4 b& r$ `( y; w8 b$ a5 S    If t = "GBT" Then
( Q( B0 G$ C8 Y" N7 g9 c2 K        e = "GB/T" + Mid(k, 4)
    Else
' r/ E. H% L+ c        e = k
- _$ k) }3 \' j& v. T    End If
# T; I+ ]2 ]+ f$ C4 k
* E$ l% l4 x) {4 L    b = Mid(c, a + 2)
    t = Right(c, 7)
: n, ?( K+ {; p( Q7 [    If t = ".SLDPRT" Or t = ".SLDASM" Then
        j = Len(b) - 7
) `0 D# N( s8 \/ \: k+ l    Else
        j = Len(b)
    End If
" e- l5 t3 g% ~0 G, u    m = Left(b, j)
. f* W# _( J, W$ z/ REnd If

1 d; e" R# r& N% Gblnretval = Part.AddCustomInfo3("", "代号", swCustomInfoText, e)
% }5 q! K4 u5 x8 Z1 ~. h  r3 Jblnretval = Part.AddCustomInfo3("", "名称", swCustomInfoText, m)
blnretval = Part.AddCustomInfo3("", "材料", swCustomInfoText, strmat)
blnretval = Part.AddCustomInfo3("", "单重", swCustomInfoText, " ")
blnretval = Part.AddCustomInfo3("", "备注", swCustomInfoText, " ")
  B& i4 Q/ ~6 L, k0 S6 W- T
. o  C$ p, A+ R* H8 tEnd Sub