SOLIDWORKS 宏合并执行的问题

ryouss

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

' n' v4 d3 ~2 Z

1. ' ******************************************************************************
   
2. ' C:\Users\admin\AppData\Local\Temp\swx8144\Macro1.swb - macro recorded on 11/22/18 by mqlu
   . A. J- a1 M, H! b' Y" A6 D. F: T6 x
3. ' ******************************************************************************
   
4. Dim swApp As Object
   
5. Dim Part As Object
   
6. Dim boolstatus As Boolean
   
7. Dim longstatus As Long, longwarnings As Long
   
8. 
   4 B5 Y, G* s& ]( k1 x+ P! r
9. Dim SelMgr As Object
   $ x5 u. F( [  \9 c$ N) l0 }: r+ `& D+ I
10. Dim Feature As Object
    & B8 E4 i2 @+ F  G. z
11. Dim a As Integer
    
12. Dim b As String
    / w; o. m4 S: Y# @$ R& T' w, a5 m
13. Dim m As String
    
14. Dim e As String
    
15. Dim k As String
    
16. Dim t As String
    7 p; u* P; b. {; E/ D# K6 n+ }
17. Dim c As String
    
18. Dim j As Integer
    
19. Dim strmat As String
    - g3 j/ X4 m4 R( h5 D* z% c
20. Dim tempvalue As String
    
21. 
    
22. Sub main() '刪除所有配置屬性
    
23. Set swApp = Application.SldWorks
    
24. Set Part = swApp.ActiveDoc
    
25. CurCFGname = Part.GetConfigurationNames
    # T: k. m( m# |/ e, Y6 O
26. CurCFGnameCount = Part.GetConfigurationCount
    
27. For i = 0 To CurCFGnameCount - 1
    
28.     Set CusPropMgr = Part.Extension.CustomPropertyManager(CurCFGname(i))
    5 E6 e0 i# t' g; `5 R
29.     Vnamearr = CusPropMgr.GetNames
    - K( K8 Q+ e% B. [% S
30.     If Not IsEmpty(Vnamearr) Then
    " o3 z) {! q* t: Z
31.         For Each Vnamearr2 In Vnamearr
    
32.             bRet = Part.DeleteCustomInfo2(CurCFGname(i), Vnamearr2)
    6 M6 I! }5 O# L0 D  A
33.         Next
    
34.     End If
    
35. Next
    
36. Call 刪除自定義屬性
    
37. Call partitionTM
    
38. 
    4 X5 z1 E4 [4 R' w
39. End Sub
      x  m) i0 ~9 T9 B/ M' w
40. 
    ! P, ?0 F$ e! B' d! B+ o  Y
41. '~~~ 刪除自定義屬性 ~~~
    * m/ V- T! c( v7 g8 d8 v
42. Sub 刪除自定義屬性()
    " C9 y5 `" H! e% T- x+ V! S
43. 'Dim swApp As Object
    8 C2 `0 k/ n( L/ z- R
44. Dim swModel2 As SldWorks.ModelDoc2
    
45. Dim vCustInfoNameArr2 As Variant
    
46. 
    
47. Set swApp = Application.SldWorks
    
48. Set swModel2 = swApp.ActiveDoc
    / J: W( X$ j6 J& ]" n( i
49. vCustInfoNameArr2 = swModel2.GetCustomInfoNames
    
50.   If Not IsEmpty(vCustInfoNameArr2) Then
    
51.      For Each vCustInfoName2 In vCustInfoNameArr2
    * K$ E3 S* g, D" v
52.          bRet = swModel2.DeleteCustomInfo(vCustInfoName2)
    9 Y  }, J- m3 @- s) E6 p5 X
53.       Next
    ' S* W* X2 k/ v- a( N8 N; h
54.   End If
    
55. End Sub
    
56. 
    
57. '~~~ partitionTM ~~~
    - q6 O! E1 [4 Z5 t  }& ~( H4 f, \
58. Sub partitionTM() 'partitionTM
    . b# Y: b) S/ s8 n% s
59. 
    
60. 'link solidworks
    
61. Set swApp = Application.SldWorks
    
62. Set Part = swApp.ActiveDoc
    + Y; f, n6 Q% o0 h
63. Set SelMgr = Part.SelectionManager
    % h/ M* l, _+ l+ ]" q
64. swApp.ActiveDoc.ActiveView.FrameState = 1
    6 y2 A+ Q6 O/ C* p" @! P. j
65. '設定變量
    3 X7 r' |: c9 n$ G
66. c = swApp.ActiveDoc.GetTitle() '零件名
    % l: T7 a0 X6 @  U% i* S
67. strmat = Chr(34) + Trim("SW-Material" + "@") + c + Chr(34)
    
68. 'tempvalue = Part.CustomInfo2("", "材料")
    
69. blnretval = Part.DeleteCustomInfo2("", "代號")
    + c$ Q0 X- K4 W8 ?
70. blnretval = Part.DeleteCustomInfo2("", "名稱")
    8 a+ u4 g/ }4 ]& v0 l2 _6 u% j
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)
    % A2 R5 O' q/ s  y
76.     If t = "GBT" Then
    
77.         e = "GB/T" + Mid(k, 4)
    
78.     Else
    - _% D. a5 O0 ?8 V4 t& b" J
79.         e = k
    
80.     End If
    
81.     b = Mid(c, a + 2)
    % a" X4 B8 T9 p( R
82.     t = Right(c, 7)
    ! n0 u( B/ [, p6 J0 Z
83.     If t = ".SLDPRT" Or t = ".SLDASM" Then
    3 L! x0 ~& ]1 J; W6 I
84.         j = Len(b) - 7
    # ~3 y  q3 e# j" O8 d$ H
85.     Else
    
86.         j = Len(b)
    5 P. B* x6 x3 I* L0 a7 e( L
87.     End If
    7 t! m9 n3 }( U; @0 v
88.     m = Left(b, j)
    ' H) `. S! r, h2 A" u3 x8 F
89. End If
    / W; `* p5 [) Q9 o- o* V
90. blnretval = Part.AddCustomInfo3("", "代號", swCustomInfoText, e)
    / }1 o8 ]7 U( }% B
91. blnretval = Part.AddCustomInfo3("", "名稱", swCustomInfoText, m)
    
92. blnretval = Part.AddCustomInfo3("", "材料", swCustomInfoText, strmat)
    
93. blnretval = Part.AddCustomInfo3("", "單重", swCustomInfoText, " ")
    + O# L9 g" P8 w
94. blnretval = Part.AddCustomInfo3("", "備註", swCustomInfoText, " ")
    
95. 
    $ ~( k) T- d# }  I6 W' q
96. End Sub

复制代码

# l; u, |1 J, v: r9 I- G5 J! ~6 o

arter_2006

ryouss 发表于 2018-11-25 11:32
& Y! r. P" g* U0 K9 g+ s' b& O0 u0 H就是如下的繁体字改為簡体字就是

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

  g8 g3 c$ s' T  m( \' ******************************************************************************
' C:\Users\admin\AppData\Local\Temp\swx8144\Macro1.swb - macro recorded on 11/22/18 by mqlu
5 e4 G7 N9 {, v- t' ******************************************************************************
Dim swApp As Object
0 B7 d  C' V) Z" @) `; A- W' }6 j. yDim Part As Object
Dim boolstatus As Boolean
, `( a/ r  M2 ?0 lDim longstatus As Long, longwarnings As Long

- s$ X/ N( k- I0 h+ k% L# XDim SelMgr As Object
7 |, r: {" p- V0 A2 cDim Feature As Object
Dim a As Integer
! A! `$ V* I* E/ ~; V( @; eDim b As String
Dim m As String
Dim e As String
Dim k As String
2 H) ~: q, k8 ?Dim t As String
Dim c As String
% h( Q; P/ v( M& t: a- qDim j As Integer
8 A9 a' G1 E$ ^# e5 y1 T$ S( DDim strmat As String
Dim tempvalue As String
% ?+ f4 m# w) d6 d4 ]- Q  m- d
Sub main() '刪除所有配置属性
- D8 s# V3 c" f7 M/ O  ^' R3 vSet swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
CurCFGname = Part.GetConfigurationNames
  S" M$ C7 I; cCurCFGnameCount = Part.GetConfigurationCount
% R4 x: S. ]$ O. m- S# g4 ~( |For i = 0 To CurCFGnameCount - 1
* @/ ?) c7 g: T5 t' R  ^* R  }    Set CusPropMgr = Part.Extension.CustomPropertyManager(CurCFGname(i))
    Vnamearr = CusPropMgr.GetNames
    If Not IsEmpty(Vnamearr) Then
8 e0 p5 W, H* v        For Each Vnamearr2 In Vnamearr
3 h6 i2 l- L8 O- K' T; k3 _, a: ]) A            bRet = Part.DeleteCustomInfo2(CurCFGname(i), Vnamearr2)
' ]1 a$ v8 N$ ^: R2 T/ X        Next
# r/ _5 @2 }2 A$ q7 @9 ?    End If
Next
9 F& X4 J0 K2 W: D( ]; ZCall 刪除自定义属性
" J! c  Y1 g4 R: P! L& ECall partitionTM
; U$ I- M+ L- M4 Y& w* X( i$ F, x; s
" V' w/ U  E# \" `- [8 nEnd Sub

4 Q6 S% P8 G5 `6 i' u8 d/ F0 ^'~~~ 刪除自定义属性 ~~~
Sub 刪除自定义属性()
9 Q7 K* b0 N' x( K8 J0 B$ q6 Q6 i'Dim swApp As Object
Dim swModel2 As SldWorks.ModelDoc2
, [% m) q' n- x3 [Dim vCustInfoNameArr2 As Variant
& r( G+ Y  V6 `- v4 A* a# p
* x" A5 x) O/ H. J4 dSet swApp = Application.SldWorks
. f' U) k0 K5 wSet swModel2 = swApp.ActiveDoc
; n; \& d0 o2 KvCustInfoNameArr2 = swModel2.GetCustomInfoNames
  If Not IsEmpty(vCustInfoNameArr2) Then
     For Each vCustInfoName2 In vCustInfoNameArr2
; V% O6 O1 y' U3 M( r         bRet = swModel2.DeleteCustomInfo(vCustInfoName2)
      Next
  End If
End Sub

'~~~ partitionTM ~~~
Sub partitionTM() 'partitionTM
, s+ a* E7 g+ r1 _) _
" h: I7 T6 x/ o+ L0 M'link solidworks
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
, b0 r3 L6 y. H: B: P  p% |Set SelMgr = Part.SelectionManager
swApp.ActiveDoc.ActiveView.FrameState = 1
'设定变量
c = swApp.ActiveDoc.GetTitle() '零件名
strmat = Chr(34) + Trim("SW-Material" + "@") + c + Chr(34)
'tempvalue = Part.CustomInfo2("", "材料")
blnretval = Part.DeleteCustomInfo2("", "代号")
blnretval = Part.DeleteCustomInfo2("", "名称")
' A- |* h! ]1 W2 Oblnretval = Part.DeleteCustomInfo2("", "材料")
, ]2 P. e: ~* Ta = InStr(c, " ") - 1
7 G4 [4 C+ p+ R/ @( RIf a > 0 Then
; P9 J& k6 [' `, J    k = Left(c, a)
. c- H3 x( T: }3 C9 }    t = Left(LTrim(e), 3)
    If t = "GBT" Then
& w6 _8 L3 n+ F3 ~% l7 V        e = "GB/T" + Mid(k, 4)
    Else
- W, M/ z2 W) Q( \8 e$ O        e = k
. Z4 B; p/ ]" }2 F    End If
    b = Mid(c, a + 2)
4 @* O, a8 w( ~8 C, N: ]! L0 r    t = Right(c, 7)
6 X# W+ o3 J6 `; M5 d    If t = ".SLDPRT" Or t = ".SLDASM" Then
        j = Len(b) - 7
( Y0 I5 F$ U2 ~& t/ f& C3 v! V$ L    Else
$ a- E3 S. a9 ]' s, a        j = Len(b)
4 f9 {5 ]7 \" |" G: A3 Z( g0 C    End If
' U( u5 {/ e& A; k! G- V% ?6 F5 p2 P    m = Left(b, j)
0 z, _+ }6 h7 k/ d6 NEnd If
) e& R. {2 }! wblnretval = Part.AddCustomInfo3("", "代号", swCustomInfoText, e)
/ |$ ~0 m( q6 jblnretval = Part.AddCustomInfo3("", "名称", swCustomInfoText, m)
$ c+ r3 W) o0 Sblnretval = Part.AddCustomInfo3("", "材料", swCustomInfoText, strmat)
( U. \% p" w' i, ~0 rblnretval = Part.AddCustomInfo3("", "单重", swCustomInfoText, " ")
4 K! Y# j) P# _  P  dblnretval = Part.AddCustomInfo3("", "备注", swCustomInfoText, " ")

End Sub
  l; W: m6 l7 L

ryouss

& M& L) n4 n1 k9 o8 J' l

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

4 _4 a; W. l/ i  }' ********************************** ...

% |2 d* V& i/ F0 P5 P  L3 csw2017 測試OK
7 @- E' O" l8 K2 D/ D有否顯示什麼錯誤提示?




# q: x6 j& F# \

arter_2006

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

ryouss

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

2018 沒版本能試

arter_2006

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

6 j4 c4 C; Y, c/ s/ b非常感谢您，让您费心了。
) c# \: O4 |9 A! e" R

