SOLIDWORKS 宏合并执行的问题

ryouss

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

0 I& ^0 L/ n: s1 j" h% E0 v
5 `* M( N5 L% `, a; m) Y

1. ' ******************************************************************************
   
2. ' C:\Users\admin\AppData\Local\Temp\swx8144\Macro1.swb - macro recorded on 11/22/18 by mqlu
   7 Q3 X: }# r" B" [, }, G+ r9 R
3. ' ******************************************************************************
   
4. Dim swApp As Object
   
5. Dim Part As Object
   * p: v+ I' w$ x
6. Dim boolstatus As Boolean
   
7. Dim longstatus As Long, longwarnings As Long
   0 p4 j: d9 a/ m+ P7 i: @
8. 
   , }: h8 j1 t# G
9. Dim SelMgr As Object
   ; ], w2 ~+ M( H1 ~7 n( n* _
10. Dim Feature As Object
    
11. Dim a As Integer
    
12. Dim b As String
    
13. Dim m As String
    1 X% X( t6 B0 J$ O) H0 }
14. Dim e As String
    3 O1 N9 A! Y6 H6 `1 M- X' d0 {
15. Dim k As String
    0 F3 e8 R3 o8 V% ]+ F. }
16. Dim t As String
    
17. Dim c As String
    * J( g: N" T4 H: @' X% N4 f! Q' D
18. Dim j As Integer
    
19. Dim strmat As String
    
20. Dim tempvalue As String
    
21. 
    ) R3 t$ J0 P) J7 n
22. Sub main() '刪除所有配置屬性
    ! b' U* P+ ~. V! w' ?6 ^
23. Set swApp = Application.SldWorks
    + }. O* b% a6 d+ E; w
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))
    
29.     Vnamearr = CusPropMgr.GetNames
    
30.     If Not IsEmpty(Vnamearr) Then
    
31.         For Each Vnamearr2 In Vnamearr
    $ v- M: S% q7 |' v
32.             bRet = Part.DeleteCustomInfo2(CurCFGname(i), Vnamearr2)
    7 p; u5 z7 b; h5 J2 _. r: ]7 O4 {4 k
33.         Next
    8 T  Z3 V6 k% o  e
34.     End If
    0 g8 b! s6 u9 O+ W' Q
35. Next
    
36. Call 刪除自定義屬性
    
37. Call partitionTM
    
38. 
    
39. End Sub
    
40. 
    3 w8 F3 T) C3 I2 \6 O% {
41. '~~~ 刪除自定義屬性 ~~~
    # q  r- Q3 [. x$ B
42. Sub 刪除自定義屬性()
    5 Z1 |- u1 D) \# f, N6 f$ ^
43. 'Dim swApp As Object
    
44. Dim swModel2 As SldWorks.ModelDoc2
    + e6 O. o' Y: c, m% {$ B/ v
45. Dim vCustInfoNameArr2 As Variant
    
46. 
    " @' k& R2 k9 ~  p: C, W
47. Set swApp = Application.SldWorks
    - t+ r% |+ g; y% k& K$ _! U" f
48. Set swModel2 = swApp.ActiveDoc
    
49. vCustInfoNameArr2 = swModel2.GetCustomInfoNames
    2 X# {! L) B4 H# ~* B3 i. p
50.   If Not IsEmpty(vCustInfoNameArr2) Then
    ) p8 B/ h0 S9 p& x! M2 ~1 j6 c
51.      For Each vCustInfoName2 In vCustInfoNameArr2
    : W+ q. j$ l& u
52.          bRet = swModel2.DeleteCustomInfo(vCustInfoName2)
    
53.       Next
    
54.   End If
    2 {6 e% n  L* e
55. End Sub
    
56. 
    3 f! L; s" ]+ e8 z, w, d0 E
57. '~~~ partitionTM ~~~
    " I8 g$ z8 p4 L+ L; K
58. Sub partitionTM() 'partitionTM
    
59. 
    / X; B+ N0 _; c! M% v
60. 'link solidworks
    ' {+ w4 }  c9 {% a- Z: [9 o
61. Set swApp = Application.SldWorks
    ; t4 x* r1 m* x* x! C! U1 w! b* c
62. Set Part = swApp.ActiveDoc
    
63. Set SelMgr = Part.SelectionManager
    
64. swApp.ActiveDoc.ActiveView.FrameState = 1
    8 l/ b! T0 {4 `# j' m$ H- _* x
65. '設定變量
    6 O  P  F* s; z) _) y
