SOLIDWORKS 宏合并執(zhí)行的問題

ryouss

就是如下的繁體字改為簡(jiǎn)體字就是

1. ' ******************************************************************************
   
2. ' C:\Users\admin\AppData\Local\Temp\swx8144\Macro1.swb - macro recorded on 11/22/18 by mqlu
   
3. ' ******************************************************************************
   
4. Dim swApp As Object
   6 ~, z% `, E! R* X2 _& H6 n% F
5. Dim Part As Object
   
6. Dim boolstatus As Boolean
   
7. Dim longstatus As Long, longwarnings As Long
   
8. 
   8 G7 F2 X: i& s( K2 [4 W- m: p
9. Dim SelMgr As Object
   ; `: o' |7 N- g) ^: q: B6 H
10. Dim Feature As Object
    
11. Dim a As Integer
    
12. Dim b As String
    
13. Dim m As String
    
14. Dim e As String
    7 \  C5 D# q: ]6 C) L0 R- u
15. Dim k As String
    : b' K* U! u$ |1 T: K
16. Dim t As String
    
17. Dim c As String
    0 x7 n" |+ ~  [2 K% D( t
18. Dim j As Integer
    ; i! i: o3 j: |
19. Dim strmat As String
    
20. Dim tempvalue As String
    2 i4 C/ H7 n# S
21. 
    : f: v) h+ F  h8 _$ c( I1 q5 J
22. Sub main() '刪除所有配置屬性
    # A7 C/ \. k( h3 a. |! S
23. Set swApp = Application.SldWorks
    * q) P" U4 L6 o. [. y, |