arter_2006

ryouss 发表于 2018-11-26 17:05
2 y8 o- [: D6 j( f  {4 t$ `2018 沒版本能試

9 ?" t) y. F" ]3 Y" ~, q能否把您的SWP文件发上来，我刚才用solidworks 2014也试了一下，发现也不行，但是别的宏都可以。
7 i6 D& g; b  a我从网页上复制下来的都变成下面这个样子了，所以要删掉很多多出来的东西，我怀疑是不是这个原因导致的，但是校对很费时间，也难发现。
% C/ ]  Z. k& a5 Y5 h% Z
  J6 m0 Q& v. l0 R; [0 M! W' ******************************************************************************3 \3 X) J3 n, I6 @4 |0 x
7 ^7 g7 V2 w7 ~3 e' 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 _
Dim longstatus As Long, longwarnings As Long
1 N- G# `& `' e  i% _$ }4 [4 B1 W8 u' q( \3 d4 Y/ K1 v" N; D
" C5 x& E- d" D! _' \7 D3 J( R9 \8 _3 m& \) d/ \Dim SelMgr As Object
: S& D4 E8 I: d4 K4 q9 f0 e& f5 HDim Feature As Object
! [9 }; C5 Z+ V- o+ y9 G2 @9 Z7 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
- W/ K$ M8 c1 L) qDim 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
% R* ?6 C5 B( @3 D& DDim c As String
2 |! u: ]+ Z+ I( P! K3 d. @4 X+ d/ Q. _. p: yDim j As Integer3 N( z+ v  K2 q* v6 D
# l( ]3 U& R9 \0 ~Dim strmat As String
" F! d7 t6 p- DDim tempvalue As String
7 a1 F$ v( H) h9 I- {5 i1 C- ]& E& r" D5 F  G0 |% Q: b, Y
$ J  P6 I% v2 X( t5 x- o) ?$ `2 a( G& L5 x7 Q- B3 Z( ISub main() '刪除所有配置屬性
+ A* K# h; d( k5 S; c8 H3 l/ z* n* R9 KSet swApp = Application.SldWorks9 g. p. p7 K6 u7 ?4 x4 W6 n
Set Part = swApp.ActiveDoc$ q6 |& ^2 b7 ~/ ]( ^0 R
CurCFGname = Part.GetConfigurationNames
3 o+ t7 a8 p2 a0 j0 |6 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))
' d! j4 `2 ^+ s  j. G( J! L$ ?  c% B6 }    Vnamearr = CusPropMgr.GetNames4 B$ N4 Q* X) q- [; f8 r0 ^5 {
# \" ~6 C" M, l$ W    If Not IsEmpty(Vnamearr) Then' t" n; u" h( T
        For Each Vnamearr2 In Vnamearr
) ]! L5 X% O  @+ E- n8 t& |, B: B/ V9 S4 d, F7 Z            bRet = Part.DeleteCustomInfo2(CurCFGname(i), Vnamearr2)+ h. {$ P6 Q5 M: i
9 ?0 x9 G4 }  p        Next- P& E; Z$ s7 V+ a( t' E% T
4 _5 E8 |) N3 D$ B3 y9 u( S    End If
2 }  y8 R3 T; ^  w& r$ A3 @6 S" n' d2 eNext
3 e, T# L# O) M  Z. ?1 B% ?  k" k4 f; K$ vCall 刪除自定義屬性
( A- x) f" C" d8 G6 }) {# {' iCall partitionTM4 }2 o$ e' E7 t

: `6 k9 z, x( m6 z2 @8 q. ~" b  {% q" `4 h6 {End Sub
% e; G6 r) ]# @' p
" D7 r# [' m2 U5 Z7 k9 B. O: ?'~~~ 刪除自定義屬性 ~~~
1 u0 k9 R' f2 z: 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
) [" M; y% y" N+ g- A# O3 P- f6 [! f' g# o6 S, e, W4 z+ EDim vCustInfoNameArr2 As Variant7 J* i  U% A! t0 \0 D! h, V
+ X# v- e# j- T5 M0 y! j7 n( z/ Q
7 Q" C7 y5 H0 Z: q- K" x+ X- v- E% b! h6 i* p! ], |9 USet swApp = Application.SldWorks
0 O+ x! U# a& K1 ?6 j8 D" ]4 S  i4 [' W6 ]0 I* U0 V' O' B+ NSet swModel2 = swApp.ActiveDoc3 u) Z+ D2 D4 z; M# d4 {
5 ^! s2 Q3 F/ ]: ^/ ~& ~& JvCustInfoNameArr2 = swModel2.GetCustomInfoNames- N/ C9 m0 n2 t* k9 u
3 o) q% ~5 f7 D  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
         bRet = swModel2.DeleteCustomInfo(vCustInfoName2)