66. c = swApp.ActiveDoc.GetTitle() '零件名
    
67. strmat = Chr(34) + Trim("SW-Material" + "@") + c + Chr(34)
    
68. 'tempvalue = Part.CustomInfo2("", "材料")
    
69. blnretval = Part.DeleteCustomInfo2("", "代號")
    2 j# d) k7 b. |+ o: |( l8 q
70. blnretval = Part.DeleteCustomInfo2("", "名稱")
    % {# ^+ L3 i2 e2 v
71. blnretval = Part.DeleteCustomInfo2("", "材料")
    
72. a = InStr(c, " ") - 1
    ' \+ I) \" i" ]/ p/ g5 B# X8 B7 _
73. If a > 0 Then
    3 Y! \, o5 c& ^0 N- ]/ `  H8 z+ ?
74.     k = Left(c, a)
    ; V; R$ X. X" c( O4 I
75.     t = Left(LTrim(e), 3)
    / I' U" X2 `  |# Z+ A0 f5 n
76.     If t = "GBT" Then
    
77.         e = "GB/T" + Mid(k, 4)
    ) t# y7 z# X3 U2 ?! A  W  E
78.     Else
    ! D- x1 h# X% p& ?2 h0 p
79.         e = k
    
80.     End If
    + E: Q. V! O$ b$ }9 j4 u- G
81.     b = Mid(c, a + 2)
    
82.     t = Right(c, 7)
    
83.     If t = ".SLDPRT" Or t = ".SLDASM" Then
    
84.         j = Len(b) - 7
    / O& I0 T3 N8 F- V/ |/ x" K0 u
85.     Else
    9 _! R$ ]" g3 {' M4 j
86.         j = Len(b)
    ( m; V9 O2 y, |0 X3 Z& Y
87.     End If
    * u# ^( c7 ~) o# |
88.     m = Left(b, j)
    & a/ v; a6 x; j
89. End If
    
90. blnretval = Part.AddCustomInfo3("", "代號", swCustomInfoText, e)
    : ~5 ~& @3 m' h9 \  ~! d' w
91. blnretval = Part.AddCustomInfo3("", "名稱", swCustomInfoText, m)
    # Q9 y8 X0 s1 O. a7 s) e/ w6 U9 u3 y* R
92. blnretval = Part.AddCustomInfo3("", "材料", swCustomInfoText, strmat)
    
93. blnretval = Part.AddCustomInfo3("", "單重", swCustomInfoText, " ")
    
94. blnretval = Part.AddCustomInfo3("", "備註", swCustomInfoText, " ")
    
95. 
    
96. End Sub

复制代码

. T& c) j+ \" t. {6 w

arter_2006

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

, n  u; S& v% d3 |2 Y/ @$ M: o执行后无反应，属性都没改，不知道问题出在哪里？让您费心了。

6 R  e3 g4 k) }; R" V0 ]' ******************************************************************************
6 h2 ~' j! o9 e1 {% c  ?7 E' F' C:\Users\admin\AppData\Local\Temp\swx8144\Macro1.swb - macro recorded on 11/22/18 by mqlu
' ******************************************************************************
# Z# ]+ G0 [; L' w% JDim swApp As Object
Dim Part As Object
. o3 H# t) h7 l; Y9 h. S0 iDim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long

