SOLIDWORKS 宏合并执行的问题

ryouss

就是如下的繁体字改為簡体字就是
3 f. \( d0 @: R& R; a$ i4 v
) O5 x- C8 g4 T

1. ' ******************************************************************************
   ( |( [$ A- x9 m1 n4 ]& m3 D
2. ' C:\Users\admin\AppData\Local\Temp\swx8144\Macro1.swb - macro recorded on 11/22/18 by mqlu
   ) N, l# i( S# O* {8 V
3. ' ******************************************************************************
   & a8 T6 U# A8 G8 Z3 ~  D
4. Dim swApp As Object
   
5. Dim Part As Object
   4 x( r- [6 W4 I' g
6. Dim boolstatus As Boolean
   
7. Dim longstatus As Long, longwarnings As Long
   3 u( F. X3 z0 M9 Q0 I* ^
8. 
   / v! t1 Y) A+ [  p1 B
9. Dim SelMgr As Object
   2 \$ |$ I' U. {, B8 E4 r9 _* A' O
10. Dim Feature As Object
      ~' Q8 M) ~2 @- ]( f9 q
11. Dim a As Integer
      @/ O3 @) g2 g( {
12. Dim b As String
    0 U9 r( {" [, {1 H1 y
13. Dim m As String
    5 w$ `7 q7 k% }/ T- C' g
14. Dim e As String
    % W* ?) V3 u% t1 Y  W
15. Dim k As String
    9 ?2 Y* b" F0 c* d- o! V( A0 E
16. Dim t As String
    
17. Dim c As String
    % ~5 w* q; q/ F- @+ c7 M% U7 v& O
18. Dim j As Integer
    3 G7 T/ I& [7 k* ]9 ]3 O  p4 V
19. Dim strmat As String
    ' f3 f& J* c: r& h1 }+ T! ]8 S
20. Dim tempvalue As String
    
21. 
    7 }1 Z+ H7 r! b( b
22. Sub main() '刪除所有配置屬性
    4 g  h8 R+ |# r$ S
23. Set swApp = Application.SldWorks
    . A& M$ x$ g+ a! i  S" M
24. Set Part = swApp.ActiveDoc
    ! V  c5 d  f8 [& U. Z
25. CurCFGname = Part.GetConfigurationNames
    & ^, N) j" v# U( Q( O# d
26. CurCFGnameCount = Part.GetConfigurationCount
    
27. For i = 0 To CurCFGnameCount - 1
    : i2 i' n! k: q
28.     Set CusPropMgr = Part.Extension.CustomPropertyManager(CurCFGname(i))
    % c) Y; B4 b- `# p) \
29.     Vnamearr = CusPropMgr.GetNames
    % v- A' [& G9 N  I2 Z5 I
30.     If Not IsEmpty(Vnamearr) Then
    
31.         For Each Vnamearr2 In Vnamearr
    
32.             bRet = Part.DeleteCustomInfo2(CurCFGname(i), Vnamearr2)
    & a4 e2 U8 ~9 S, {
33.         Next
    
34.     End If
    4 K/ P, X# @" G( U  A3 {8 A1 I) m
35. Next
    % E+ x& w9 }) W# ?. a0 t. d
36. Call 刪除自定義屬性
    
37. Call partitionTM
    
38. 
    4 B  q4 M7 R, p
39. End Sub
    2 G( A- r. m' d  x
40. 
    
41. '~~~ 刪除自定義屬性 ~~~
    
42. Sub 刪除自定義屬性()
    
43. 'Dim swApp As Object
    & T; e( M& ~7 }  L6 i$ z
44. Dim swModel2 As SldWorks.ModelDoc2
    
45. Dim vCustInfoNameArr2 As Variant
    - ^2 ?* `" V; N# e# F  T, T
46. 
    
47. Set swApp = Application.SldWorks
    % W0 B2 K* x* V# z8 g
48. Set swModel2 = swApp.ActiveDoc
    9 S6 {' C% B' d7 T4 M) F  W3 T! ?
49. vCustInfoNameArr2 = swModel2.GetCustomInfoNames
    , D. K6 l. p" P. @5 @* b
50.   If Not IsEmpty(vCustInfoNameArr2) Then
    . p* M" t; U8 w
51.      For Each vCustInfoName2 In vCustInfoNameArr2
    
52.          bRet = swModel2.DeleteCustomInfo(vCustInfoName2)
    3 P" x' D" Y: h2 g; _
53.       Next
    
54.   End If
    2 Q# X# b; N- \; C$ z# q
55. End Sub
    
56. 
    * I% O/ z1 e* j+ b) }4 `, Y
57. '~~~ partitionTM ~~~
    
58. Sub partitionTM() 'partitionTM
    9 Z5 Y" Y# ]7 j' F1 W8 K+ R
59. 
    
60. 'link solidworks
    
61. Set swApp = Application.SldWorks
    % r- z# q/ k2 O0 @2 a! J
62. Set Part = swApp.ActiveDoc
    # e7 O$ _& w; r
63. Set SelMgr = Part.SelectionManager
    # M& ]; o3 K. Q  {
64. swApp.ActiveDoc.ActiveView.FrameState = 1
    1 |8 u/ k' o. d5 [, o
65. '設定變量
    " d" a; R" v: }) z0 ?
66. c = swApp.ActiveDoc.GetTitle() '零件名
    ; Z7 ]7 a; W7 K  Q
67. strmat = Chr(34) + Trim("SW-Material" + "@") + c + Chr(34)
    ; A7 t$ p8 s/ ^% [2 K
68. 'tempvalue = Part.CustomInfo2("", "材料")
    
69. blnretval = Part.DeleteCustomInfo2("", "代號")
    3 H! y' I; _3 ?
70. blnretval = Part.DeleteCustomInfo2("", "名稱")
    - _- ~' l5 W9 b+ f  Z: m
71. blnretval = Part.DeleteCustomInfo2("", "材料")
    
72. a = InStr(c, " ") - 1
    % r( w$ Z1 ^, @# Y
73. If a > 0 Then
    ) Z5 Z7 a! B- c4 i+ R% g  ]% U; j
74.     k = Left(c, a)
    
75.     t = Left(LTrim(e), 3)
    7 z/ ~5 v* `- N% p
76.     If t = "GBT" Then
    
77.         e = "GB/T" + Mid(k, 4)
    ) M" d8 p/ F" U4 a3 g
78.     Else
    2 g; |  T5 p: l; I6 y) i$ Q
79.         e = k
    8 f* B+ o/ i% u4 O: D# a
80.     End If
    " l8 ?2 p" K' N& u- o
81.     b = Mid(c, a + 2)
    4 F9 ?/ E, {8 k2 \5 v
82.     t = Right(c, 7)
    . Z6 J% C5 c; E2 K6 G
83.     If t = ".SLDPRT" Or t = ".SLDASM" Then
    
84.         j = Len(b) - 7
    8 A9 e" i3 n" N) |
85.     Else
    
86.         j = Len(b)
    
87.     End If
    
88.     m = Left(b, j)
    9 F, A# h$ ^# a7 g+ E' d
89. End If
    ! |, }% j5 p# n) q3 h# H
90. blnretval = Part.AddCustomInfo3("", "代號", swCustomInfoText, e)
    
91. blnretval = Part.AddCustomInfo3("", "名稱", swCustomInfoText, m)
    , z0 F1 Q! P- B' \% K" z
92. blnretval = Part.AddCustomInfo3("", "材料", swCustomInfoText, strmat)
    
93. blnretval = Part.AddCustomInfo3("", "單重", swCustomInfoText, " ")
    
94. blnretval = Part.AddCustomInfo3("", "備註", swCustomInfoText, " ")
    + b" t8 d' p* w! m% T
95. 
    
96. End Sub

复制代码

4 h* c$ M" I! {; _. N$ E1 ^

% O2 H) c+ N4 \6 a. }! K$ w
5 [6 W+ |3 Q* W/ E( S

arter_2006

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

% Y/ ]) g) B7 s1 Y! i/ A执行后无反应，属性都没改，不知道问题出在哪里？让您费心了。
6 j) Q6 ^0 F& a- z% Q* g1 M6 b
8 O- Q" U/ p7 n' ******************************************************************************
6 h# l' K3 c# O) _+ |- r3 g3 N4 S9 e' C:\Users\admin\AppData\Local\Temp\swx8144\Macro1.swb - macro recorded on 11/22/18 by mqlu
6 m: A9 }9 H) N9 S" C+ [' ******************************************************************************
Dim swApp As Object
Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long

Dim SelMgr As Object
) \! ]; U9 T) t: w# _' g3 |Dim Feature As Object
Dim a As Integer
2 R* }1 l$ }. C7 P7 g4 G9 h8 c& S6 N' ODim b As String
9 B2 n$ c. j" M* @/ o( {/ UDim m As String
7 h! w( u' h8 C8 d  zDim e As String
* V: _1 X/ a; Q+ cDim k As String
Dim t As String
* K- ?( `' t8 m' U7 T0 I  nDim c As String
# o+ y5 E; M( J! kDim j As Integer
Dim strmat As String
Dim tempvalue As String

% M- I( ^% m* MSub main() '刪除所有配置属性
$ b& S% ?; A( P- ^6 K! h% T5 }Set swApp = Application.SldWorks
4 t( n* e5 `% U) o) `4 P' hSet Part = swApp.ActiveDoc
CurCFGname = Part.GetConfigurationNames
CurCFGnameCount = Part.GetConfigurationCount
. Q) C, G5 y) V# ^8 ~! ZFor i = 0 To CurCFGnameCount - 1
- h( O3 m# _) f3 C3 ~: B6 W. |    Set CusPropMgr = Part.Extension.CustomPropertyManager(CurCFGname(i))
$ U' c( t4 k& J9 D* L/ y    Vnamearr = CusPropMgr.GetNames
8 O3 Y/ ~* t5 m: w& P8 j2 [6 L. h, q* _    If Not IsEmpty(Vnamearr) Then
        For Each Vnamearr2 In Vnamearr
            bRet = Part.DeleteCustomInfo2(CurCFGname(i), Vnamearr2)
        Next
3 g9 a) q4 m0 P3 t    End If
Next
2 m' A) d- q6 A" {# z. `5 S7 }Call 刪除自定义属性
Call partitionTM
& l5 ~) O! n! h/ [8 Q
0 t( L7 ~7 Z" NEnd Sub

'~~~ 刪除自定义属性 ~~~
+ U" _0 a) x" z0 C* C# \Sub 刪除自定义属性()
. M0 K. y' M; |# t% f) N0 A) X" c'Dim swApp As Object
Dim swModel2 As SldWorks.ModelDoc2
Dim vCustInfoNameArr2 As Variant

7 Y+ S1 \1 r# r/ ]9 o' eSet swApp = Application.SldWorks
Set swModel2 = swApp.ActiveDoc
vCustInfoNameArr2 = swModel2.GetCustomInfoNames
  If Not IsEmpty(vCustInfoNameArr2) Then
     For Each vCustInfoName2 In vCustInfoNameArr2
         bRet = swModel2.DeleteCustomInfo(vCustInfoName2)
      Next
4 P& Z* `( k: @/ K  End If
/ s0 x! @' Y$ V/ j0 MEnd Sub
2 }% S/ _8 v. [
'~~~ partitionTM ~~~
3 p) p. P2 R! ISub partitionTM() 'partitionTM

+ |% S! t4 ]; \: y'link solidworks
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
Set SelMgr = Part.SelectionManager
1 w: w4 g$ Z* _' AswApp.ActiveDoc.ActiveView.FrameState = 1
* B. Q% y: a3 O'设定变量
c = swApp.ActiveDoc.GetTitle() '零件名
- N  f! O1 W+ Q# l. Y3 g7 Z9 ostrmat = Chr(34) + Trim("SW-Material" + "@") + c + Chr(34)
5 m5 O$ _5 O* ~'tempvalue = Part.CustomInfo2("", "材料")
6 N* s1 n. {4 e" F) nblnretval = Part.DeleteCustomInfo2("", "代号")
( @6 {, l/ w5 K, `: W' I+ x9 Pblnretval = Part.DeleteCustomInfo2("", "名称")
blnretval = Part.DeleteCustomInfo2("", "材料")
, U: y' i% [$ O) p2 V, v7 ya = InStr(c, " ") - 1
If a > 0 Then
. a8 _: j$ P! ?/ |( ^- S7 W0 X    k = Left(c, a)
    t = Left(LTrim(e), 3)
    If t = "GBT" Then
        e = "GB/T" + Mid(k, 4)
    Else
- F# i/ z, [2 ~; K, {" X        e = k
& h' G# L9 ]) ?/ N    End If
    b = Mid(c, a + 2)
3 }# x8 M3 x: M    t = Right(c, 7)
    If t = ".SLDPRT" Or t = ".SLDASM" Then
! x; j; m+ |( j        j = Len(b) - 7
    Else
/ d, m& C" c2 M- z        j = Len(b)
: D2 E, }" o5 W# J    End If
    m = Left(b, j)
9 x7 f/ b, s& y6 ZEnd If
( {. P4 `! X# p3 `blnretval = Part.AddCustomInfo3("", "代号", swCustomInfoText, e)
8 k) y) X3 I+ i5 N$ Ublnretval = Part.AddCustomInfo3("", "名称", swCustomInfoText, m)
  S9 b- a4 ^: m3 L7 E' fblnretval = Part.AddCustomInfo3("", "材料", swCustomInfoText, strmat)
  y, z* z$ p' H, C' D8 }blnretval = Part.AddCustomInfo3("", "单重", swCustomInfoText, " ")
. x2 o7 B9 o2 @( e: k6 ^3 nblnretval = Part.AddCustomInfo3("", "备注", swCustomInfoText, " ")

7 O% s8 n0 ^  D0 e) A0 }1 QEnd Sub
& Q1 A* Q* K; \1 n) d: J
1 \  a! A8 [7 F. ~1 X

ryouss

# \/ ~% O1 r4 R. H) j# P$ b

arter_2006 发表于 2018-11-26 15:11
执行后无反应，属性都没改，不知道问题出在哪里？让您费心了。
/ H+ n- c6 ^% l3 o5 {% L1 m" p
' ********************************** ...

4 j4 d. q/ a: s% Qsw2017 測試OK
有否顯示什麼錯誤提示?
( H' p4 r$ g# [2 I5 }
7 G/ T5 {! j' Q& u. J7 ~8 p+ F8 C+ W

) m% B$ u' p- g5 |$ c) I

arter_2006

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

ryouss

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

6 G8 }) |3 n* b. u# Z/ v2018 沒版本能試

arter_2006

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

, |1 [- b( m) u, ]6 M, `非常感谢您，让您费心了。
- h) g9 O# S, P2 z' K0 f5 F

arter_2006

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

( r1 u; I$ C+ M) s! Z  f$ r能否把您的SWP文件发上来，我刚才用solidworks 2014也试了一下，发现也不行，但是别的宏都可以。
我从网页上复制下来的都变成下面这个样子了，所以要删掉很多多出来的东西，我怀疑是不是这个原因导致的，但是校对很费时间，也难发现。
& [- P' G6 N6 {$ }1 c  P9 b
  h" }! s- N+ c3 D' ******************************************************************************3 \3 X) J3 n, I6 @4 |0 x
1 Q% s3 y9 D* m% I0 J! [' A# k' 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
5 D9 M* c* u# P# W& ?5 v! l' ******************************************************************************
# L) ^- A# s5 c& K1 W4 K& H9 F5 a: n% \( F) I, C+ j: _& m6 bDim swApp As Object
& ]1 z& E3 F. T2 E5 b' e* i- B# F; m% [6 c9 t+ \0 }Dim Part As Object! t9 ?1 q2 c' K2 l9 ^4 X" G
' H3 w' S. |' B4 R' _* [9 fDim boolstatus As Boolean- I8 s/ Y$ i' W. N0 _
Dim longstatus As Long, longwarnings As Long
- i3 z" p& C/ o3 s1 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
6 v3 D3 U1 [, D+ y8 A7 s$ z: N6 b! v  l! SDim a As Integer
" J9 B( w, |: c$ m& c& 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
( D; x( Y6 l7 ~" f5 x* q, h9 zDim e As String" t" l1 k  K7 K8 U: @# s; `
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
- ]4 f  Q% @. r) YDim strmat As String
# k4 ]7 j5 m% O3 F4 U' _* P" F! d7 t6 p- DDim tempvalue As String
& E& r" D5 F  G0 |% Q: b, Y
) S4 ?( M( e5 E- 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
% Z6 O6 a7 i$ p+ J  e1 SSet Part = swApp.ActiveDoc$ q6 |& ^2 b7 ~/ ]( ^0 R
CurCFGname = Part.GetConfigurationNames
, e0 W. O& T9 [( D/ c5 K- [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
    Set CusPropMgr = Part.Extension.CustomPropertyManager(CurCFGname(i))
8 K" Z9 i: W* a% ^* T0 q1 d. 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
9 [. \  n& f1 Y        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
) l/ \: r' S6 C) A        Next- P& E; Z$ s7 V+ a( t' E% T
    End If
$ A3 @6 S" n' d2 eNext
& h% c# e  \$ K- }3 C5 f  k" k4 f; K$ vCall 刪除自定義屬性
$ C  D6 \; G* F6 u: V$ K# Y( A- x) f" C" d8 G6 }) {# {' iCall partitionTM4 }2 o$ e' E7 t
. Q" L+ V9 ]1 N# X: K  J6 e! ?3 ]
2 @8 q. ~" b  {% q" `4 h6 {End Sub
% e; G6 r) ]# @' p
" D7 r# [' m2 U5 Z7 k9 B. O: ?'~~~ 刪除自定義屬性 ~~~
4 A+ V, h* D: u3 F, Q  U4 i2 s/ Y: Q6 `! G2 u. ]" |4 i. ?Sub 刪除自定義屬性()
  B# r$ |5 d2 b. o4 x5 W" n+ J'Dim swApp As Object2 Q# s7 O1 ~+ I" }
( [& M' S( V+ s- r' X5 {1 n/ iDim swModel2 As SldWorks.ModelDoc2
6 c! o" ]1 N* @! f' g# o6 S, e, W4 z+ EDim vCustInfoNameArr2 As Variant7 J* i  U% A! t0 \0 D! h, V

2 [  _- C8 P  }5 G1 y- 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
  ^% {3 Y7 V# c9 z% ^$ J: b, X  If Not IsEmpty(vCustInfoNameArr2) Then
) o7 H/ Z' m0 Q6 ?* ?! V# Z5 s; g8 P9 J( v  m% Z     For Each vCustInfoName2 In vCustInfoNameArr2- \% O7 w% [: r; T3 |5 M
         bRet = swModel2.DeleteCustomInfo(vCustInfoName2)
. ?" R/ r# I! y' x7 _' X      Next9 U+ R% V2 G# P
* ^- K; K7 d2 w2 \: m" j  _  End If
2 N1 @2 u& N/ m# E3 E& V, L( M& Q4 l& b0 TEnd Sub
6 M- K7 `: z' w) T+ c$ V; G
" [$ l( V. Z6 T9 ]/ j9 |  ?( U5 a+ K'~~~ partitionTM ~~~7 O3 t. l4 R1 [+ ]3 K  G+ M
; k2 J5 P% S# [# l# a/ W# dSub partitionTM() 'partitionTM( j# ]! b. Q, G0 M9 E4 f8 B2 J
% l; E) x# ~4 [& t0 {8 [
+ m- A- y+ }3 ~. X'link solidworks( C, c- [# N+ Z* [
5 O1 h/ Q8 c) ~Set swApp = Application.SldWorks+ w1 D3 {4 b7 ^# i5 p4 ~2 p
Set Part = swApp.ActiveDoc
8 z9 B2 K8 h" s6 T6 B) 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
7 U& d7 j2 m9 g6 Q/ ['設定變量& }. N& d* J$ W) S
9 W; |  R" V1 u5 D) rc = swApp.ActiveDoc.GetTitle() '零件名
5 U" K& u( A, g1 a, k6 x. {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("", "材料")
2 t& l4 r4 N, _& U; y& P! d9 n  V  X0 H+ J1 Yblnretval = Part.DeleteCustomInfo2("", "代號")3 w1 A4 Q. Z1 \, x1 N/ e; R
: X5 u8 {' x& z: }3 X% Bblnretval = Part.DeleteCustomInfo2("", "名稱"). }" r" K0 E! E
1 e% K" ^; Q0 Ublnretval = Part.DeleteCustomInfo2("", "材料")
; ~3 r# f) \% e. [% B+ U) d- F; R- ]4 V0 e- k2 J; Sa = InStr(c, " ") - 1
" v0 S% D. r) K$ `' iIf a > 0 Then
$ o& J0 V0 K- u7 E0 D& _% k+ M" K3 ~    k = Left(c, a)0 D( T  G4 u* @' Z: h# g5 h) k
) F$ B, Y: f5 b: B6 F6 A) W" t    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
    Else
8 c0 [; _6 J. ^& U) n! W2 i7 C- b( f1 H* X4 B; P        e = k& O7 M7 ]$ E: v$ n5 ]  ?0 p$ z
! }& t" Z, O' `# X5 y    End If! C- h9 R! k; n% D6 G+ S; P
    b = Mid(c, a + 2)
. M  n' ^4 K/ G3 j; ^1 a, _" o% b/ ^0 j8 S  T    t = Right(c, 7)
, W1 w6 X; K; Q+ l/ ?7 ?2 k( 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' \
( l" v9 }& E/ K* o' O    Else& f9 y# D- W/ Y! i& w- H
        j = Len(b); J( ?# E, |  ?
9 W( J- \/ a# d: j' E9 G0 n0 _    End If8 @/ x5 s, N; \. _& V# V
    m = Left(b, j)
  N1 U. Y  k) @0 ]. P: e' A' P) l4 b& \End If( o3 u- a' n" g; c4 t2 s& ]
. C% U, L7 j' ^3 A, Tblnretval = Part.AddCustomInfo3("", "代號", swCustomInfoText, e)
& w; }4 S0 }+ ^: F  K  N' M% L5 C4 Hblnretval = Part.AddCustomInfo3("", "名稱", swCustomInfoText, m)7 a/ m( J8 q$ B) ^& B( M# Q' V
0 g& T% w- G* D- b% x: yblnretval = Part.AddCustomInfo3("", "材料", swCustomInfoText, strmat)
9 Z0 O2 e0 Q6 cblnretval = Part.AddCustomInfo3("", "單重", swCustomInfoText, " ")
$ u9 R# s2 _; a) i# R! A0 u  V; G2 e# V. L; H; {2 wblnretval = Part.AddCustomInfo3("", "備註", swCustomInfoText, " ")
* x8 o) M6 P% A9 g8 P. k: i2 D6 }7 z- @1 t: i# Q, P, {! f% c" J- {6 u; t
End Sub
- N( |% @) O) W! P: e

ryouss

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

附swp繁体版   

ryouss

# F$ ^) J- B$ h7 ]7 C
試試把   CurCFGname = swApp.GetConfigurationNames

8 R& W7 E) g" q. @* ~2 \4 @改為      CurCFGname = swApp.GetConfigurationNames(swApp.ActiveDoc.GetPathName) '補加零件文件的路徑及名稱
2 |# r) T8 h$ z8 W8 D5 C' i: ]
在沒補加 (swApp.ActiveDoc.GetPathName) 時在2012及2015版是會有提示錯誤的(如附图)
另VBA編程在   " '  " 符號后的文字是會跳過不執行的.



8 ~4 t2 t9 q/ A- G4 x7 \% V

arter_2006

我试过了，改之前，改之后一个样，而且执行中没有任何错误提示。
, O: \4 b) I3 ]2 r& @6 e  t# Y' ******************************************************************************
' C:\Users\admin\AppData\Local\Temp\swx8144\Macro1.swb - macro recorded on 11/22/18 by mqlu
# X, J" ?: ^' ?' ******************************************************************************
' r8 t) t# \2 E1 w. sDim swApp As Object
# D5 J* z# ~9 b3 e$ I6 RDim Part As Object
Dim boolstatus As Boolean
/ I3 f* v( Q9 z8 \) N! QDim longstatus As Long, longwarnings As Long

