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

ryouss

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

1. ' ******************************************************************************
   
2. ' C:\Users\admin\AppData\Local\Temp\swx8144\Macro1.swb - macro recorded on 11/22/18 by mqlu
   - W. N1 G( k2 |9 U3 l& Z) ?% c
3. ' ******************************************************************************
   
4. Dim swApp As Object
   
5. Dim Part As Object
   $ I4 W* }* m2 w: M. h
6. Dim boolstatus As Boolean
   + C, W! S- [8 H% ?" _
7. Dim longstatus As Long, longwarnings As Long
   # ~  C3 s0 n& C" M- P( z
8. 
   
9. Dim SelMgr As Object
   9 Z2 a: z# ]% u2 r! s# D+ H5 e9 {
10. Dim Feature As Object
    
11. Dim a As Integer
    ! p. u# Z$ Q$ ^( A: K4 g
12. Dim b As String
    ; V/ X7 t4 ], t. N
13. Dim m As String
    
14. Dim e As String
    / _* r9 g6 q! {5 O7 o+ X7 @" j
15. Dim k As String
    7 l- c( D' a& Z* E* U+ d1 u; G
16. Dim t As String
    5 o2 \$ m! E# m4 N$ J7 k+ L
17. Dim c As String
    
18. Dim j As Integer
    + p9 N* t* r, J
19. Dim strmat As String
    
20. Dim tempvalue As String
    
21. 
    2 }0 x9 R6 F$ J/ [: O
22. Sub main() '刪除所有配置屬性
    7 L# N0 E1 L% p. l
23. Set swApp = Application.SldWorks
    
24. Set Part = swApp.ActiveDoc
    + f! W; i' x2 w7 b) J/ {! e# |9 @
25. CurCFGname = Part.GetConfigurationNames
    
26. CurCFGnameCount = Part.GetConfigurationCount
    3 h- c; R. Z$ f& c  C) e) p' m
27. For i = 0 To CurCFGnameCount - 1
    ; ^% |' V  H3 `4 H& b+ t0 g4 D8 @
28.     Set CusPropMgr = Part.Extension.CustomPropertyManager(CurCFGname(i))
    
29.     Vnamearr = CusPropMgr.GetNames
    
30.     If Not IsEmpty(Vnamearr) Then
    : N& v: Q6 `; B" j3 T% I3 I+ h
31.         For Each Vnamearr2 In Vnamearr
    1 K5 e% i5 Q5 L5 Z, K5 o1 |
32.             bRet = Part.DeleteCustomInfo2(CurCFGname(i), Vnamearr2)
    - o  b1 g( I3 F1 K/ T) \$ }
33.         Next
    
34.     End If
    
35. Next
    / h. m: Q# e2 F$ Z% |2 T; K. K
36. Call 刪除自定義屬性
    
37. Call partitionTM
    * c% M- T% K6 p8 F  }7 X, H
38. 
    
39. End Sub
      I8 N/ C( p- J# U/ u7 R
40. 
    ' U4 k3 \: `  i6 B' s- n8 p
41. '~~~ 刪除自定義屬性 ~~~
    