* r1 q+ ?1 N2 K7 x6 EDim SelMgr As Object
) `/ ]6 b4 {- L6 _( _4 oDim Feature As Object
* Y% V; T4 |0 T# h! r$ s( c5 EDim a As Integer
1 N' W! z0 t* v% TDim b As String
Dim m As String
Dim e As String
1 f& P4 l/ G! b; NDim k As String
Dim t As String
Dim c As String
+ O- M: y# g. {0 U' f) bDim j As Integer
Dim strmat As String
Dim tempvalue As String
4 _+ L% \5 H  m. ]
- W: K6 c/ `! G4 u( R! bSub main() '刪除所有配置属性
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
CurCFGname = Part.GetConfigurationNames
0 W5 L* p3 Z  K. {: h' WCurCFGnameCount = Part.GetConfigurationCount
For i = 0 To CurCFGnameCount - 1
( x. s2 b5 ~, K' Q3 ^& x    Set CusPropMgr = Part.Extension.CustomPropertyManager(CurCFGname(i))
    Vnamearr = CusPropMgr.GetNames
    If Not IsEmpty(Vnamearr) Then
        For Each Vnamearr2 In Vnamearr
            bRet = Part.DeleteCustomInfo2(CurCFGname(i), Vnamearr2)
        Next
  z* M' v  r; U5 ]' n% K( d2 D    End If
' ^0 r1 [% H# X: uNext
' C# K7 Y6 Q- I5 gCall 刪除自定义属性
% _# Q1 n- \$ f+ v  f6 nCall partitionTM

End Sub
! h8 I, p( T* C/ Q5 I! s
'~~~ 刪除自定义属性 ~~~
Sub 刪除自定义属性()
'Dim swApp As Object
9 o9 ?' w, z' _Dim swModel2 As SldWorks.ModelDoc2
/ t5 e9 N$ i% P9 \& SDim vCustInfoNameArr2 As Variant

. d$ h6 ~' f8 [- W/ dSet swApp = Application.SldWorks
Set swModel2 = swApp.ActiveDoc
vCustInfoNameArr2 = swModel2.GetCustomInfoNames
  If Not IsEmpty(vCustInfoNameArr2) Then
. B6 r& f  t: g' D  L1 ?     For Each vCustInfoName2 In vCustInfoNameArr2
& l1 b5 G+ U; T         bRet = swModel2.DeleteCustomInfo(vCustInfoName2)
( G3 b" h( j' ~7 ^# U      Next
  End If
End Sub
4 D# Y6 k) l) C3 s- o) R9 L
'~~~ partitionTM ~~~
# J) P  h8 J2 |6 E% V& B' T/ lSub partitionTM() 'partitionTM
" Y5 ^* X' w/ M( `! l
1 I; o% z" a5 ?5 g1 N% i'link solidworks
2 `& c) t9 A0 L" ~; ASet swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
' O; c; J* u' {6 W% ?Set SelMgr = Part.SelectionManager
swApp.ActiveDoc.ActiveView.FrameState = 1
2 M4 \9 [% d4 k3 j  k'设定变量
1 t- ~# \  `9 @; r' k9 Yc = swApp.ActiveDoc.GetTitle() '零件名
8 a9 c8 R: s! ?- F7 l+ Pstrmat = Chr(34) + Trim("SW-Material" + "@") + c + Chr(34)
5 D$ B) q4 K6 g6 q7 V6 C" e: T'tempvalue = Part.CustomInfo2("", "材料")
blnretval = Part.DeleteCustomInfo2("", "代号")
3 o* Q! I$ b2 \5 I$ O0 |0 Jblnretval = Part.DeleteCustomInfo2("", "名称")
blnretval = Part.DeleteCustomInfo2("", "材料")
; {0 t+ f+ c% W; }7 Ta = InStr(c, " ") - 1
, B/ g/ M0 r. n' v% ~8 fIf a > 0 Then
    k = Left(c, a)
    t = Left(LTrim(e), 3)
9 }: q+ I, O5 N7 [! H$ m7 ^    If t = "GBT" Then
        e = "GB/T" + Mid(k, 4)
9 I: h* s2 r" K" B! m4 V    Else
5 [4 r7 r/ f; j        e = k
    End If
    b = Mid(c, a + 2)
7 G' `3 _* S# q" Y    t = Right(c, 7)
    If t = ".SLDPRT" Or t = ".SLDASM" Then
, H& p! T2 @3 x: q' I# S5 [        j = Len(b) - 7
    Else
7 _$ ^" F; m* q        j = Len(b)
    End If
* b1 E$ `; u+ V! z    m = Left(b, j)
) h: `( G+ M% }& B! uEnd If
blnretval = Part.AddCustomInfo3("", "代号", swCustomInfoText, e)
blnretval = Part.AddCustomInfo3("", "名称", swCustomInfoText, m)
# s. o/ D( y  r* _% l2 mblnretval = Part.AddCustomInfo3("", "材料", swCustomInfoText, strmat)
  Q& b6 z8 }9 R0 hblnretval = Part.AddCustomInfo3("", "单重", swCustomInfoText, " ")
blnretval = Part.AddCustomInfo3("", "备注", swCustomInfoText, " ")

End Sub
& `. K2 ^5 e# B6 _1 \# V4 A

ryouss

arter_2006 发表于 2018-11-26 15:11
执行后无反应，属性都没改，不知道问题出在哪里？让您费心了。

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

sw2017 測試OK
有否顯示什麼錯誤提示?
2 q7 T8 P- k! w! Y

3 t! L  O5 E3 d9 ~5 [

arter_2006

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

ryouss

arter_2006 发表于 2018-11-26 17:00
我的是Solidworks 2018，看来可能是版本的问题了

2018 沒版本能試
$ @9 X) X6 D9 G3 }: Q) H* J3 c& C  J6 Y# T

arter_2006

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

! D: `0 A5 n- R; {3 s7 t, s非常感谢您，让您费心了。

arter_2006

ryouss 发表于 2018-11-26 17:05
, I. v1 b5 c  Q1 t) `9 R* T/ X' h2018 沒版本能試

! s; D* T8 L  X能否把您的SWP文件发上来，我刚才用solidworks 2014也试了一下，发现也不行，但是别的宏都可以。
我从网页上复制下来的都变成下面这个样子了，所以要删掉很多多出来的东西，我怀疑是不是这个原因导致的，但是校对很费时间，也难发现。

; D2 Z2 T  d+ ~0 F4 a. o' ******************************************************************************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
" Q- q$ N, z' \' ******************************************************************************
  d# ~: i/ S+ U2 p. D' B/ D. S: n% \( F) I, C+ j: _& m6 bDim swApp As Object
8 Q( k; \, {# c' e* i- B# F; m% [6 c9 t+ \0 }Dim Part As Object! t9 ?1 q2 c' K2 l9 ^4 X" G
! y5 k" p5 P- B- D; K" X. A* W5 X. ODim boolstatus As Boolean- I8 s/ Y$ i' W. N0 _
1 y' ]! m$ H6 m$ M/ V+ ^" jDim longstatus As Long, longwarnings As Long
) V0 _! K5 r- s5 E; V( c- T1 W8 u' q( \3 d4 Y/ K1 v" N; D
! V, Q; T, j, J7 ^3 J( R9 \8 _3 m& \) d/ \Dim SelMgr As Object
% U4 U3 t. X8 m$ [  L: 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; `
  ]/ Z; }2 |& C/ y0 \2 @Dim k As String* ?4 t9 u7 n+ _
Dim t As String
% 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
" F! d7 t6 p- DDim tempvalue As String
& E& r" D5 F  G0 |% Q: b, Y
- 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
3 h7 P9 J- W8 \5 {8 M7 x3 sSet Part = swApp.ActiveDoc$ q6 |& ^2 b7 ~/ ]( ^0 R
8 h8 y/ }: r; P- o* m7 WCurCFGname = Part.GetConfigurationNames
; C' R' L& @) v) u+ a- ~- [5 v: x. U8 U( V* kCurCFGnameCount = Part.GetConfigurationCount
" c- O# J: c, c5 w7 Y0 T. @for i = 0 To CurCFGnameCount - 1& {$ V* E/ x+ ~. V
( B& S' R- {2 j2 A) J    Set CusPropMgr = Part.Extension.CustomPropertyManager(CurCFGname(i))
. G( J! L$ ?  c% B6 }    Vnamearr = CusPropMgr.GetNames4 B$ N4 Q* X) q- [; f8 r0 ^5 {
6 n8 f, U+ l3 @1 O' i    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
# S3 i; }2 i" ~) |* v        Next- P& E; Z$ s7 V+ a( t' E% T
9 }8 U7 ~, ^: f+ R9 Y; e0 J    End If
7 u4 Q8 }+ Y+ V2 j$ A3 @6 S" n' d2 eNext
  k" k4 f; K$ vCall 刪除自定義屬性
4 h8 m- X! ~/ |( A- x) f" C" d8 G6 }) {# {' iCall partitionTM4 }2 o$ e' E7 t

0 q  N, Q0 p) T; l- y+ e2 @8 q. ~" b  {% q" `4 h6 {End Sub
% e; G6 r) ]# @' p
3 P& o# }) \  ^; C" D7 r# [' m2 U5 Z7 k9 B. O: ?'~~~ 刪除自定義屬性 ~~~
, q$ |7 t3 o0 S. L# k; l$ {: Q6 `! G2 u. ]" |4 i. ?Sub 刪除自定義屬性()
  B# r$ |5 d2 b. o4 x5 W" n+ J'Dim swApp As Object2 Q# s7 O1 ~+ I" }