24. Set Part = swApp.ActiveDoc
    ( S1 u0 `2 C2 j! p0 ^. e
25. CurCFGname = Part.GetConfigurationNames
    5 p0 ^8 D4 ?6 D; D9 l/ V) f* V
26. CurCFGnameCount = Part.GetConfigurationCount
    3 x, Y; m) S  y2 M) L: N
27. For i = 0 To CurCFGnameCount - 1
    6 }2 L: S1 G# e9 z
28.     Set CusPropMgr = Part.Extension.CustomPropertyManager(CurCFGname(i))
    : w. e, H/ L7 Q: S
29.     Vnamearr = CusPropMgr.GetNames
    
30.     If Not IsEmpty(Vnamearr) Then
    
31.         For Each Vnamearr2 In Vnamearr
    
32.             bRet = Part.DeleteCustomInfo2(CurCFGname(i), Vnamearr2)
    
33.         Next
    6 g# x9 H3 |; C% M9 L
34.     End If
    
35. Next
    
36. Call 刪除自定義屬性
    ' [2 X# Z+ V# c5 s
37. Call partitionTM
    
38. 
    ) B0 z0 q  o$ g, B( U7 x
39. End Sub
    
40. 
    
41. '~~~ 刪除自定義屬性 ~~~
    & A3 G+ t# Y* i0 Q! Q( E
42. Sub 刪除自定義屬性()
    
43. 'Dim swApp As Object
    
44. Dim swModel2 As SldWorks.ModelDoc2
    # p: U/ b) R/ }' }  H* w* a. V
45. Dim vCustInfoNameArr2 As Variant
    
46. 
    : z( @$ {# _: N' s4 |* I; z
47. Set swApp = Application.SldWorks
    3 v4 p  B& R% S9 r8 U
48. Set swModel2 = swApp.ActiveDoc
    4 `, |5 |3 U4 {* ~
49. vCustInfoNameArr2 = swModel2.GetCustomInfoNames
    - e& `# h" I' c7 r% _1 p- L" Y
50.   If Not IsEmpty(vCustInfoNameArr2) Then
    
51.      For Each vCustInfoName2 In vCustInfoNameArr2
    / n7 t+ ]" U+ @( N
52.          bRet = swModel2.DeleteCustomInfo(vCustInfoName2)
    
53.       Next
    " k4 c! ?) Z  }- X
54.   End If
    , h2 e( @" c' i
55. End Sub
    ' D! C( k7 a% ~+ v) I3 _- Q) |
56. 
    
57. '~~~ partitionTM ~~~
    
58. Sub partitionTM() 'partitionTM
    
59. 
    7 \3 ^, A" G& z; G! \
60. 'link solidworks
    
61. Set swApp = Application.SldWorks
    ( j! ?- s: W( x5 O, m6 s7 w
62. Set Part = swApp.ActiveDoc
    : b( h+ W8 |) a, u  D6 g2 |
63. Set SelMgr = Part.SelectionManager
    + T$ q" f1 w$ S4 A4 \- _3 N
64. swApp.ActiveDoc.ActiveView.FrameState = 1
    
65. '設(shè)定變量
    ) k0 K$ `. @5 }3 B% g' I
66. c = swApp.ActiveDoc.GetTitle() '零件名
    
67. strmat = Chr(34) + Trim("SW-Material" + "@") + c + Chr(34)
    ! X. m2 x& z3 q. C# e0 l
68. 'tempvalue = Part.CustomInfo2("", "材料")
    
69. blnretval = Part.DeleteCustomInfo2("", "代號(hào)")
    & u( g% c4 k+ i6 K6 Q# w! a
70. blnretval = Part.DeleteCustomInfo2("", "名稱")
    
71. blnretval = Part.DeleteCustomInfo2("", "材料")
    ( Z3 y/ U& G, Z& c7 `
72. a = InStr(c, " ") - 1
    
73. If a > 0 Then
    + b" d6 s) c  i5 U* a
74.     k = Left(c, a)
    
75.     t = Left(LTrim(e), 3)
    ( j" z$ I3 ~/ U  a
76.     If t = "GBT" Then
    / x, i3 R2 x. M5 A$ y
77.         e = "GB/T" + Mid(k, 4)
    
78.     Else
    
79.         e = k
    * }% X3 @9 p) Y" P, O
80.     End If
    3 c( Z' b3 @* Q: V( M
81.     b = Mid(c, a + 2)
    4 R! z4 C% D) G6 C/ Z1 `
82.     t = Right(c, 7)
    
83.     If t = ".SLDPRT" Or t = ".SLDASM" Then
    8 l/ I& c& V- [, [. s0 a' C" w: |" n
84.         j = Len(b) - 7
    
85.     Else
    
86.         j = Len(b)
    + a" Y+ J# b9 n7 ]# s! t
87.     End If
    3 S) l3 ^: z1 K  {& j& x
88.     m = Left(b, j)
    
89. End If
    
90. blnretval = Part.AddCustomInfo3("", "代號(hào)", swCustomInfoText, e)
    % r8 O6 b! z, q
91. blnretval = Part.AddCustomInfo3("", "名稱", swCustomInfoText, m)
    
92. blnretval = Part.AddCustomInfo3("", "材料", swCustomInfoText, strmat)
    
93. blnretval = Part.AddCustomInfo3("", "單重", swCustomInfoText, " ")
    
94. blnretval = Part.AddCustomInfo3("", "備註", swCustomInfoText, " ")
    
95. 
    ! x8 \  z6 `# U( d, o" y8 I
96. End Sub

復(fù)制代碼

arter_2006

ryouss 發(fā)表于 2018-11-25 11:32
' t0 @1 `, o* G- R' E9 x9 w就是如下的繁體字改為簡(jiǎn)體字就是

執(zhí)行后無反應(yīng)，屬性都沒改，不知道問題出在哪里？讓您費(fèi)心了。
+ _1 q7 S' M: @$ e# p% ]
' ******************************************************************************
$ Y: m) Y7 e; \$ Z' C:\Users\admin\AppData\Local\Temp\swx8144\Macro1.swb - macro recorded on 11/22/18 by mqlu
' ******************************************************************************
Dim swApp As Object
. t# j+ U0 H; h# u1 [8 ?Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
" S  g/ m0 R% R. ~- \, R6 }& J
' d# @2 ]7 r/ FDim SelMgr As Object
Dim Feature As Object
Dim a As Integer
Dim b As String
5 {. |. k6 `; _Dim m As String
2 W# I# c$ A" e6 O1 [. K1 SDim e As String
2 f* I8 J" |5 s  kDim k As String
Dim t As String
Dim c As String
Dim j As Integer
- D; ?) p# B# [. E9 \2 ?Dim strmat As String
Dim tempvalue As String
- {' K& m' `  d! w$ W9 q* t
- t  H4 x4 N( y( lSub main() '刪除所有配置屬性
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
" I3 |3 T5 C. G. I4 u6 q& R2 rCurCFGname = Part.GetConfigurationNames
CurCFGnameCount = Part.GetConfigurationCount
For i = 0 To CurCFGnameCount - 1
+ f) w$ T3 L: K( _  u    Set CusPropMgr = Part.Extension.CustomPropertyManager(CurCFGname(i))
4 ^" v4 e* \) M5 \2 Y    Vnamearr = CusPropMgr.GetNames
    If Not IsEmpty(Vnamearr) Then
        For Each Vnamearr2 In Vnamearr
            bRet = Part.DeleteCustomInfo2(CurCFGname(i), Vnamearr2)
        Next
    End If
Next
1 M+ v+ j* c0 j. e2 xCall 刪除自定義屬性
Call partitionTM

End Sub

: E, }( d; O' m1 `'~~~ 刪除自定義屬性 ~~~
0 `& g) g* N6 R. O4 D% S: s) ?, hSub 刪除自定義屬性()
'Dim swApp As Object
Dim swModel2 As SldWorks.ModelDoc2
. ~* r, J. I% o; h6 N3 ?0 IDim vCustInfoNameArr2 As Variant

Set swApp = Application.SldWorks
- s) g8 Z, C& o: A' o# rSet swModel2 = swApp.ActiveDoc
" P; o6 x  |7 p9 K# avCustInfoNameArr2 = swModel2.GetCustomInfoNames
5 {+ h* G. m  G# Y+ u  If Not IsEmpty(vCustInfoNameArr2) Then
# |7 V. |% r* H: n     For Each vCustInfoName2 In vCustInfoNameArr2
         bRet = swModel2.DeleteCustomInfo(vCustInfoName2)
/ D) f* Z6 G2 D      Next
  End If
& p2 T# l5 u  c4 Y& mEnd Sub
' E; \5 G, ]/ m% ~! k
! J9 [# s. C$ I( f4 ]$ V6 n'~~~ partitionTM ~~~
: K8 Q4 ?0 G5 U5 ^% F) `1 I* p2 aSub partitionTM() 'partitionTM

/ [7 n$ B3 Y0 C# g2 V8 Q# B1 H'link solidworks
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
' n! f- ^! J# D0 A8 x# m+ Q5 t8 v$ iSet SelMgr = Part.SelectionManager
7 |! N" c) G( V% J$ R* B+ n% P0 [swApp.ActiveDoc.ActiveView.FrameState = 1
9 J* W5 \: r/ f0 D$ @) P* w'設(shè)定變量
c = swApp.ActiveDoc.GetTitle() '零件名
strmat = Chr(34) + Trim("SW-Material" + "@") + c + Chr(34)
* B* ]1 @2 D1 m& Y'tempvalue = Part.CustomInfo2("", "材料")
blnretval = Part.DeleteCustomInfo2("", "代號(hào)")
blnretval = Part.DeleteCustomInfo2("", "名稱")
- }) X( l! t% Y, {% c0 g1 g5 b9 tblnretval = Part.DeleteCustomInfo2("", "材料")
7 `; B$ i, @& Y0 I% Ba = InStr(c, " ") - 1
5 a$ d4 Z& R" b$ J" |$ OIf a > 0 Then
) D2 l/ @# u1 P7 ^* i: d+ e    k = Left(c, a)
- a2 E( D/ L) I    t = Left(LTrim(e), 3)
    If t = "GBT" Then
) `' h, p& d5 n# q" X: }        e = "GB/T" + Mid(k, 4)
    Else
  y( }+ M. R5 M1 ]4 I        e = k
: C: l# F. _! J# u- R6 \% g    End If
    b = Mid(c, a + 2)
8 z" T1 j2 _' A) S3 l! H    t = Right(c, 7)
. o3 F5 s* v. E* Y" c    If t = ".SLDPRT" Or t = ".SLDASM" Then
1 {9 P$ e' {2 p# O, r3 W* U3 J2 p        j = Len(b) - 7
    Else
        j = Len(b)
& @6 A  z! P: ]% L' |8 ]5 B    End If
    m = Left(b, j)
End If
blnretval = Part.AddCustomInfo3("", "代號(hào)", swCustomInfoText, e)
1 b$ T) _$ x$ l) Gblnretval = Part.AddCustomInfo3("", "名稱", swCustomInfoText, m)
7 D0 C* K9 G0 j$ I  wblnretval = Part.AddCustomInfo3("", "材料", swCustomInfoText, strmat)
blnretval = Part.AddCustomInfo3("", "單重", swCustomInfoText, " ")
blnretval = Part.AddCustomInfo3("", "備注", swCustomInfoText, " ")
  Y# r% i8 y2 k$ }
End Sub

% @8 V; i/ ?+ D$ ~

ryouss

/ i  G- |0 {/ n; f- q# W( j" ^6 q- Z

arter_2006 發(fā)表于 2018-11-26 15:11
" ]- o* R7 b) M8 A1 P+ Z( I執(zhí)行后無反應(yīng)，屬性都沒改，不知道問題出在哪里？讓您費(fèi)心了。
6 F* }8 U7 E( h4 f7 }, C  j* e
' ********************************** ...

7 @4 G& S* \' Y8 zsw2017 測(cè)試OK
/ V, Z7 Q* C6 ]+ @有否顯示什麼錯(cuò)誤提示?


$ k1 y5 `! c, k# m3 d

arter_2006

我的是Solidworks 2018，看來可能是版本的問題了

ryouss

arter_2006 發(fā)表于 2018-11-26 17:00
" r, t" d7 T/ L8 G* V我的是Solidworks 2018，看來可能是版本的問題了

& w) P' N; [" K/ n2018 沒版本能試

arter_2006

ryouss 發(fā)表于 2018-11-26 17:05
3 ]0 v/ K" {  c9 Y) h2018 沒版本能試

$ `* e5 L) G. Q+ K: W+ Q8 `4 k非常感謝您，讓您費(fèi)心了。
/ _' l1 j7 ?- l% Y. R

arter_2006

ryouss 發(fā)表于 2018-11-26 17:05
2018 沒版本能試

+ {6 X& o4 R+ M1 F$ J1 Y! c能否把您的SWP文件發(fā)上來，我剛才用solidworks 2014也試了一下，發(fā)現(xiàn)也不行，但是別的宏都可以。
& c+ z; K; ~4 ]7 Z1 e我從網(wǎng)頁上復(fù)制下來的都變成下面這個(gè)樣子了，所以要?jiǎng)h掉很多多出來的東西，我懷疑是不是這個(gè)原因?qū)е碌模�但是校�?duì)很費(fèi)時(shí)間，也難發(fā)現(xiàn)。

  w( ?! j2 Q; l# `  X' W' ******************************************************************************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
2 z% u2 a4 y) H% T# t! C$ @' ******************************************************************************
; ~8 x1 N+ @6 h: 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 W8 u' q( \3 d4 Y/ K1 v" N; D
& ^" s* t$ r: \9 o3 J( R9 \8 _3 m& \) d/ \Dim SelMgr As Object
6 n! O9 G! ], W2 e; [: S& D4 E8 I: d4 K4 q9 f0 e& f5 HDim Feature As Object
/ f% m/ p* O% m# n. y  f7 s$ z: N6 b! v  l! SDim a As Integer
8 ?# J7 ^, y. p9 P* U; o5 ^. E& 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
* i" J2 k$ h, T1 o4 u, RDim m As String+ ?/ w( `) D: S9 x
' b: z# X$ U6 R: _2 Q, }' ]( w: X' M1 jDim e As String" t" l1 k  K7 K8 U: @# s; `
; ~5 \+ b. X) E  NDim k As String* ?4 t9 u7 n+ _
Dim t As String
6 u5 z0 ^/ B1 |% Z* R2 @9 k9 h% R* ?6 C5 B( @3 D& DDim c As String
4 Z7 }$ _: M( h) V5 u' |  s* ~! K3 d. @4 X+ d/ Q. _. p: yDim j As Integer3 N( z+ v  K2 q* v6 D
6 _! Z, V2 c3 B! d/ A7 pDim strmat As String
# [' e( @0 t2 f! y" v, `* a" 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
6 k" B% |% `" P3 B+ L( H# FSet Part = swApp.ActiveDoc$ q6 |& ^2 b7 ~/ ]( ^0 R
CurCFGname = Part.GetConfigurationNames
% Q% f9 a3 p. N6 _+ I- [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))
$ v. E+ t' _0 d3 b2 K$ E. G( J! L$ ?  c% B6 }    Vnamearr = CusPropMgr.GetNames4 B$ N4 Q* X) q- [; f8 r0 ^5 {
  A; g& T1 f( D4 T    If Not IsEmpty(Vnamearr) Then' t" n; u" h( T
' |/ N( x" G, A4 W- J        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
# s( B( A$ S: d  |- d+ ~$ A3 @6 S" n' d2 eNext
  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
6 s& K/ q6 b* f3 A9 ]- z% e; G6 r) ]# @' p
6 o* N( W, Q# ?" D7 r# [' m2 U5 Z7 k9 B. O: ?'~~~ 刪除自定義屬性 ~~~
& f& J1 c3 u( d* X: 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
: W8 y. I8 w$ _4 k* |+ F8 g! f' g# o6 S, e, W4 z+ EDim vCustInfoNameArr2 As Variant7 J* i  U% A! t0 \0 D! h, V

- 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 {
+ v$ ~+ w" z( l" ?- LvCustInfoNameArr2 = swModel2.GetCustomInfoNames- N/ C9 m0 n2 t* k9 u
% H+ j0 }9 P# K6 I9 C7 M  If Not IsEmpty(vCustInfoNameArr2) Then
0 [0 N- w) t# K" p8 U! V# Z5 s; g8 P9 J( v  m% Z     For Each vCustInfoName2 In vCustInfoNameArr2- \% O7 w% [: r; T3 |5 M
9 \7 f5 e5 V4 A  S         bRet = swModel2.DeleteCustomInfo(vCustInfoName2)
* n( y% k/ _) w0 c8 g. ?" R/ r# I! y' x7 _' X      Next9 U+ R% V2 G# P
' ~4 Q: L) Q0 e4 t3 ?3 k7 i  End If
& V, L( M& Q4 l& b0 TEnd Sub
8 \7 _0 g8 _; x) |- T( l6 M- K7 `: z' w) T+ c$ V; G
/ j9 |  ?( U5 a+ K'~~~ partitionTM ~~~7 O3 t. l4 R1 [+ ]3 K  G+ M
% _5 h& C7 b) W+ n8 v2 q8 xSub partitionTM() 'partitionTM( j# ]! b. Q, G0 M9 E4 f8 B2 J
8 V5 }% x7 U8 m$ j% l; E) x# ~4 [& t0 {8 [
/ c9 D" }6 r3 e2 n1 |, _'link solidworks( C, c- [# N+ Z* [
9 j+ N1 ?3 k$ \0 j( HSet 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
1 D  u& d# |" {' ?! S% D4 ]swApp.ActiveDoc.ActiveView.FrameState = 1& ?6 I  _. Y+ \4 m7 P" c% W/ h
0 m- E% X; P2 A7 @% W'設(shè)定變量& }. N& d* J$ W) S
( [' o, e, Z; [& n- C  Q! _8 M: yc = swApp.ActiveDoc.GetTitle() '零件名
$ ]! G1 i7 W; N, H4 I, {$ Y; Q& d- w. {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("", "材料")
* W3 C# h7 Q4 Q: i6 [0 H) W% o& c& U; y& P! d9 n  V  X0 H+ J1 Yblnretval = Part.DeleteCustomInfo2("", "代號(hào)")3 w1 A4 Q. Z1 \, x1 N/ e; R
blnretval = Part.DeleteCustomInfo2("", "名稱"). }" r" K0 E! E
3 n3 o- |. [3 y. F, C! f+ \5 Cblnretval = 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 b% g( C  E* t, Y4 O. Q- M( d2 }7 f0 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
( ?: F+ C. d  R7 A& U# I        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
5 M1 ~! T5 e2 I1 @  x$ E# e4 \! d    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
  W! ~6 g  S8 N( 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
7 Y2 J8 s! P' a7 h2 r        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& ]
, k4 ^; b8 M0 r% e% Kblnretval = Part.AddCustomInfo3("", "代號(hào)", swCustomInfoText, e)
: F  K  N' M% L5 C4 Hblnretval = Part.AddCustomInfo3("", "名稱", swCustomInfoText, m)7 a/ m( J8 q$ B) ^& B( M# Q' V
) V$ i+ ~  S& y' `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, " ")
6 Q# `  M$ m- A8 W+ x) Y9 t: i2 D6 }7 z- @1 t: i# Q, P, {! f% c" J- {6 u; t
  A! V1 [0 [( _' n1 K3 p# ?End Sub
" O( r3 ?5 b1 @/ A& Q& X; d# b0 G
* s, r  G' D0 L5 t; A" G

ryouss

arter_2006 發(fā)表于 2018-11-26 17:27
( ?+ n+ B+ P) e8 U5 U3 L能否把您的SWP文件發(fā)上來，我剛才用solidworks 2014也試了一下，發(fā)現(xiàn)也不行，但是別的宏都可以。
4 D3 D6 }0 k! v7 p1 R我從網(wǎng) ...

' G3 q2 T6 T4 g9 F附swp繁體版   

ryouss

試試把   CurCFGname = swApp.GetConfigurationNames
! i  b: H& j/ [$ T4 l3 g
9 g6 D5 t* [& b; |+ d, B$ T8 V改為      CurCFGname = swApp.GetConfigurationNames(swApp.ActiveDoc.GetPathName) '補(bǔ)加零件文件的路徑及名稱

3 g6 `5 e+ S  I% f, N在沒補(bǔ)加 (swApp.ActiveDoc.GetPathName) 時(shí)在2012及2015版是會(huì)有提示錯(cuò)誤的(如附圖)
2 h) G4 k! X* D9 x2 g另VBA編程在   " '  " 符號(hào)后的文字是會(huì)跳過不執(zhí)行的.
) Q& I7 _) u- m" u/ P. F
3 k, w! Y2 t. [4 l7 l

arter_2006

我試過了，改之前，改之后一個(gè)樣，而且執(zhí)行中沒有任何錯(cuò)誤提示。
' ******************************************************************************
' C:\Users\admin\AppData\Local\Temp\swx8144\Macro1.swb - macro recorded on 11/22/18 by mqlu
- l0 h& u8 |: k$ r$ K/ O; H; @' ******************************************************************************
Dim swApp As Object
Dim Part As Object
3 ^& H% G0 j* b0 [% v1 jDim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
% t& k$ i  Q- W: q9 b9 w1 r& X
Dim SelMgr As Object
  m6 w0 r: Y' n" g' q8 bDim Feature As Object
Dim a As Integer
+ C, u2 v. {( f4 r, _* C9 S  jDim b As String
" f/ i$ J) Q, K9 o: N# HDim m As String
Dim e As String
" M$ J- p2 {$ H) C2 d5 m. Y' VDim k As String
Dim t As String
' K* }1 K7 v3 C* i! DDim c As String
Dim j As Integer
8 C0 o, x7 J+ JDim strmat As String
Dim tempvalue As String

Sub main() '刪除所有配置屬性
* o# W6 S3 j' I! ~# h4 GSet swApp = Application.SldWorks
: y  V* S0 M: F/ L- JSet Part = swApp.ActiveDoc
CurCFGname = swApp.GetConfigurationNames(swApp.ActiveDoc.GetPathName) '補(bǔ)加零件文件的路徑及名稱
2 B& {# ]% @8 w! XCurCFGnameCount = Part.GetConfigurationCount
& A% k% p3 N( ^5 W. jFor i = 0 To CurCFGnameCount - 1
    Set CusPropMgr = Part.Extension.CustomPropertyManager(CurCFGname(i))
  \) G" \9 _6 d7 s8 w5 e    Vnamearr = CusPropMgr.GetNames
    If Not IsEmpty(Vnamearr) Then
        For Each Vnamearr2 In Vnamearr
7 C' j3 \3 @% `! U8 i7 J& Y            bRet = Part.DeleteCustomInfo2(CurCFGname(i), Vnamearr2)
/ V1 A& N1 u4 s8 S: [. g3 `2 N, f        Next
1 K, L, e9 p0 p, E( q    End If
Next
9 _, C( n! [* V3 c3 R* \( r- FCall 刪除自定義屬性
Call partitionTM

) ?) @/ f( C8 B' `7 U$ a; Z! D# _# dEnd Sub

'~~~ 刪除自定義屬性 ~~~
( N/ h3 K& T2 r2 iSub 刪除自定義屬性()
'Dim swApp As Object
Dim swModel2 As SldWorks.ModelDoc2
6 ?: Y5 O) o$ `& hDim vCustInfoNameArr2 As Variant

8 R' h2 d3 c4 @% b6 SSet swApp = Application.SldWorks
$ i5 S" p( J; M9 GSet swModel2 = swApp.ActiveDoc
vCustInfoNameArr2 = swModel2.GetCustomInfoNames
  If Not IsEmpty(vCustInfoNameArr2) Then
: z5 L1 K; j( @     For Each vCustInfoName2 In vCustInfoNameArr2
         bRet = swModel2.DeleteCustomInfo(vCustInfoName2)
      Next
2 p' T' V0 D7 r6 N. U' C- d" j  End If
+ p4 S, r& X1 z/ H: J* y1 IEnd Sub

/ Q  e& E6 z0 R9 t$ m! G6 A'~~~ partitionTM ~~~
1 S1 F6 t7 d4 @0 u4 T, U2 C: k* Y8 V: qSub partitionTM() 'partitionTM
" m8 `( A, v! x# _
, z- B; `* h; E9 C$ h- B- d'link solidworks
+ T7 b5 }& Q+ L  J( \& uSet swApp = Application.SldWorks
7 |& r' h7 V* N$ dSet Part = swApp.ActiveDoc
* ]8 u7 R* O7 E+ RSet SelMgr = Part.SelectionManager
swApp.ActiveDoc.ActiveView.FrameState = 1
4 d' n) |! {& n  f; n6 y'設(shè)定變量
8 d+ W9 ^+ N6 x+ Zc = swApp.ActiveDoc.GetTitle() '零件名
) ^/ n$ U) I4 W# i( _strmat = Chr(34) + Trim("SW-Material" + "@") + c + Chr(34)
9 `9 r, _* o4 i# y  v'tempvalue = Part.CustomInfo2("", "材料")
blnretval = Part.DeleteCustomInfo2("", "代號(hào)")
0 i4 g2 _- g6 A: _8 Oblnretval = Part.DeleteCustomInfo2("", "名稱")
: T4 u/ n, ?$ N+ d7 gblnretval = Part.DeleteCustomInfo2("", "材料")
0 c, P) C! H! N, X: Q) A; Y5 V+ H
4 T: k7 g) W; y
a = InStr(c, " ") - 1
, I/ M$ ^" N' s  P1 hIf a > 0 Then
0 n9 w, A; T. i$ G! J- P  y( f    k = Left(c, a)
8 n% y- n+ Q; n( h; @7 h    t = Left(LTrim(e), 3)
  m3 c$ Z4 F, n7 E' Q* t9 a7 b
    If t = "GBT" Then
7 B+ }. f, J& e, c! l        e = "GB/T" + Mid(k, 4)
1 e9 h8 i1 v/ v& I7 v    Else
        e = k
6 ^! x+ g7 m3 a    End If

& F  V( T0 u0 U    b = Mid(c, a + 2)
    t = Right(c, 7)
    If t = ".SLDPRT" Or t = ".SLDASM" Then
        j = Len(b) - 7
7 C  Y& D1 T" A% b  x& P    Else
6 ?; F4 R' Q! t2 ?& T1 q- F8 E        j = Len(b)
. o& _) x/ ]3 u8 `& d; K6 v    End If
8 f! l- _9 M7 e% a    m = Left(b, j)
End If
; @4 n9 d& p9 }$ D* f9 E
( D' V. {6 Y! j4 \7 F  Y/ R8 [9 O* m" R( ablnretval = Part.AddCustomInfo3("", "代號(hào)", swCustomInfoText, e)
blnretval = Part.AddCustomInfo3("", "名稱", swCustomInfoText, m)
& o: q& E% x0 Jblnretval = Part.AddCustomInfo3("", "材料", swCustomInfoText, strmat)
blnretval = Part.AddCustomInfo3("", "單重", swCustomInfoText, " ")
blnretval = Part.AddCustomInfo3("", "備注", swCustomInfoText, " ")

End Sub