42. Sub 刪除自定義屬性()
    ) s( b1 F, V2 E* {
43. 'Dim swApp As Object
    2 g( }' U1 ?7 ~! e" u
44. Dim swModel2 As SldWorks.ModelDoc2
    
45. Dim vCustInfoNameArr2 As Variant
    4 j9 W/ h! I) g7 A3 |
46. 
    & `' f. W, c: v
47. Set swApp = Application.SldWorks
    
48. Set swModel2 = swApp.ActiveDoc
    
49. vCustInfoNameArr2 = swModel2.GetCustomInfoNames
    / t) g" d& |& q: E! k. `( K
50.   If Not IsEmpty(vCustInfoNameArr2) Then
    
51.      For Each vCustInfoName2 In vCustInfoNameArr2
    ; u4 m- v( x5 E' q: q
52.          bRet = swModel2.DeleteCustomInfo(vCustInfoName2)
    
53.       Next
    , R9 c, W+ o3 o+ O. e+ w
54.   End If
    
55. End Sub
    
56. 
    ( a! d& Z, F/ {& [/ J
57. '~~~ partitionTM ~~~
    
58. Sub partitionTM() 'partitionTM
    4 V8 s. i) {* I' g
59. 
    
60. 'link solidworks
    
61. Set swApp = Application.SldWorks
    / [! J2 f. u( A6 h
62. Set Part = swApp.ActiveDoc
    
63. Set SelMgr = Part.SelectionManager
    
64. swApp.ActiveDoc.ActiveView.FrameState = 1
    
65. '設(shè)定變量
    ( K* Y# u; M; M) |
66. c = swApp.ActiveDoc.GetTitle() '零件名
    
67. strmat = Chr(34) + Trim("SW-Material" + "@") + c + Chr(34)
    " ]3 j- O$ _  }9 Y
68. 'tempvalue = Part.CustomInfo2("", "材料")
    
69. blnretval = Part.DeleteCustomInfo2("", "代號")
    1 S: h# a* V; `. k4 T3 s! D" U; _8 t
70. blnretval = Part.DeleteCustomInfo2("", "名稱")
    
71. blnretval = Part.DeleteCustomInfo2("", "材料")
    + B7 [+ B' N5 _+ L/ L( ?* Z
72. a = InStr(c, " ") - 1
    
73. If a > 0 Then
    ; K7 c$ D) ~3 \5 z4 _6 B
74.     k = Left(c, a)
    2 j& p2 d& ^4 }( [# \1 `
75.     t = Left(LTrim(e), 3)
    
76.     If t = "GBT" Then
    
77.         e = "GB/T" + Mid(k, 4)
    
78.     Else
    3 E* d  }8 ~" i9 R! q
79.         e = k
    5 _: _: l% t" ^5 B
80.     End If
    & Z. _: n- f" }$ K8 q: t0 ]- z" v
81.     b = Mid(c, a + 2)
    
82.     t = Right(c, 7)
    7 O, u9 u0 c0 k' a
83.     If t = ".SLDPRT" Or t = ".SLDASM" Then
    - v9 ]) B3 I0 R. T4 F1 \
84.         j = Len(b) - 7
    & T; u4 @- S. r, F
85.     Else
    
86.         j = Len(b)
    
87.     End If
    
88.     m = Left(b, j)
    
89. End If
    7 x% _1 E, H9 s* r
90. blnretval = Part.AddCustomInfo3("", "代號", swCustomInfoText, e)
    
91. blnretval = Part.AddCustomInfo3("", "名稱", swCustomInfoText, m)
    
92. blnretval = Part.AddCustomInfo3("", "材料", swCustomInfoText, strmat)
    
93. blnretval = Part.AddCustomInfo3("", "單重", swCustomInfoText, " ")
    
94. blnretval = Part.AddCustomInfo3("", "備註", swCustomInfoText, " ")
    
95. 
    
96. End Sub

復(fù)制代碼

arter_2006

ryouss 發(fā)表于 2018-11-25 11:32
  k' y! g" R7 b. h1 B就是如下的繁體字改為簡體字就是

* \$ N" r2 b6 r' R# l, T執(zhí)行后無反應(yīng),，屬性都沒改,，不知道問題出在哪里,？讓您費(fèi)心了,。
# t& H2 J2 [5 |
/ y8 E+ }1 i* T6 ]; Y' ******************************************************************************
1 j" T8 P( a4 h" V6 ]2 w' C:\Users\admin\AppData\Local\Temp\swx8144\Macro1.swb - macro recorded on 11/22/18 by mqlu
6 T1 e; F1 I( F4 |1 g' ******************************************************************************
* ?; O+ e; r  w! x- U: EDim swApp As Object
Dim Part As Object
. M7 r  ^: B5 C% H+ f$ m0 O4 ~5 WDim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long

Dim SelMgr As Object
Dim Feature As Object
4 H5 e- t" ?  k! kDim a As Integer
% h( X$ ?/ ~/ u% ]' J% f4 J. FDim b As String
! o  {/ R. ~+ L# W9 L2 j, h- eDim m As String
3 f+ V) K5 f# T9 DDim e As String
0 h% P* ^. ?& K' L8 ZDim k As String
' z8 x2 j7 E9 Y% J) FDim t As String
4 g. _" T/ S6 L0 LDim c As String
0 P( {# i9 Q1 Y" |7 O  Q8 B. FDim j As Integer
Dim strmat As String
; B4 {  g- h" e0 b$ t2 sDim tempvalue As String

; N) f3 _) I" h' P3 \7 Z; sSub main() '刪除所有配置屬性
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
CurCFGname = Part.GetConfigurationNames
/ k$ |9 k& b; h! e1 d% oCurCFGnameCount = Part.GetConfigurationCount
" S% d1 p9 \5 f4 b. ^0 `For i = 0 To CurCFGnameCount - 1
    Set CusPropMgr = Part.Extension.CustomPropertyManager(CurCFGname(i))
6 Y6 `8 P3 |* b. G5 `/ w! c    Vnamearr = CusPropMgr.GetNames
    If Not IsEmpty(Vnamearr) Then
8 U* D- K1 z' k& Q        For Each Vnamearr2 In Vnamearr
            bRet = Part.DeleteCustomInfo2(CurCFGname(i), Vnamearr2)
; H% N4 O4 W. y3 }0 F" _9 A        Next
    End If
Next
+ ^  V! {7 T. i+ mCall 刪除自定義屬性
9 ^$ }! ^* x! ]& ?# X  @Call partitionTM
9 y! D( }4 B& F: f3 @  f3 y) n
% x( F& {! X0 q! C' cEnd Sub
( l8 N" G: h% V2 a0 z% p
: k% G4 }4 I# W: _* e'~~~ 刪除自定義屬性 ~~~
Sub 刪除自定義屬性()
'Dim swApp As Object
Dim swModel2 As SldWorks.ModelDoc2
Dim vCustInfoNameArr2 As Variant
* @1 t+ f9 F, j4 F8 m! @" \+ l* c
9 O( Z# R7 |( WSet swApp = Application.SldWorks
Set swModel2 = swApp.ActiveDoc
vCustInfoNameArr2 = swModel2.GetCustomInfoNames
$ @! P* [1 v9 S2 Z$ o  If Not IsEmpty(vCustInfoNameArr2) Then
     For Each vCustInfoName2 In vCustInfoNameArr2
         bRet = swModel2.DeleteCustomInfo(vCustInfoName2)
" ~5 K, e- J& G9 ^# A/ ]: H      Next
8 g) u; p0 `7 t3 f( v% D& x! J' V  End If
! V! _2 P3 e/ z6 wEnd Sub

'~~~ partitionTM ~~~
Sub partitionTM() 'partitionTM
1 T: o: G2 _: s: L4 F& [( I) _$ H- @: @
" M* m+ [& G8 q) e: N! X' a9 |  U'link solidworks
+ q) [) b- n( sSet swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
Set SelMgr = Part.SelectionManager
8 Y. O# n8 \5 j$ H2 n6 c- lswApp.ActiveDoc.ActiveView.FrameState = 1
'設(shè)定變量
, U  o* [5 b) o" ~6 mc = swApp.ActiveDoc.GetTitle() '零件名
: \5 e3 L! y  n# \. i0 V0 Jstrmat = Chr(34) + Trim("SW-Material" + "@") + c + Chr(34)
/ y7 S) I0 {, V4 k+ r" v3 l/ n0 _3 x'tempvalue = Part.CustomInfo2("", "材料")
blnretval = Part.DeleteCustomInfo2("", "代號")
blnretval = Part.DeleteCustomInfo2("", "名稱")
1 K# P7 w" j1 r% ~( J) t; c9 l5 Eblnretval = Part.DeleteCustomInfo2("", "材料")
a = InStr(c, " ") - 1
1 s; a, J  x& k2 ^2 g9 EIf a > 0 Then
    k = Left(c, a)
7 z% e! D7 o6 e& B) b0 ^, G    t = Left(LTrim(e), 3)
; R* K" L6 P+ q( h& d$ Z5 }    If t = "GBT" Then
        e = "GB/T" + Mid(k, 4)
    Else
        e = k
    End If
0 Q$ E( U# M* e- J9 ?    b = Mid(c, a + 2)
    t = Right(c, 7)
2 m/ N9 P+ O* A5 o* l, s    If t = ".SLDPRT" Or t = ".SLDASM" Then
# r( v: {1 e3 ^4 b        j = Len(b) - 7
    Else
9 Q2 N3 ~! C. B0 n' W3 p        j = Len(b)
    End If
    m = Left(b, j)
End If
blnretval = Part.AddCustomInfo3("", "代號", swCustomInfoText, e)
1 ~$ L9 V& }: V" O' K7 qblnretval = Part.AddCustomInfo3("", "名稱", swCustomInfoText, m)
blnretval = Part.AddCustomInfo3("", "材料", swCustomInfoText, strmat)
7 o, E2 V5 H; V) f. jblnretval = Part.AddCustomInfo3("", "單重", swCustomInfoText, " ")
blnretval = Part.AddCustomInfo3("", "備注", swCustomInfoText, " ")
5 |+ Y$ L- \' w
; g2 [1 [5 _0 q. qEnd Sub
  v- g8 y5 h1 X' L  D. z
( V' V+ k' W  X5 l

ryouss

arter_2006 發(fā)表于 2018-11-26 15:11
2 r7 J# v% l0 e$ ~3 f. |" P9 P執(zhí)行后無反應(yīng),，屬性都沒改，不知道問題出在哪里,？讓您費(fèi)心了,。

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

  x5 X4 p7 p, X3 \sw2017 測試OK
有否顯示什麼錯(cuò)誤提示?
! U+ V/ W/ o. M& V9 }  Y
$ v7 V' o) ~. b3 k4 V6 _; e
$ ~- D' n. |8 Y. H

arter_2006

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

ryouss

arter_2006 發(fā)表于 2018-11-26 17:00
我的是Solidworks 2018，看來可能是版本的問題了

2018 沒版本能試

arter_2006

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

非常感謝您,，讓您費(fèi)心了,。
/ n0 Q% ?5 q; r& b: a6 h5 ]7 B

arter_2006

ryouss 發(fā)表于 2018-11-26 17:05
3 v9 L8 O  g, Z- N9 u5 m! R$ Z2018 沒版本能試

能否把您的SWP文件發(fā)上來，我剛才用solidworks 2014也試了一下,，發(fā)現(xiàn)也不行,，但是別的宏都可以。
我從網(wǎng)頁上復(fù)制下來的都變成下面這個(gè)樣子了,，所以要?jiǎng)h掉很多多出來的東西,，我懷疑是不是這個(gè)原因?qū)е碌模�但是校對很費(fèi)時(shí)間,，也難發(fā)現(xiàn),。
3 |& A: l9 C1 b
- ]! S7 k; t$ ^  v  X' ******************************************************************************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
' ******************************************************************************
: n% \( F) I, C+ j: _& m6 bDim swApp As Object
( ~- y. K, S' v# J+ c- G' 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 _
1 \1 R6 S7 V7 E+ K1 X1 gDim longstatus As Long, longwarnings As Long
1 W8 u' q( \3 d4 Y/ K1 v" N; D
3 d5 \* \* [7 I/ u( ^$ Y' q3 J( R9 \8 _3 m& \) d/ \Dim SelMgr As Object
: S& D4 E8 I: d4 K4 q9 f0 e& f5 HDim Feature As Object
7 t& J  v0 C6 z" M9 Y9 ^3 E$ v7 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
  ?) {( H) D6 i; EDim e As String" t" l1 k  K7 K8 U: @# s; `
+ @1 u! a: H! Q6 r& sDim k As String* ?4 t9 u7 n+ _
Dim t As String
8 L  _* e7 e4 M: n1 a% 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
6 k" `2 O! O# S7 P  e) r8 _% RDim strmat As String
" C, T; r* F+ r5 r7 _; Y: [- F" 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() '刪除所有配置屬性
  }2 C4 ^" h  n# ]7 R3 h& A; 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
- l* s4 O: }4 c' o# Y5 e" DCurCFGname = Part.GetConfigurationNames
- [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))
. 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
- d( N/ E: [) A/ j7 s5 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
( Y6 @2 O& ]+ r        Next- P& E; Z$ s7 V+ a( t' E% T
! g- Q1 O3 c+ b$ U  K    End If
$ A3 @6 S" n' d2 eNext
. J3 [5 {$ y' K1 l/ H& _  k" k4 f; K$ vCall 刪除自定義屬性
5 R( Q( ?( F; b# m! g( O5 W; e2 K( 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
: }: P  {8 `  ?: |; i# z" D7 r# [' m2 U5 Z7 k9 B. O: ?'~~~ 刪除自定義屬性 ~~~
: Q6 `! G2 u. ]" |4 i. ?Sub 刪除自定義屬性()
' d" N) A8 Z; z6 u* f$ o4 ~  B# r$ |5 d2 b. o4 x5 W" n+ J'Dim swApp As Object2 Q# s7 O1 ~+ I" }
+ i; a( G/ \# p- ZDim swModel2 As SldWorks.ModelDoc2
! f' g# o6 S, e, W4 z+ EDim vCustInfoNameArr2 As Variant7 J* i  U% A! t0 \0 D! h, V
, @# u7 v+ w' t9 `
3 b& n/ w  R8 ^  R- 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 {
& u! i9 ?. p. ?5 Q& l8 i5 a2 U  h/ XvCustInfoNameArr2 = swModel2.GetCustomInfoNames- N/ C9 m0 n2 t* k9 u
  If Not IsEmpty(vCustInfoNameArr2) Then
; `& j  ]8 }9 K: a( T* y! V# Z5 s; g8 P9 J( v  m% Z     For Each vCustInfoName2 In vCustInfoNameArr2- \% O7 w% [: r; T3 |5 M
3 N1 K0 w2 E2 @0 z( s' _( i         bRet = swModel2.DeleteCustomInfo(vCustInfoName2)
4 l; _& ]) O5 M* l4 w. ?" R/ r# I! y' x7 _' X      Next9 U+ R% V2 G# P
1 h& i  H6 u6 U* R  End If
& V, L( M& Q4 l& b0 TEnd Sub
  C5 c7 N8 p2 K6 I2 `5 J6 M- K7 `: z' w) T+ c$ V; G
! g) u7 C9 K- ^. Y  _/ j9 |  ?( U5 a+ K'~~~ partitionTM ~~~7 O3 t. l4 R1 [+ ]3 K  G+ M
: g& r5 v/ B. `, S$ v$ K+ QSub partitionTM() 'partitionTM( j# ]! b. Q, G0 M9 E4 f8 B2 J
! Z1 U( B0 y' l* j% l; E) x# ~4 [& t0 {8 [
" ?" A: x' M4 @& g7 q% A& D'link solidworks( C, c- [# N+ Z* [
2 i6 J' v9 [' O7 B+ ~* ?0 rSet swApp = Application.SldWorks+ w1 D3 {4 b7 ^# i5 p4 ~2 p
7 Z) U7 t, r& l$ |$ p; o6 MSet 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
6 {& W' N2 [# L: R+ \* u4 e4 u'設(shè)定變量& }. N& d* J$ W) S
6 Y* K5 O. O3 n% Jc = 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
'tempvalue = Part.CustomInfo2("", "材料")
, ?& S. ~7 |4 y" Y' l# m% S, D/ N7 T& 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
/ v& K  \# P* y$ Y# Dblnretval = 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 D& _% k+ M" K3 ~    k = Left(c, a)0 D( T  G4 u* @' Z: h# g5 h) k
  F$ y, W; h3 F: ^! z! y( g4 n# f    t = Left(LTrim(e), 3)0 |: d+ H% K1 I5 d; ^& r
4 ~# z5 x/ n; i3 b$ h8 x  |    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
" d% h  c0 Q6 V5 X# b3 R' c! W2 i7 C- b( f1 H* X4 B; P        e = k& O7 M7 ]$ E: v$ n5 ]  ?0 p$ z
6 X5 ^' A; `6 d/ K  i    End If! C- h9 R! k; n% D6 G+ S; P
2 h" S9 d/ `6 d$ v$ Q  Q9 [6 O% l    b = Mid(c, a + 2)
" e! _+ u7 y! \3 R* ~8 h3 B1 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
! i8 U7 O$ B; g" a( 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
" a7 ?) D8 ?# g9 v' D# p' W2 z" m        j = Len(b); J( ?# E, |  ?
) w+ i; s2 q0 |9 L4 A# D    End If8 @/ x5 s, N; \. _& V# V
, e3 h: z7 H' [* A; w/ y' [  H9 \! D    m = Left(b, j)
6 m7 c0 K4 ?- T% Y" G& l. P: e' A' P) l4 b& \End If( o3 u- a' n" g; c4 t2 s& ]
blnretval = Part.AddCustomInfo3("", "代號", swCustomInfoText, e)
) n7 f, q  i. S5 i6 o: 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, " ")
7 G6 _0 D( R" ?  V; G2 e# V. L; H; {2 wblnretval = Part.AddCustomInfo3("", "備註", swCustomInfoText, " ")
. p: S& r) M% D: i2 D6 }7 z- @1 t: i# Q, P, {! f% c" J- {6 u; t
End Sub

ryouss

arter_2006 發(fā)表于 2018-11-26 17:27
能否把您的SWP文件發(fā)上來，我剛才用solidworks 2014也試了一下,，發(fā)現(xiàn)也不行,，但是別的宏都可以。
我從網(wǎng) ...

附swp繁體版   
, U+ Q" y" [" t3 d; _; ?

ryouss

4 H8 e/ Y( E  l- u3 b
3 V# ]* A: i' S2 v試試把   CurCFGname = swApp.GetConfigurationNames

改為      CurCFGname = swApp.GetConfigurationNames(swApp.ActiveDoc.GetPathName) '補(bǔ)加零件文件的路徑及名稱
8 N1 f; E* P+ t4 R
0 X5 h, w! ^& B' s4 e+ n在沒補(bǔ)加 (swApp.ActiveDoc.GetPathName) 時(shí)在2012及2015版是會(huì)有提示錯(cuò)誤的(如附圖)
另VBA編程在   " '  " 符號后的文字是會(huì)跳過不執(zhí)行的.
5 N2 a$ r7 I3 m. c

5 b8 E  w* `1 |2 V/ M1 O8 W9 e
/ x" m% X5 ?9 [

arter_2006

我試過了,，改之前,，改之后一個(gè)樣，而且執(zhí)行中沒有任何錯(cuò)誤提示,。
/ k- _7 B. Z9 Y8 b& v: A* X8 t% R' ******************************************************************************
8 R. z3 U) @& L/ _' Q' j# X' C:\Users\admin\AppData\Local\Temp\swx8144\Macro1.swb - macro recorded on 11/22/18 by mqlu
* [0 w. i, e" y' [' ******************************************************************************
) X- w! }) l; k- l7 D! mDim swApp As Object
4 L# j3 r- g  P0 mDim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
4 F2 ]/ E% w( s5 t. S) n
Dim SelMgr As Object
Dim Feature As Object
5 P0 a# r; M5 ]Dim a As Integer
Dim b As String
Dim m As String
Dim e As String
7 Z. D1 T8 r2 ?. a6 PDim k As String
, I( e  W! n8 ^- d" h2 U, B! s# XDim t As String
Dim c As String
( k8 M/ F$ O# I) ^; A  K: mDim j As Integer
Dim strmat As String
0 G. Y5 q8 c- d  YDim tempvalue As String

Sub main() '刪除所有配置屬性
2 v6 q; f" ^  W3 n) c/ |Set swApp = Application.SldWorks
. i& f! q0 `$ ySet Part = swApp.ActiveDoc
CurCFGname = swApp.GetConfigurationNames(swApp.ActiveDoc.GetPathName) '補(bǔ)加零件文件的路徑及名稱
: O. ]$ N9 Z2 x. ^/ u$ k6 @CurCFGnameCount = Part.GetConfigurationCount
1 U! G/ c* ?( |$ c7 I( GFor i = 0 To CurCFGnameCount - 1
5 _' |0 w, H: j# i2 k    Set CusPropMgr = Part.Extension.CustomPropertyManager(CurCFGname(i))
    Vnamearr = CusPropMgr.GetNames
; t$ ?2 g5 e! B! T) P8 G: z3 f    If Not IsEmpty(Vnamearr) Then
3 C5 |1 `5 l3 o% f        For Each Vnamearr2 In Vnamearr
1 u$ u% O7 e, H$ L% y$ n5 k            bRet = Part.DeleteCustomInfo2(CurCFGname(i), Vnamearr2)
. {) d) a8 |4 `& z$ N$ L+ Y        Next
$ P6 Q! O, q2 g    End If
4 W5 D3 I/ |. G% i9 CNext
+ C( Z  x' ^* U4 t' h3 Y( oCall 刪除自定義屬性
2 R; L+ p# N; D9 t' g  E# U  v" S) ~Call partitionTM

End Sub

+ G  Y1 k8 h8 T1 s, g  G+ z'~~~ 刪除自定義屬性 ~~~
Sub 刪除自定義屬性()
'Dim swApp As Object
, T5 [1 L& r# ~2 s' l" |# B  LDim swModel2 As SldWorks.ModelDoc2
Dim vCustInfoNameArr2 As Variant
* X  n0 A- ]2 |& }6 Y4 ^+ }! i
2 [4 m& t7 w+ H/ L/ z) _  f' CSet swApp = Application.SldWorks
Set swModel2 = swApp.ActiveDoc
$ [) K0 {& y+ L+ RvCustInfoNameArr2 = swModel2.GetCustomInfoNames
  If Not IsEmpty(vCustInfoNameArr2) Then
     For Each vCustInfoName2 In vCustInfoNameArr2
         bRet = swModel2.DeleteCustomInfo(vCustInfoName2)
$ f& g5 U3 U5 Z! p+ t, ]      Next
  End If
End Sub

'~~~ partitionTM ~~~
$ l1 ?$ b2 I( iSub partitionTM() 'partitionTM

; ~7 ?0 x0 ^; X" E' `( x'link solidworks
. I. D; _7 r' b, HSet swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
. J( O, |, Y" Q% SSet SelMgr = Part.SelectionManager
swApp.ActiveDoc.ActiveView.FrameState = 1
'設(shè)定變量
9 K9 H3 n& c0 {& }6 b, ec = swApp.ActiveDoc.GetTitle() '零件名
strmat = Chr(34) + Trim("SW-Material" + "@") + c + Chr(34)
'tempvalue = Part.CustomInfo2("", "材料")
) `8 i3 }% r  Q4 [: b  [$ [  Ablnretval = Part.DeleteCustomInfo2("", "代號")
blnretval = Part.DeleteCustomInfo2("", "名稱")
+ q6 u/ s& P2 P7 D5 L# q  Zblnretval = Part.DeleteCustomInfo2("", "材料")
* m5 E0 a# Q/ [

+ `5 c( F+ {  F0 Y8 L! Ba = InStr(c, " ") - 1
. ^: x- @4 H3 D3 E6 `If a > 0 Then
0 M' e/ m5 P7 |  A9 ^3 ]; ]    k = Left(c, a)
    t = Left(LTrim(e), 3)

    If t = "GBT" Then
7 d) K+ `' B3 M1 _' N% B. i; u        e = "GB/T" + Mid(k, 4)
4 ?8 E9 B& }, M1 H) t) `  g4 c6 M    Else
        e = k
    End If
, K, |% I+ W$ p; j( O) L  x
    b = Mid(c, a + 2)
, {  _$ J5 T4 F' K( T' x, N  j    t = Right(c, 7)
    If t = ".SLDPRT" Or t = ".SLDASM" Then
4 i8 `! Y7 c4 R- z3 O1 P4 n        j = Len(b) - 7
    Else
. a9 E- D& Y/ s# [3 W8 m5 w% `& x        j = Len(b)
    End If
2 |# |- P4 i4 v% k    m = Left(b, j)
, ]* X; w0 y; a5 C, TEnd If

blnretval = Part.AddCustomInfo3("", "代號", swCustomInfoText, e)
blnretval = Part.AddCustomInfo3("", "名稱", swCustomInfoText, m)
" p  O) {; X$ E7 g8 r5 Oblnretval = Part.AddCustomInfo3("", "材料", swCustomInfoText, strmat)
/ ~* V2 F! D1 O+ S$ fblnretval = Part.AddCustomInfo3("", "單重", swCustomInfoText, " ")
" c6 Q5 z: U7 U: n7 Iblnretval = Part.AddCustomInfo3("", "備注", swCustomInfoText, " ")
& m6 \, f* V5 ~; y: N
  y0 y* H- S7 ~9 XEnd Sub