/ T* Y2 L" b9 j$ ODim swModel2 As SldWorks.ModelDoc2
' R4 ~6 H' Q9 `9 R9 ]3 o, d! f' g# o6 S, e, W4 z+ EDim vCustInfoNameArr2 As Variant7 J* i  U% A! t0 \0 D! h, V

& W! ], j. O4 T; e9 M6 ~- 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 {
  X. \1 a" _) G+ p6 `/ C6 ~vCustInfoNameArr2 = swModel2.GetCustomInfoNames- N/ C9 m0 n2 t* k9 u
  If Not IsEmpty(vCustInfoNameArr2) Then
- Y8 A8 ]" S  e6 n+ H3 r4 i- K+ k! V# Z5 s; g8 P9 J( v  m% Z     For Each vCustInfoName2 In vCustInfoNameArr2- \% O7 w% [: r; T3 |5 M
  M5 x+ N: k6 V7 r. l         bRet = swModel2.DeleteCustomInfo(vCustInfoName2)
. ?" R/ r# I! y' x7 _' X      Next9 U+ R% V2 G# P
  End If
& Y$ ^& |3 S. F7 @! [& V, L( M& Q4 l& b0 TEnd Sub
, V' N" H+ N* m7 M) |% i3 I6 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* [
8 `5 I. n; i$ ^Set swApp = Application.SldWorks+ w1 D3 {4 b7 ^# i5 p4 ~2 p
Set Part = swApp.ActiveDoc
1 x) r" n7 M+ ?5 Q& i5 R- f) d) k" c8 Y, z+ b# A0 `9 OSet SelMgr = Part.SelectionManager% m# Z: n! Q: I/ M* d( j' c
6 f* y8 G# g3 O+ z8 QswApp.ActiveDoc.ActiveView.FrameState = 1& ?6 I  _. Y+ \4 m7 P" c% W/ h
'設定變量& }. N& d* J$ W) S
c = swApp.ActiveDoc.GetTitle() '零件名
2 Y' D, s! u1 f5 R" G4 a- t. {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("", "材料")
5 K% ^  H& l: U3 q# [# S" G& U; y& P! d9 n  V  X0 H+ J1 Yblnretval = Part.DeleteCustomInfo2("", "代號")3 w1 A4 Q. Z1 \, x1 N/ e; R
' U7 H; @. x5 r3 Y0 }& Yblnretval = Part.DeleteCustomInfo2("", "名稱"). }" r" K0 E! E
blnretval = Part.DeleteCustomInfo2("", "材料")
* t' s; u* p! l8 k& v+ U) d- F; R- ]4 V0 e- k2 J; Sa = InStr(c, " ") - 1
4 t8 ^9 h$ E  C4 R- }! X5 z" v0 S% D. r) K$ `' iIf a > 0 Then
  y. K& c0 }8 t6 @$ G  n8 Z" j0 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
