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

ryouss

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


1 O# W. d$ e/ s3 z8 j2 x

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
   
5. Dim Part As Object
   
6. Dim boolstatus As Boolean
   $ ^+ @5 \+ c3 v
7. Dim longstatus As Long, longwarnings As Long
   
8. 
   ( F/ }) M% u5 }# x( l9 X) E
9. Dim SelMgr As Object
   6 b: Y: Y. K- A
10. Dim Feature As Object
    : `& c+ @( N6 a) p* A+ @3 v
11. Dim a As Integer
    . E7 V' @; p' Y% {) x, m# E: X
12. Dim b As String
    6 N$ j2 N' Q: Y3 }7 Q
13. Dim m As String
    
14. Dim e As String
    
15. Dim k As String
    
16. Dim t As String
      h8 W# {" R% E' w" b0 L$ [& h) W% b
17. Dim c As String
    # K1 y9 J8 _5 r" Q
18. Dim j As Integer
    9 y- K% M5 h1 s# C2 ]3 p
19. Dim strmat As String
    
20. Dim tempvalue As String
    
21. 
    
22. Sub main() '刪除所有配置屬性
    
23. Set swApp = Application.SldWorks
    & H2 D4 V! g, z1 H- J3 v4 T/ @$ ^
24. Set Part = swApp.ActiveDoc
    ; s# g% n& `, P! _) ]
25. CurCFGname = Part.GetConfigurationNames
    
26. CurCFGnameCount = Part.GetConfigurationCount
    " J  P: C) h9 T7 h3 ?0 d