4 y* T5 [0 N9 _; ]* t2 q. ?" R/ r# I! y' x7 _' X      Next9 U+ R% V2 G# P
: ]/ z( y6 J0 r  End If
: k" X/ E3 @( V, |& i& 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
. ?  R! r6 g+ L8 N* p7 c3 qSub partitionTM() 'partitionTM( j# ]! b. Q, G0 M9 E4 f8 B2 J
( }+ W: h/ o0 m% l; E) x# ~4 [& t0 {8 [
8 X5 K/ X  ]5 T9 i% S; a'link solidworks( C, c- [# N+ Z* [
Set swApp = Application.SldWorks+ w1 D3 {4 b7 ^# i5 p4 ~2 p
Set Part = swApp.ActiveDoc
" Q; C' Q! B! i+ {% \) 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() '零件名
; V5 P% {2 ]3 W! y- b. {8 L5 ~" z0 y# g! I" Estrmat = Chr(34) + Trim("SW-Material" + "@") + c + Chr(34). w+ f3 v( W- `* D! G! v. z
7 R# k2 q& {- a5 e+ }'tempvalue = Part.CustomInfo2("", "材料")
& U; y& P! d9 n  V  X0 H+ J1 Yblnretval = Part.DeleteCustomInfo2("", "代號")3 w1 A4 Q. Z1 \, x1 N/ e; R
; Z+ W8 m  Q2 [  y# Zblnretval = Part.DeleteCustomInfo2("", "名稱"). }" r" K0 E! E
blnretval = Part.DeleteCustomInfo2("", "材料")
2 g6 J5 n8 g) D; D8 V! }+ U) d- F; R- ]4 V0 e- k2 J; Sa = InStr(c, " ") - 1
# w* w) D/ E5 V2 I6 A' v4 [" v0 S% D. r) K$ `' iIf a > 0 Then
7 E% Y; ]0 m1 l' G6 o6 B7 m0 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
, }# S7 g# O' J  U: k: n    If t = "GBT" Then0 a: k4 H  }1 j) y
+ }# H0 S( i5 f8 g8 I6 z        e = "GB/T" + Mid(k, 4)0 C& x4 F4 D' ], i* s8 T
3 Q% ?% b* f0 u0 n: d3 P  A    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)
( 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' \
* e1 y+ L* W1 I5 q    Else& f9 y# D- W/ Y! i& w- H
. P; q# {5 A0 j        j = Len(b); J( ?# E, |  ?
    End If8 @/ x5 s, N; \. _& V# V
    m = Left(b, j)
+ b* w/ X  t( g& S4 n. P: e' A' P) l4 b& \End If( o3 u- a' n" g; c4 t2 s& ]
' W  E5 y+ R* C( Rblnretval = 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)
3 b. e# D* f( ^  u9 Z0 O2 e0 Q6 cblnretval = Part.AddCustomInfo3("", "單重", swCustomInfoText, " ")
  V; G2 e# V. L; H; {2 wblnretval = Part.AddCustomInfo3("", "備註", swCustomInfoText, " ")
1 I4 X9 Q) p! i0 h" I. v# J- k: i2 D6 }7 z- @1 t: i# Q, P, {! f% c" J- {6 u; t
End Sub

$ I" h4 [/ N/ g8 M6 [7 f) W7 z

ryouss

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

附swp繁体版   
1 K  [7 |- n+ A6 p- n0 E

ryouss

+ r% W9 H0 M) z, |' H
試試把   CurCFGname = swApp.GetConfigurationNames
, V. _: n( v9 g) H( m+ Z6 R* h8 E
改為      CurCFGname = swApp.GetConfigurationNames(swApp.ActiveDoc.GetPathName) '補加零件文件的路徑及名稱

在沒補加 (swApp.ActiveDoc.GetPathName) 時在2012及2015版是會有提示錯誤的(如附图)
另VBA編程在   " '  " 符號后的文字是會跳過不執行的.

  t8 r0 f, g" j/ B' {* M

# D" ^: C; r5 ?, E% M) A

arter_2006

我试过了，改之前，改之后一个样，而且执行中没有任何错误提示。
' ******************************************************************************
) h3 u+ E. ?& v1 N3 _) k' C:\Users\admin\AppData\Local\Temp\swx8144\Macro1.swb - macro recorded on 11/22/18 by mqlu
' ******************************************************************************
. G6 z* z: ~+ NDim swApp As Object
Dim Part As Object
( ]# l% T6 m( \0 h7 r+ |  ]! X3 UDim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
8 a/ z% J5 r& O
' T+ `. |- N8 S1 Y3 n2 m- V9 H. ~' oDim SelMgr As Object
Dim Feature As Object
Dim a As Integer
' X" J4 C$ h5 v" oDim b As String
Dim m As String
Dim e As String
Dim k As String
+ I. w9 r; ~  Q7 P- [Dim t As String
Dim c As String
Dim j As Integer
Dim strmat As String
$ u+ j+ o% y  Z! d0 tDim tempvalue As String
; t, E3 A: r5 N0 S. E
" ?) D, R8 v# g  p5 ~1 ySub main() '刪除所有配置属性
# Q% l/ @* X) d: M4 j, {Set swApp = Application.SldWorks
  `2 K; M7 i3 i& i' x: |% JSet Part = swApp.ActiveDoc
( |1 e4 p6 e% H- \5 R1 S) r& ICurCFGname = swApp.GetConfigurationNames(swApp.ActiveDoc.GetPathName) '补加零件文件的路径及名称
# {1 Y/ I8 q7 b7 A  E. MCurCFGnameCount = Part.GetConfigurationCount
For i = 0 To CurCFGnameCount - 1
' M- q! }: I' d! f- b    Set CusPropMgr = Part.Extension.CustomPropertyManager(CurCFGname(i))
    Vnamearr = CusPropMgr.GetNames
9 c# @/ _1 V, m0 {$ ?7 O( l    If Not IsEmpty(Vnamearr) Then
" O. u+ a: w" g  _6 ^1 _2 l$ P: _; e        For Each Vnamearr2 In Vnamearr
            bRet = Part.DeleteCustomInfo2(CurCFGname(i), Vnamearr2)
        Next
    End If
Next
Call 刪除自定义属性
Call partitionTM
( D4 ]7 Q$ o6 ?3 z) J4 M
End Sub

'~~~ 刪除自定义属性 ~~~
Sub 刪除自定义属性()
: E2 i: ]3 R8 f' K- }% Y2 x: s'Dim swApp As Object
Dim swModel2 As SldWorks.ModelDoc2
0 ?2 l2 E/ q9 u  ~( A) z4 ^Dim vCustInfoNameArr2 As Variant

Set swApp = Application.SldWorks
Set swModel2 = swApp.ActiveDoc
6 P' a4 w6 Y/ W: e5 ?0 ~vCustInfoNameArr2 = swModel2.GetCustomInfoNames
0 {! [. _+ {& R% V5 C/ S' _  If Not IsEmpty(vCustInfoNameArr2) Then
# b1 u' O7 X) _# f$ ?     For Each vCustInfoName2 In vCustInfoNameArr2
  v2 f6 ^, ~  S% K( a         bRet = swModel2.DeleteCustomInfo(vCustInfoName2)
      Next
  End If
3 c0 U" |8 l6 V4 S& I5 O; t/ NEnd Sub
3 \! k/ B  d! ]1 Z& i
+ F. @, U' S! j9 }' m'~~~ partitionTM ~~~
: C: T  A( b. _9 pSub partitionTM() 'partitionTM
0 C5 z1 x+ j, K; b: v
/ K6 r  X( w& M3 S'link solidworks
Set swApp = Application.SldWorks
5 T, p2 [+ m$ m" S& `6 cSet Part = swApp.ActiveDoc
0 x# x2 X% C% k1 K& P* D2 p" ^Set SelMgr = Part.SelectionManager
( C. \  ^) {  Q, X, X2 ~! iswApp.ActiveDoc.ActiveView.FrameState = 1
0 P1 C- m! s5 n2 I3 S/ _0 Z'设定变量
c = swApp.ActiveDoc.GetTitle() '零件名
! m0 {1 D9 O/ b1 @4 [) S; sstrmat = Chr(34) + Trim("SW-Material" + "@") + c + Chr(34)
'tempvalue = Part.CustomInfo2("", "材料")
blnretval = Part.DeleteCustomInfo2("", "代号")
1 D+ M5 z& l) x' C& R& N! s  v3 l6 ?blnretval = Part.DeleteCustomInfo2("", "名称")
9 Q  s/ f: v. X, Yblnretval = Part.DeleteCustomInfo2("", "材料")
$ g) J& L! _1 o2 H

a = InStr(c, " ") - 1
% q5 t7 W; `: j# S# ?If a > 0 Then
- l" @  B& U" w* }& z) ^    k = Left(c, a)
& V: z, I4 {/ l3 R& [+ Y    t = Left(LTrim(e), 3)
! d9 {+ j- E, y
    If t = "GBT" Then
        e = "GB/T" + Mid(k, 4)
    Else
3 K& I* F0 j- p3 l5 U        e = k
    End If

    b = Mid(c, a + 2)
8 s4 Z, I, w+ J. [; T! t    t = Right(c, 7)
$ C9 ]: y3 d4 B) H9 @  J    If t = ".SLDPRT" Or t = ".SLDASM" Then
        j = Len(b) - 7
+ r  u7 O4 M3 v" E4 O. U4 |    Else
        j = Len(b)
- {; u! T9 c. W$ s- A  n    End If
- n& U9 x. E4 i  C    m = Left(b, j)
; e- i6 e( y/ ~8 w2 m0 ~End If

' m! y# N  U5 \2 ^# X& ^" sblnretval = Part.AddCustomInfo3("", "代号", swCustomInfoText, e)
blnretval = Part.AddCustomInfo3("", "名称", swCustomInfoText, m)
blnretval = Part.AddCustomInfo3("", "材料", swCustomInfoText, strmat)
1 R; V' j( F. U% ablnretval = Part.AddCustomInfo3("", "单重", swCustomInfoText, " ")
& p7 S7 `$ p4 E1 |* cblnretval = Part.AddCustomInfo3("", "备注", swCustomInfoText, " ")
& {$ P) G% m  q( e0 L' l( ~
End Sub