3 [9 P9 Y5 d& G0 U  d" r- _2 R+ w    If t = "GBT" Then0 a: k4 H  }1 j) y
        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
+ N$ k6 I$ P0 J2 |    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' \
    Else& f9 y# D- W/ Y! i& w- H
        j = Len(b); J( ?# E, |  ?
8 P8 G- t. A4 Z$ l9 {6 [/ A3 m# b    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)
  F! v; A0 b, a/ ?9 J; R5 i  l9 Z0 O2 e0 Q6 cblnretval = Part.AddCustomInfo3("", "單重", swCustomInfoText, " ")
  V; G2 e# V. L; H; {2 wblnretval = Part.AddCustomInfo3("", "備註", swCustomInfoText, " ")
- @: j& a% L* M- }9 x8 I6 ]: i2 D6 }7 z- @1 t: i# Q, P, {! f% c" J- {6 u; t
3 H, _' [+ @2 g8 zEnd Sub
+ S9 U, `- l9 p' m

ryouss

arter_2006 发表于 2018-11-26 17:27
, p9 p/ h; r8 ]8 n能否把您的SWP文件发上来，我刚才用solidworks 2014也试了一下，发现也不行，但是别的宏都可以。
  a; c3 b% P9 e# a. w3 t我从网 ...

附swp繁体版   

ryouss

" l+ C  _7 i. c* R
試試把   CurCFGname = swApp.GetConfigurationNames

0 h% g/ G2 f& R0 A# V: S改為      CurCFGname = swApp.GetConfigurationNames(swApp.ActiveDoc.GetPathName) '補加零件文件的路徑及名稱

# S- J" |, f1 E4 ]+ T* h( e$ V在沒補加 (swApp.ActiveDoc.GetPathName) 時在2012及2015版是會有提示錯誤的(如附图)
另VBA編程在   " '  " 符號后的文字是會跳過不執行的.
2 v1 `+ ]: H* {7 w* q1 F: X/ J
! w: p7 w) B( g; p2 p
4 w( ~% G/ m' M6 Z
; r" X8 t3 e7 z+ Q

arter_2006

我试过了，改之前，改之后一个样，而且执行中没有任何错误提示。
' ******************************************************************************
' C:\Users\admin\AppData\Local\Temp\swx8144\Macro1.swb - macro recorded on 11/22/18 by mqlu
& u+ x5 J* g, a1 v: c9 {, w' ******************************************************************************
Dim swApp As Object
, W6 r* u' k9 i. BDim Part As Object
Dim boolstatus As Boolean
! S+ e. _0 _( F# z& NDim longstatus As Long, longwarnings As Long
& |, W5 d: M! Y1 i2 _
. f$ N1 J( E5 i' K4 r# M3 hDim SelMgr As Object
Dim Feature As Object
Dim a As Integer
- h5 Y& J( e' x, cDim b As String
4 f) e9 F  N3 w9 h3 uDim m As String
, [' W, \/ c6 H5 x+ A( lDim e As String
/ U) o8 p. S! c4 C. VDim k As String
Dim t As String
Dim c As String
7 T7 z6 K# K* d1 HDim j As Integer
Dim strmat As String
2 f- d' V* \" t+ W2 KDim tempvalue As String

8 E3 w2 l7 m. l, Y1 G. @3 J) L/ XSub main() '刪除所有配置属性
# L. Y9 t7 ^/ M% M9 D8 a+ L2 gSet swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
- k, I$ [- P; `CurCFGname = swApp.GetConfigurationNames(swApp.ActiveDoc.GetPathName) '补加零件文件的路径及名称
CurCFGnameCount = Part.GetConfigurationCount
For i = 0 To CurCFGnameCount - 1
3 N1 ?' X9 J6 h% L/ Y$ A3 e    Set CusPropMgr = Part.Extension.CustomPropertyManager(CurCFGname(i))
! _8 N1 w/ d; A# S6 P1 w: \; J! `+ o    Vnamearr = CusPropMgr.GetNames
    If Not IsEmpty(Vnamearr) Then
" d( j$ |+ p1 L/ o9 K        For Each Vnamearr2 In Vnamearr
% A7 R2 g: y' F3 y            bRet = Part.DeleteCustomInfo2(CurCFGname(i), Vnamearr2)
. _9 T& h2 H& x        Next
+ \' h+ a, `, E6 Y- a0 P8 O    End If
Next
Call 刪除自定义属性
2 b  [5 i2 c8 g. zCall partitionTM
! _* z, `! }' u. ~% \
6 O" ?: g0 M4 ^6 _% hEnd Sub
! [) v# M# L5 G/ S, d- x
# X& _/ t. v4 E  O3 V, S'~~~ 刪除自定义属性 ~~~
) @: @1 }/ ]: w7 u. d+ z2 NSub 刪除自定义属性()
'Dim swApp As Object
9 Y0 \( u+ E% RDim swModel2 As SldWorks.ModelDoc2
7 l7 J% Q. D! T- A2 V6 A/ VDim vCustInfoNameArr2 As Variant

Set swApp = Application.SldWorks
Set swModel2 = swApp.ActiveDoc
vCustInfoNameArr2 = swModel2.GetCustomInfoNames
( i. B; I/ c9 w9 \. Y+ \  If Not IsEmpty(vCustInfoNameArr2) Then
/ {* f  I" B; ?' L     For Each vCustInfoName2 In vCustInfoNameArr2
  Q, o8 @. P5 {) d! O7 s         bRet = swModel2.DeleteCustomInfo(vCustInfoName2)
      Next
3 C6 A0 ~$ A3 K* i1 S5 }  End If
End Sub

0 G, b9 C4 L. H2 q7 m'~~~ partitionTM ~~~
Sub partitionTM() 'partitionTM

( o7 i1 R& {6 r" _0 j/ F/ h'link solidworks
. V3 S& X/ \& K% ASet swApp = Application.SldWorks
4 t, ?0 m% S4 g3 Q9 KSet Part = swApp.ActiveDoc
# p9 S. \5 V, F7 PSet SelMgr = Part.SelectionManager
swApp.ActiveDoc.ActiveView.FrameState = 1
" `' h% w0 c$ l$ t9 t  R- Z# r2 G$ b'设定变量
% Z6 \* h# K3 Q: R) f  V% f2 i/ s0 k, oc = swApp.ActiveDoc.GetTitle() '零件名
. ?3 o; v' D( Y5 K' `$ X) q- O2 Rstrmat = Chr(34) + Trim("SW-Material" + "@") + c + Chr(34)
8 l: G& H4 `: |% |% O) c, s'tempvalue = Part.CustomInfo2("", "材料")
blnretval = Part.DeleteCustomInfo2("", "代号")
4 p- `  x% A8 @2 j5 @9 f, wblnretval = Part.DeleteCustomInfo2("", "名称")
blnretval = Part.DeleteCustomInfo2("", "材料")
+ w/ b8 h. P" u. n5 ]5 K) Q

a = InStr(c, " ") - 1
7 E) i4 u3 J' o/ fIf a > 0 Then
    k = Left(c, a)
    t = Left(LTrim(e), 3)

- |5 ^/ o, o/ ]* j8 h% e" ]& s; X$ n7 [    If t = "GBT" Then
        e = "GB/T" + Mid(k, 4)
    Else
        e = k
    End If

& C" k5 i7 z3 M0 v    b = Mid(c, a + 2)
* |( m5 e. |" u# _' E    t = Right(c, 7)
    If t = ".SLDPRT" Or t = ".SLDASM" Then
        j = Len(b) - 7
  V! S4 N  L: X* Y( O4 f    Else
        j = Len(b)
    End If
    m = Left(b, j)
End If
1 v) K$ m3 |4 @7 a6 K6 i. _
+ k) s9 z: p, p+ b, oblnretval = Part.AddCustomInfo3("", "代号", swCustomInfoText, e)
; R1 P7 E) ^& B2 l9 n% H( tblnretval = Part.AddCustomInfo3("", "名称", swCustomInfoText, m)
blnretval = Part.AddCustomInfo3("", "材料", swCustomInfoText, strmat)
blnretval = Part.AddCustomInfo3("", "单重", swCustomInfoText, " ")
6 }- S/ m# |* H+ d0 G- B0 m6 h+ Lblnretval = Part.AddCustomInfo3("", "备注", swCustomInfoText, " ")
9 k2 `; Y4 F9 j- j" j  O
End Sub