! a' b* k0 E+ ~) a7 e& {3 EDim SelMgr As Object
" ^; E' x& I9 S# pDim Feature As Object
Dim a As Integer
Dim b As String
Dim m As String
2 \4 X- B0 C: a( H0 `: i& h& F: uDim 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
0 L3 S2 N. |. L) V$ I
' ^& o1 C8 P, A6 [& iSub main() '刪除所有配置属性
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
CurCFGname = swApp.GetConfigurationNames(swApp.ActiveDoc.GetPathName) '补加零件文件的路径及名称
$ u) @" d- S+ R" zCurCFGnameCount = Part.GetConfigurationCount
For i = 0 To CurCFGnameCount - 1
    Set CusPropMgr = Part.Extension.CustomPropertyManager(CurCFGname(i))
. w5 M0 m5 V9 M( M. k* I" c. |2 E    Vnamearr = CusPropMgr.GetNames
$ R& Q. S; j0 D& Q# B, b" B, o    If Not IsEmpty(Vnamearr) Then
! E$ s9 q3 J+ ?8 {! x        For Each Vnamearr2 In Vnamearr
            bRet = Part.DeleteCustomInfo2(CurCFGname(i), Vnamearr2)
% ^3 \) A) {! Q. B/ T% b: M; B  B        Next
" G' s6 T% _& T3 K0 d! b    End If
Next
3 R& e# b' J3 V2 H1 f# h: O1 xCall 刪除自定义属性
Call partitionTM
  a+ S+ r* R' X3 g8 H3 o- ^9 W
+ @# \7 D9 Q9 s1 e2 O: x$ M+ QEnd Sub

'~~~ 刪除自定义属性 ~~~
Sub 刪除自定义属性()
'Dim swApp As Object
Dim swModel2 As SldWorks.ModelDoc2
Dim vCustInfoNameArr2 As Variant

Set swApp = Application.SldWorks
9 W9 _5 M. u( e7 d, ~Set swModel2 = swApp.ActiveDoc
  \2 T, D( N% q: l! l% j$ XvCustInfoNameArr2 = swModel2.GetCustomInfoNames
  If Not IsEmpty(vCustInfoNameArr2) Then
     For Each vCustInfoName2 In vCustInfoNameArr2
         bRet = swModel2.DeleteCustomInfo(vCustInfoName2)
      Next
  End If
End Sub

'~~~ partitionTM ~~~
* L! _2 m% ]9 m. K/ hSub partitionTM() 'partitionTM

'link solidworks
: m" b; n! I% S$ m7 C6 m4 ^$ \! cSet swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
Set SelMgr = Part.SelectionManager
swApp.ActiveDoc.ActiveView.FrameState = 1
+ S) K, F. ]( R$ u, b  Q5 V2 g'设定变量
( B) L* z. ]. ^8 Rc = swApp.ActiveDoc.GetTitle() '零件名
strmat = Chr(34) + Trim("SW-Material" + "@") + c + Chr(34)
+ ^# `6 _& P" E5 r' s! b# @'tempvalue = Part.CustomInfo2("", "材料")
blnretval = Part.DeleteCustomInfo2("", "代号")
+ t3 V. v$ d2 wblnretval = Part.DeleteCustomInfo2("", "名称")
3 [* E, l  D9 @blnretval = Part.DeleteCustomInfo2("", "材料")
& O. @; A/ G' E* b8 E
( a; A: N4 a. G: v; h% n
a = InStr(c, " ") - 1
+ o3 {" z! R5 K" b6 ZIf a > 0 Then
; T; ~* U- Q5 t; q    k = Left(c, a)
    t = Left(LTrim(e), 3)

) c% O9 f; @0 K/ g9 {    If t = "GBT" Then
# y3 X; t$ L8 K& c( D8 @3 J  ?        e = "GB/T" + Mid(k, 4)
    Else
/ [2 W7 O4 U1 x        e = k
    End If
" u: q; h, n4 z) I4 L% Y
) E& u0 _6 ]& m$ F    b = Mid(c, a + 2)
    t = Right(c, 7)
    If t = ".SLDPRT" Or t = ".SLDASM" Then
        j = Len(b) - 7
/ D9 L, E# {: @3 M5 S! |0 {    Else
+ h3 W2 z9 B* ^& ^        j = Len(b)
% A7 s! w* s9 N" j. ?    End If
6 B! x' e  k0 a2 j, ^8 V    m = Left(b, j)
End If

blnretval = Part.AddCustomInfo3("", "代号", swCustomInfoText, e)
blnretval = Part.AddCustomInfo3("", "名称", swCustomInfoText, m)
) l+ A# C2 I5 \) J; J) Yblnretval = Part.AddCustomInfo3("", "材料", swCustomInfoText, strmat)
blnretval = Part.AddCustomInfo3("", "单重", swCustomInfoText, " ")
  l2 P/ d, l5 ^/ o$ E5 pblnretval = Part.AddCustomInfo3("", "备注", swCustomInfoText, " ")
/ s& p/ N3 a  o
End Sub