27. For i = 0 To CurCFGnameCount - 1
    ' Y4 B5 X8 D/ [) U" |0 G& F) x! \
28.     Set CusPropMgr = Part.Extension.CustomPropertyManager(CurCFGname(i))
    
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
    & K( \0 W  {  e
34.     End If
    
35. Next
    
36. Call 刪除自定義屬性
    % S! F5 Z! }( c6 {! R( T
37. Call partitionTM
    
38. 
    / j7 O* o/ R+ Z2 ?& G6 b; l
39. End Sub
    6 T: Y, [; U/ N
40. 
    
41. '~~~ 刪除自定義屬性 ~~~
    " T& k2 D# S  I0 O
42. Sub 刪除自定義屬性()
    
43. 'Dim swApp As Object
    0 E9 Q* F+ q6 T9 n5 p9 r$ c
44. Dim swModel2 As SldWorks.ModelDoc2
    
45. Dim vCustInfoNameArr2 As Variant
    
46. 
    $ n1 [+ |9 d; e& C6 a
47. Set swApp = Application.SldWorks
    ' J; J4 z0 W1 g9 v: D
48. Set swModel2 = swApp.ActiveDoc
    
49. vCustInfoNameArr2 = swModel2.GetCustomInfoNames
    3 a7 c! D" j+ x. F; n8 M% |
50.   If Not IsEmpty(vCustInfoNameArr2) Then
    3 M3 x- ]9 R/ |( ?5 [( H0 @3 G! y7 n
51.      For Each vCustInfoName2 In vCustInfoNameArr2
    
52.          bRet = swModel2.DeleteCustomInfo(vCustInfoName2)
    
53.       Next
    " ~$ g% Q! P0 `" w
54.   End If
    
55. End Sub
    % e) a2 h1 V7 y7 O8 O
56. 
    
57. '~~~ partitionTM ~~~
    
58. Sub partitionTM() 'partitionTM
    
59. 
    ' a7 w1 P0 n% F. v
60. 'link solidworks
    ) s' p; E' H9 w' s+ f6 d4 Y
61. Set swApp = Application.SldWorks
    
62. Set Part = swApp.ActiveDoc
    3 @- w! Y7 I4 t2 L
63. Set SelMgr = Part.SelectionManager
    
64. swApp.ActiveDoc.ActiveView.FrameState = 1
    
65. '設(shè)定變量
    " ]7 v* V# f  q& Z
66. c = swApp.ActiveDoc.GetTitle() '零件名
    ; f* f  b/ Z( i/ R0 O
67. strmat = Chr(34) + Trim("SW-Material" + "@") + c + Chr(34)
    ! X6 z1 i/ l- W# C4 r; T9 J
68. 'tempvalue = Part.CustomInfo2("", "材料")
    
69. blnretval = Part.DeleteCustomInfo2("", "代號")
    
70. blnretval = Part.DeleteCustomInfo2("", "名稱")
    
71. blnretval = Part.DeleteCustomInfo2("", "材料")
    , @7 t& `% K- s6 n% x; p. \' Z
72. a = InStr(c, " ") - 1
    
73. If a > 0 Then
    ' S; w# H3 d! v
74.     k = Left(c, a)
    5 J/ T. T; w. K- _; O+ ~
75.     t = Left(LTrim(e), 3)
    8 _; a0 m3 o& }$ Q( ?8 M$ p
76.     If t = "GBT" Then
    ! E0 N/ O% ]& ?# R, n
77.         e = "GB/T" + Mid(k, 4)
    + W" m" h3 \* i0 e: ?) ?
78.     Else
    . V8 _3 H& ?. I4 o# \  s* D9 e
79.         e = k
    3 n' u, S4 M2 x. V6 P( z& D4 S6 M5 e
80.     End If
    : K' @/ s1 }6 n
81.     b = Mid(c, a + 2)
    ( K( e* R2 [9 L3 F
82.     t = Right(c, 7)
    
83.     If t = ".SLDPRT" Or t = ".SLDASM" Then
    
84.         j = Len(b) - 7
    
85.     Else
    
86.         j = Len(b)
    ( Q9 v1 `# o0 D( A& Z( d  F0 d& [$ b
87.     End If
    8 v. W3 h8 w# D3 g: p$ M
88.     m = Left(b, j)
    - r& V4 ]7 O: n4 ^4 K, |
89. End If
    
90. blnretval = Part.AddCustomInfo3("", "代號", swCustomInfoText, e)
    9 [# X$ _! H9 s+ U. Z! S( e4 N
91. blnretval = Part.AddCustomInfo3("", "名稱", swCustomInfoText, m)
    
92. blnretval = Part.AddCustomInfo3("", "材料", swCustomInfoText, strmat)
    
93. blnretval = Part.AddCustomInfo3("", "單重", swCustomInfoText, " ")
    
94. blnretval = Part.AddCustomInfo3("", "備註", swCustomInfoText, " ")
    8 ^) ^; p# f' v+ j3 W
95. 
    
96. End Sub

復(fù)制代碼

6 x7 _) |3 \3 h% Y; H& }! {% ~

arter_2006

ryouss 發(fā)表于 2018-11-25 11:32
0 t, p6 h8 T: S1 z+ E+ x就是如下的繁體字改為簡體字就是

執(zhí)行后無反應(yīng)，屬性都沒改，不知道問題出在哪里？讓您費(fèi)心了。

' ******************************************************************************
7 I/ B. J" }/ D' C:\Users\admin\AppData\Local\Temp\swx8144\Macro1.swb - macro recorded on 11/22/18 by mqlu
' ******************************************************************************
Dim swApp As Object
Dim Part As Object
+ z9 s$ Y2 E! K( P' f) p8 i% \2 f' wDim boolstatus As Boolean
# ]7 e# l9 i' H1 b0 a6 f! {Dim longstatus As Long, longwarnings As Long

6 V$ T$ r2 |+ f% ?1 ADim SelMgr As Object
Dim Feature As Object
Dim a As Integer
Dim b As String
Dim m As String
Dim e As String
' ^, {" |- b  E. S$ r% I4 jDim k As String
Dim t As String
4 L1 j, Q7 h8 {/ t2 d) o! MDim c As String
Dim j As Integer
Dim strmat As String
Dim tempvalue As String
1 m& _( Z9 e( b8 ]5 b
( a, B' t. M  Y' L' `Sub main() '刪除所有配置屬性
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
CurCFGname = Part.GetConfigurationNames
CurCFGnameCount = Part.GetConfigurationCount
For i = 0 To CurCFGnameCount - 1
    Set CusPropMgr = Part.Extension.CustomPropertyManager(CurCFGname(i))
    Vnamearr = CusPropMgr.GetNames
* p. u& `" O' L' m: S4 F! H    If Not IsEmpty(Vnamearr) Then
        For Each Vnamearr2 In Vnamearr
1 P: A1 s" Z6 \% t% I" E3 J            bRet = Part.DeleteCustomInfo2(CurCFGname(i), Vnamearr2)
        Next
    End If
Next
Call 刪除自定義屬性
8 [! M! S9 o6 e) ACall partitionTM
( `/ Q4 I; d! M+ D
: ?2 s; p% O2 {End Sub
5 q- R3 A# E. D: Y( I1 K: V) c
/ S8 S2 s2 {4 n'~~~ 刪除自定義屬性 ~~~
Sub 刪除自定義屬性()
. N" A- d  |$ N- o'Dim swApp As Object
Dim swModel2 As SldWorks.ModelDoc2
Dim vCustInfoNameArr2 As Variant

Set swApp = Application.SldWorks
, ?# I% m* N. k! gSet swModel2 = swApp.ActiveDoc
vCustInfoNameArr2 = swModel2.GetCustomInfoNames
( u; b3 Z, P. _5 J" B; y2 l  d  If Not IsEmpty(vCustInfoNameArr2) Then
     For Each vCustInfoName2 In vCustInfoNameArr2
. m4 s1 i) q7 u$ x         bRet = swModel2.DeleteCustomInfo(vCustInfoName2)
5 a$ t2 [8 \* l! c' L      Next
  End If
" n! j" Z- b  u/ D4 iEnd Sub
: M; T$ a; p9 N9 S% x# }
'~~~ partitionTM ~~~
Sub partitionTM() 'partitionTM

'link solidworks
Set swApp = Application.SldWorks
7 E; f( I/ Z) Z4 i* y: b8 a+ h0 r  vSet Part = swApp.ActiveDoc
Set SelMgr = Part.SelectionManager
" x) d, p3 }8 C+ S  y" f0 ?swApp.ActiveDoc.ActiveView.FrameState = 1
' W6 L& w- j% r1 Q' @8 ?'設(shè)定變量
: y0 S: ]9 z& \& s2 J% I; W7 Oc = swApp.ActiveDoc.GetTitle() '零件名
strmat = Chr(34) + Trim("SW-Material" + "@") + c + Chr(34)
'tempvalue = Part.CustomInfo2("", "材料")
, h# @3 @6 k9 W  |( f' y1 H- Nblnretval = Part.DeleteCustomInfo2("", "代號")
blnretval = Part.DeleteCustomInfo2("", "名稱")
blnretval = Part.DeleteCustomInfo2("", "材料")
a = InStr(c, " ") - 1
7 j  H! Y7 U% o1 |( k+ W9 Z' cIf a > 0 Then
    k = Left(c, a)
    t = Left(LTrim(e), 3)
8 P0 G+ c1 _0 x2 h7 F" k  O( O, c$ s) D    If t = "GBT" Then
        e = "GB/T" + Mid(k, 4)
; O3 _4 t& o4 S4 g) }9 v) m    Else
* Y& M( I, p( T/ G0 b# P( q6 Q/ c; W3 ]' f        e = k
    End If
/ Z+ G+ ?/ k( `% O- {8 x    b = Mid(c, a + 2)
    t = Right(c, 7)
. z) v; Y  _, U1 m. v2 P    If t = ".SLDPRT" Or t = ".SLDASM" Then
        j = Len(b) - 7
) c. w/ b# a* \8 w" x3 W) Z    Else
( B6 d" ^& F3 U0 l5 r5 u        j = Len(b)
    End If
    m = Left(b, j)
End If
blnretval = Part.AddCustomInfo3("", "代號", swCustomInfoText, e)
, u* e( |" \* f' ]* {2 gblnretval = Part.AddCustomInfo3("", "名稱", swCustomInfoText, m)
blnretval = Part.AddCustomInfo3("", "材料", swCustomInfoText, strmat)
blnretval = Part.AddCustomInfo3("", "單重", swCustomInfoText, " ")
% @3 j- p1 i4 V" F9 Zblnretval = Part.AddCustomInfo3("", "備注", swCustomInfoText, " ")

End Sub
/ y4 q1 H9 C0 Y: C  x: N) i$ a' p
( ]! Z6 U5 C5 v* r

ryouss

arter_2006 發(fā)表于 2018-11-26 15:11
執(zhí)行后無反應(yīng)，屬性都沒改，不知道問題出在哪里？讓您費(fèi)心了。

* o, j! E- D# j9 ~' ********************************** ...

& c+ a  t, B2 S2 Asw2017 測試OK
4 F/ X' x/ R2 A1 m有否顯示什麼錯(cuò)誤提示?

" a+ M) O4 s/ T' K
/ |: Q7 W: O) W$ s! J& s- l

arter_2006

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

ryouss

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

  `# C. i2 _1 U1 Y; V! ^2 m/ i2018 沒版本能試
) I8 K% ?& h$ Y+ Z, M& N) p

arter_2006

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

' z% `5 ~  j" O) S5 W6 S非常感謝您，讓您費(fèi)心了。

arter_2006

ryouss 發(fā)表于 2018-11-26 17:05
- a3 X0 X. Y. _) B& h( w2018 沒版本能試

能否把您的SWP文件發(fā)上來，我剛才用solidworks 2014也試了一下，發(fā)現(xiàn)也不行，但是別的宏都可以。
我從網(wǎng)頁上復(fù)制下來的都變成下面這個(gè)樣子了，所以要?jiǎng)h掉很多多出來的東西，我懷疑是不是這個(gè)原因?qū)е碌模�但是校對很費(fèi)時(shí)間，也難發(fā)現(xiàn)。
9 u' A; Z3 C; P
( {: r8 \* ^$ F* U1 q4 T  [' ******************************************************************************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
" _+ E; `$ I) ?9 r6 @' ******************************************************************************
: 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
6 n1 P. L: ?) X8 W( }/ a2 _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
$ r6 N  G2 N0 b, F2 K) f. v3 J( R9 \8 _3 m& \) d/ \Dim SelMgr As Object
1 f8 t" b5 r' v- B, }5 i6 w: 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
6 P+ `8 V. L1 i/ j" r9 t/ B" }Dim m As String+ ?/ w( `) D: S9 x
% B- R2 ~- v2 J; IDim e As String" t" l1 k  K7 K8 U: @# s; `
8 d+ w$ l; a# B- s7 ODim k As String* ?4 t9 u7 n+ _
Dim t As String
% R* ?6 C5 B( @3 D& DDim c As String
. [8 Y# ]( A- P& k1 }  u1 [+ M9 [! K3 d. @4 X+ d/ Q. _. p: yDim j As Integer3 N( z+ v  K2 q* v6 D
Dim strmat As String
0 p% `$ F/ ^" s: Z" Q; M" F! d7 t6 p- DDim tempvalue As String
& b8 C& o. \* T. o) N3 c& E& r" D5 F  G0 |% Q: b, Y
1 W' Z4 C" \4 Q* H' N3 `9 U! U" p- o) ?$ `2 a( G& L5 x7 Q- B3 Z( ISub main() '刪除所有配置屬性
0 x0 E# r. @3 x  f; 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
" ]% J1 O9 m  I- [5 v: x. U8 U( V* kCurCFGnameCount = Part.GetConfigurationCount
; t; I  i; S. ^- ?! [" c- O# J: c, c5 w7 Y0 T. @for i = 0 To CurCFGnameCount - 1& {$ V* E/ x+ ~. V
! ]( f1 D% U% G* k    Set CusPropMgr = Part.Extension.CustomPropertyManager(CurCFGname(i))
; {+ U, F6 q$ O& V# F3 @+ C4 Z3 V. G( J! L$ ?  c% B6 }    Vnamearr = CusPropMgr.GetNames4 B$ N4 Q* X) q- [; f8 r0 ^5 {
3 m( ^) C, q1 `$ o" H% W/ C* B    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
        Next- P& E; Z$ s7 V+ a( t' E% T
    End If
; _8 O; j: q/ W" y9 X$ A3 @6 S" n' d2 eNext
# v' G1 ~* i. X: ]# G  k" k4 f; K$ vCall 刪除自定義屬性
( A- x) f" C" d8 G6 }) {# {' iCall partitionTM4 }2 o$ e' E7 t
! P$ I$ N: U+ B4 z, }- o# ?
2 @8 q. ~" b  {% q" `4 h6 {End Sub
! W/ \4 H6 w- Y/ N% e; G6 r) ]# @' p
" D7 r# [' m2 U5 Z7 k9 B. O: ?'~~~ 刪除自定義屬性 ~~~
- Z' x& D4 g2 B7 z: s: Q6 `! G2 u. ]" |4 i. ?Sub 刪除自定義屬性()
- J/ J0 ]5 W( V1 d  B# r$ |5 d2 b. o4 x5 W" n+ J'Dim swApp As Object2 Q# s7 O1 ~+ I" }
# u" ~) J9 }6 f' r  D" g8 qDim swModel2 As SldWorks.ModelDoc2
! f' g# o6 S, e, W4 z+ EDim vCustInfoNameArr2 As Variant7 J* i  U% A! t0 \0 D! h, V
9 c; R; s* B8 H/ p
6 y" W; M6 C7 J5 F3 e; V- K" x+ X- v- E% b! h6 i* p! ], |9 USet swApp = Application.SldWorks
* ^7 ?2 N* U& I' R* S4 s( n% j4 S  i4 [' W6 ]0 I* U0 V' O' B+ NSet swModel2 = swApp.ActiveDoc3 u) Z+ D2 D4 z; M# d4 {
" `5 w! j/ |! O0 R( W7 vvCustInfoNameArr2 = swModel2.GetCustomInfoNames- N/ C9 m0 n2 t* k9 u
8 L3 Z* S8 M6 u# C  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)
* j4 k7 X  j! U* h$ V8 X. ?" R/ r# I! y' x7 _' X      Next9 U+ R% V2 G# P
) R3 [" x$ S2 z' r0 S+ J% z3 |  End If
& V, L( M& Q4 l& b0 TEnd Sub
5 D6 a: P; r3 v$ ]6 M- K7 `: z' w) T+ c$ V; G
& O! [  q9 W% L/ j9 |  ?( U5 a+ K'~~~ partitionTM ~~~7 O3 t. l4 R1 [+ ]3 K  G+ M
  Y' }- i. t- Z. h+ x6 u6 OSub partitionTM() 'partitionTM( j# ]! b. Q, G0 M9 E4 f8 B2 J
: f, N) G/ D* k3 u% V5 C7 S% l; E) x# ~4 [& t0 {8 [
4 u7 S, W$ _0 H# O) q: O' n'link solidworks( C, c- [# N+ Z* [
Set swApp = Application.SldWorks+ w1 D3 {4 b7 ^# i5 p4 ~2 p
" D& w2 Y5 d3 B0 ]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 X. |% E& P+ t  zswApp.ActiveDoc.ActiveView.FrameState = 1& ?6 I  _. Y+ \4 m7 P" c% W/ h
7 B" D! k: H6 B0 K'設(shè)定變量& }. N& d* J$ W) S
( J% y! W$ ]7 e+ Ec = swApp.ActiveDoc.GetTitle() '零件名
: }: ]3 Q8 Q8 \8 W+ k* q. {8 L5 ~" z0 y# g! I" Estrmat = Chr(34) + Trim("SW-Material" + "@") + c + Chr(34). w+ f3 v( W- `* D! G! v. z
! ~! {$ o& r0 ?- U5 n) h'tempvalue = Part.CustomInfo2("", "材料")
& 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
7 m; k0 \# j, q4 D: iblnretval = Part.DeleteCustomInfo2("", "材料")
6 S' a6 |$ V6 p: w/ O8 \  X4 \4 v+ 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
( A# r% y" U" k    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
; t2 \6 Q/ W9 ?; a/ \9 x4 X2 C    Else
! W2 i7 C- b( f1 H* X4 B; P        e = k& O7 M7 ]$ E: v$ n5 ]  ?0 p$ z
3 W* W5 h' [* a5 _: c. K) n* Y  Q    End If! C- h9 R! k; n% D6 G+ S; P
2 I3 T! c1 j1 |$ F+ Z& E. W    b = Mid(c, a + 2)
1 m0 Z% r( l. M1 a, _" o% b/ ^0 j8 S  T    t = Right(c, 7)
9 K7 b2 w1 L% i9 Y: D( H6 S2 ?' U+ d5 X" f: a    If t = ".SLDPRT" Or t = ".SLDASM" Then
& {# w) X  [% f4 R9 K( 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, |  ?
    End If8 @/ x5 s, N; \. _& V# V
' f/ m& Y$ w' ]2 f7 C    m = Left(b, j)
) M( C/ o/ K* x. 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
9 o* d+ ]! t5 ~8 f, [* d" |+ f! `blnretval = Part.AddCustomInfo3("", "材料", swCustomInfoText, strmat)
9 Z0 O2 e0 Q6 cblnretval = Part.AddCustomInfo3("", "單重", swCustomInfoText, " ")
0 C& i/ S* d+ A) t5 @' u% \% z  V; G2 e# V. L; H; {2 wblnretval = Part.AddCustomInfo3("", "備註", swCustomInfoText, " ")
: i2 D6 }7 z- @1 t: i# Q, P, {! f% c" J- {6 u; t
End Sub
+ y9 `2 T* ]; T; _/ V; A

ryouss

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

附swp繁體版   

ryouss

試試把   CurCFGname = swApp.GetConfigurationNames
* j8 c; i- d  C0 ]
6 |1 Q7 L: f1 [0 z1 I, \  |改為      CurCFGname = swApp.GetConfigurationNames(swApp.ActiveDoc.GetPathName) '補(bǔ)加零件文件的路徑及名稱
. o4 `/ W- _2 E' k5 K% k3 [
在沒補(bǔ)加 (swApp.ActiveDoc.GetPathName) 時(shí)在2012及2015版是會有提示錯(cuò)誤的(如附圖)
# s" }( r1 G" h, e; w9 h另VBA編程在   " '  " 符號后的文字是會跳過不執(zhí)行的.
0 P/ k  _  |: [- U0 M+ t


6 [/ F& j7 y$ ~

arter_2006

我試過了，改之前，改之后一個(gè)樣，而且執(zhí)行中沒有任何錯(cuò)誤提示。
' ******************************************************************************
# [& m) X$ W" B4 D% p: _5 k" I' C:\Users\admin\AppData\Local\Temp\swx8144\Macro1.swb - macro recorded on 11/22/18 by mqlu
7 w2 e7 L' H; j) Z) G& q' ******************************************************************************
Dim swApp As Object
- }  }: _: o& f# fDim Part As Object
Dim boolstatus As Boolean
+ P  ~, R6 B) ~1 BDim longstatus As Long, longwarnings As Long
: O) e. y8 Z$ z, V# N; k
! E0 f; i- e1 H# {! {Dim SelMgr As Object
  M( ^4 Q: q- K& ADim Feature As Object
; h" m8 n. Y4 c) L% q$ sDim a As Integer
Dim b As String
Dim m As String
1 U. h; P  k% K. _* RDim e As String
9 x' z" Z" k' v3 ]* gDim k As String
2 I, p5 w9 v8 h1 X- e1 pDim t As String
+ F7 Z* X& a. W2 @Dim c As String
Dim j As Integer
3 |: x2 n7 e2 J# pDim strmat As String
Dim tempvalue As String

Sub main() '刪除所有配置屬性
; s% ^$ n5 R9 H: P& uSet swApp = Application.SldWorks
" ^3 o$ A+ ]. R' c$ `9 o9 U' ]: PSet Part = swApp.ActiveDoc
& Q7 J& `' {# ]+ zCurCFGname = swApp.GetConfigurationNames(swApp.ActiveDoc.GetPathName) '補(bǔ)加零件文件的路徑及名稱
CurCFGnameCount = Part.GetConfigurationCount
+ F  d- B  M) \9 |; vFor i = 0 To CurCFGnameCount - 1
    Set CusPropMgr = Part.Extension.CustomPropertyManager(CurCFGname(i))
    Vnamearr = CusPropMgr.GetNames
    If Not IsEmpty(Vnamearr) Then
; K% k9 N: D' p  l8 b* E5 ]        For Each Vnamearr2 In Vnamearr
            bRet = Part.DeleteCustomInfo2(CurCFGname(i), Vnamearr2)
        Next
    End If
Next
2 n' m, w7 M2 G- ZCall 刪除自定義屬性
Call partitionTM

End Sub
: d8 @" j& Z* ?6 [' G
1 N$ I: F2 D4 P  I( P8 G'~~~ 刪除自定義屬性 ~~~
/ Z$ Z' \2 F* \( s; lSub 刪除自定義屬性()
  L0 `6 I" K( Q" S4 d! F'Dim swApp As Object
2 y7 z7 W! D, U3 a7 i0 R, V2 m+ wDim swModel2 As SldWorks.ModelDoc2
Dim vCustInfoNameArr2 As Variant
9 ]% m, ~6 Y2 p' @5 Y
Set swApp = Application.SldWorks
. g* {, p2 C9 k) z6 jSet swModel2 = swApp.ActiveDoc
' K" P7 _7 o3 g& Z% VvCustInfoNameArr2 = swModel2.GetCustomInfoNames
9 D9 \0 j! e) N- S+ i  If Not IsEmpty(vCustInfoNameArr2) Then
# Q8 z/ t7 @  Z& W, f; Z7 Q     For Each vCustInfoName2 In vCustInfoNameArr2
         bRet = swModel2.DeleteCustomInfo(vCustInfoName2)
      Next
" p1 X% y& x' u  End If
End Sub
/ L2 `9 Y$ o. T) g  U$ F) E
. v! L- s4 V  O. D! {0 G* r'~~~ partitionTM ~~~
Sub partitionTM() 'partitionTM
1 ]5 Q  k/ d0 l: D
6 f& o) ^9 ]  Y, l0 R'link solidworks
; t/ P: o& o0 b5 ISet swApp = Application.SldWorks
" z. T8 |3 B& MSet Part = swApp.ActiveDoc
+ }) ]% N* e" k: o: F: o0 gSet SelMgr = Part.SelectionManager
+ y$ V1 @3 x9 M. L! d; b" a5 ]swApp.ActiveDoc.ActiveView.FrameState = 1
0 B# a& f* B, F1 I'設(shè)定變量
c = swApp.ActiveDoc.GetTitle() '零件名
' V; U. @4 _0 }; F) j# A0 Ystrmat = Chr(34) + Trim("SW-Material" + "@") + c + Chr(34)
'tempvalue = Part.CustomInfo2("", "材料")
; T" r/ r. i7 E5 wblnretval = Part.DeleteCustomInfo2("", "代號")
$ m$ P7 D* l  F7 z3 B% V7 R  q* mblnretval = Part.DeleteCustomInfo2("", "名稱")
blnretval = Part.DeleteCustomInfo2("", "材料")
5 U3 [. j; L8 I3 s1 O$ X$ u$ \
( Y( a4 I! q: ~0 N+ }1 C
* t9 @/ f  D8 G% Fa = InStr(c, " ") - 1
# a9 i( ~: Z! h1 b8 w& s* HIf a > 0 Then
    k = Left(c, a)
    t = Left(LTrim(e), 3)
. K9 r- N9 z( L5 D: ~  C* A
/ g* v& R6 O8 s    If t = "GBT" Then
        e = "GB/T" + Mid(k, 4)
' M/ Y" g- p. `4 l6 N$ D. X    Else
        e = k
6 B# [8 M/ [/ I) J& L    End If

. Z6 Z, y& V- [3 x! W4 t    b = Mid(c, a + 2)
+ E" v' D# j9 _4 y/ F    t = Right(c, 7)
    If t = ".SLDPRT" Or t = ".SLDASM" Then
        j = Len(b) - 7
    Else
        j = Len(b)
- G8 S. k6 _/ i# N% ~: f3 i    End If
9 Q$ L2 Z4 K4 G    m = Left(b, j)
5 C; r8 b. @- aEnd If

1 Y7 \+ Y- [8 \1 A; Qblnretval = Part.AddCustomInfo3("", "代號", swCustomInfoText, e)
blnretval = Part.AddCustomInfo3("", "名稱", swCustomInfoText, m)
% a; q' ~. u% K2 _blnretval = Part.AddCustomInfo3("", "材料", swCustomInfoText, strmat)
2 s  g7 A1 P! [2 B! rblnretval = Part.AddCustomInfo3("", "單重", swCustomInfoText, " ")
; A8 C) |: X& Kblnretval = Part.AddCustomInfo3("", "備注", swCustomInfoText, " ")
% p1 s3 q# M" ^' _* Y
End Sub