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

ryouss

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

( z  V8 g2 @5 Y& g  ?; c- Y

1. ' ******************************************************************************
   " h4 S" f/ d$ B6 W' `7 i2 v
2. ' C:\Users\admin\AppData\Local\Temp\swx8144\Macro1.swb - macro recorded on 11/22/18 by mqlu
   
3. ' ******************************************************************************
   ( \% I6 \( u0 _) E8 ]# z
4. Dim swApp As Object
   ! o: i* j9 F& a+ S
5. Dim Part As Object
   
6. Dim boolstatus As Boolean
   
7. Dim longstatus As Long, longwarnings As Long
   4 y  h8 E8 a/ Q
8. 
   
9. Dim SelMgr As Object
   
10. Dim Feature As Object
    
11. Dim a As Integer
      f; o% W" t& m0 {+ n/ I
12. Dim b As String
    8 u: P* k$ X. U( N
13. Dim m As String
    & W6 K2 m7 r- e/ |; D
14. Dim e As String
    , G" H" [" I% `/ G4 G# p
15. Dim k As String
    
16. Dim t As String
    
17. Dim c As String
    
18. Dim j As Integer
    
19. Dim strmat As String
    
20. Dim tempvalue As String
    - `: }4 K, ^5 \1 \/ S& c% y
21. 
    1 l( ^1 E' F/ x$ v7 v
22. Sub main() '刪除所有配置屬性
    ( X* {" h# j5 T' i. f' z
23. Set swApp = Application.SldWorks
    % l; i) i* q9 j* n, m3 S2 j7 |
24. Set Part = swApp.ActiveDoc
    
25. CurCFGname = Part.GetConfigurationNames
    
26. CurCFGnameCount = Part.GetConfigurationCount
    
27. For i = 0 To CurCFGnameCount - 1
    2 \# N; z$ l/ O: ]6 \
28.     Set CusPropMgr = Part.Extension.CustomPropertyManager(CurCFGname(i))
    
29.     Vnamearr = CusPropMgr.GetNames
      l) E5 S# T4 w% L% s
30.     If Not IsEmpty(Vnamearr) Then
    
31.         For Each Vnamearr2 In Vnamearr
    * f  r% X& t. H9 |6 l" L2 D
32.             bRet = Part.DeleteCustomInfo2(CurCFGname(i), Vnamearr2)
    ' f9 p0 l/ \1 N7 |
33.         Next
    4 Z' ?! {/ Z$ V5 H4 z& ^
34.     End If
    & R5 R4 b. s( p# N. m$ Z
35. Next
    6 e! m$ S* ]7 d
36. Call 刪除自定義屬性
    
37. Call partitionTM
    
38. 
    ( \: F) z: N0 b. ?2 H0 c9 r6 H7 A
39. End Sub
    
40. 
    ' l- `' P& u+ ], L+ c
41. '~~~ 刪除自定義屬性 ~~~
    
42. Sub 刪除自定義屬性()
    . ^/ X+ g2 i1 {  V* U7 F
43. 'Dim swApp As Object
    
44. Dim swModel2 As SldWorks.ModelDoc2
    ) s0 T- u, X: }" B4 f- e0 w
45. Dim vCustInfoNameArr2 As Variant
    
46. 
    % h5 h6 N: G# v7 M$ Q" j
47. Set swApp = Application.SldWorks
    , \7 L/ @6 H& H, j/ O6 }
48. Set swModel2 = swApp.ActiveDoc
    ; m6 F5 q4 O% h) N6 C7 ^9 r
49. vCustInfoNameArr2 = swModel2.GetCustomInfoNames
    
50.   If Not IsEmpty(vCustInfoNameArr2) Then
    - I4 ^6 w: [7 _
51.      For Each vCustInfoName2 In vCustInfoNameArr2
    ! X$ E( f/ @: K, Z( ]
52.          bRet = swModel2.DeleteCustomInfo(vCustInfoName2)
    6 n  K. N7 f( c$ V
53.       Next
    " Z5 Q0 k: P) l' x3 q* ~; L! p4 O% N
54.   End If
    / E) n8 F: \7 F- r% r! g9 ^; o
55. End Sub
    % S/ l* O* I. @9 X( F9 Y
56. 
    * L' y8 }1 U3 O3 w& U# f
57. '~~~ partitionTM ~~~
    & w  g6 a. W5 F  D9 N/ n! n! x  }4 g
58. Sub partitionTM() 'partitionTM
    $ B& P9 k4 q3 D, `! R2 c/ F9 a8 Y
59. 
    
60. 'link solidworks
    
61. Set swApp = Application.SldWorks
    ) P  C2 B0 ~/ J. U! @6 p$ M
62. Set Part = swApp.ActiveDoc
    + b( ?" P' g7 b
63. Set SelMgr = Part.SelectionManager
    
64. swApp.ActiveDoc.ActiveView.FrameState = 1
    
65. '設(shè)定變量
    9 D4 E! y1 J- z( o1 o6 d
66. c = swApp.ActiveDoc.GetTitle() '零件名
    
67. strmat = Chr(34) + Trim("SW-Material" + "@") + c + Chr(34)
    , u+ k- q" d7 ?
68. 'tempvalue = Part.CustomInfo2("", "材料")
    ) C5 |  i, I: x$ Q$ k9 C
69. blnretval = Part.DeleteCustomInfo2("", "代號(hào)")
    
70. blnretval = Part.DeleteCustomInfo2("", "名稱")
    
71. blnretval = Part.DeleteCustomInfo2("", "材料")
    
72. a = InStr(c, " ") - 1
    
73. If a > 0 Then
    2 l% z. q# R# k3 ]3 X: F
74.     k = Left(c, a)
    5 @+ [& [% k' R# J" _7 t: J( ^
75.     t = Left(LTrim(e), 3)
    ; e* a1 N: o% ?
76.     If t = "GBT" Then
    
77.         e = "GB/T" + Mid(k, 4)
    : p5 p! d# S3 H0 m$ w; w
78.     Else
    
79.         e = k
    * }. p6 \2 J5 `* G$ G. ?6 x
80.     End If
    
81.     b = Mid(c, a + 2)
    
82.     t = Right(c, 7)
    
83.     If t = ".SLDPRT" Or t = ".SLDASM" Then
    ! z- V" \! v7 ~! C; ~
84.         j = Len(b) - 7
    4 U# s3 n, ^4 W: K- D2 t% `
85.     Else
    5 ^/ j; O" E8 F9 h
86.         j = Len(b)
    
87.     End If
    % M  c* F2 K/ ^, o3 b. l* u
88.     m = Left(b, j)
    ( e2 A2 ~) u) x% M6 q
89. End If
    
90. blnretval = Part.AddCustomInfo3("", "代號(hào)", swCustomInfoText, e)
    % x4 C* R% F: H
91. blnretval = Part.AddCustomInfo3("", "名稱", swCustomInfoText, m)
    0 X; c6 z1 Q2 C7 T
92. blnretval = Part.AddCustomInfo3("", "材料", swCustomInfoText, strmat)
    
93. blnretval = Part.AddCustomInfo3("", "單重", swCustomInfoText, " ")
    
94. blnretval = Part.AddCustomInfo3("", "備註", swCustomInfoText, " ")
    
95. 
    5 j# J  R( \$ s) t8 U
96. End Sub

復(fù)制代碼

: Q7 r$ ]% t+ j
' a# U  {3 B6 ^9 C8 h6 V3 ]
1 ^* x2 |' i# [7 y: G; Q

arter_2006

ryouss 發(fā)表于 2018-11-25 11:32
) c* [! k9 w! @- z" u0 ]# Z就是如下的繁體字改為簡(jiǎn)體字就是

執(zhí)行后無反應(yīng)，屬性都沒改，不知道問題出在哪里？讓您費(fèi)心了。
, y  o4 P" @3 x) S- g
8 c+ B! u: c+ t! N5 h; Z' ******************************************************************************
( X) k3 I. F3 b, _: \' C:\Users\admin\AppData\Local\Temp\swx8144\Macro1.swb - macro recorded on 11/22/18 by mqlu
' ******************************************************************************
Dim swApp As Object
- c4 J. V# c2 |5 B5 P+ L7 KDim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long

Dim SelMgr As Object
6 C- P) N) ?5 M( |2 X. ]Dim Feature As Object
  N  g6 e$ ~4 Z8 |/ F2 m& U+ KDim a As Integer
Dim b As String
6 R6 j) a+ b' z5 w, JDim m As String
Dim e As String
Dim k As String
2 t0 o1 g" X) D! f) j' x4 |Dim t As String
Dim c As String
5 Q: [" K( `. G" i3 ]Dim j As Integer
+ h* V2 L1 V- i& vDim strmat As String
Dim tempvalue As String

- l! A5 j; q; k; K" \0 fSub main() '刪除所有配置屬性
' M( c$ _8 d6 I/ t5 Z3 @Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
CurCFGname = Part.GetConfigurationNames
& R9 Q9 b8 n& k$ _7 l; f/ LCurCFGnameCount = Part.GetConfigurationCount
For i = 0 To CurCFGnameCount - 1
9 t" B3 m, W0 B) [    Set CusPropMgr = Part.Extension.CustomPropertyManager(CurCFGname(i))
4 \0 Q! ]9 c* l3 i    Vnamearr = CusPropMgr.GetNames
    If Not IsEmpty(Vnamearr) Then
        For Each Vnamearr2 In Vnamearr
            bRet = Part.DeleteCustomInfo2(CurCFGname(i), Vnamearr2)
        Next
    End If
% a# q9 x; G' m/ F) i+ j5 ?  {, wNext
+ W/ C/ B9 y; B8 Z( ICall 刪除自定義屬性
Call partitionTM

% ~  h8 x2 @3 j' G9 u9 MEnd Sub

+ T5 M5 X* O( K6 X'~~~ 刪除自定義屬性 ~~~
, x! e, @* G4 ASub 刪除自定義屬性()
'Dim swApp As Object
4 u& z' B5 g! }% V9 |Dim swModel2 As SldWorks.ModelDoc2
) E6 L, K- p" x8 H+ E5 UDim vCustInfoNameArr2 As Variant

Set swApp = Application.SldWorks
6 X7 ?# ~; y, a3 C# j* OSet swModel2 = swApp.ActiveDoc
% `* p& W! ^& e" d. F) L, Z6 dvCustInfoNameArr2 = swModel2.GetCustomInfoNames
" }! C& G0 q9 r; R6 {4 N9 @  If Not IsEmpty(vCustInfoNameArr2) Then
8 t) h: z* N7 |: S0 s     For Each vCustInfoName2 In vCustInfoNameArr2
2 l0 T" W) b4 `; ]  n         bRet = swModel2.DeleteCustomInfo(vCustInfoName2)
) \4 M  _2 D0 n/ m, Y      Next
2 `) ^6 B3 @4 @+ o; N7 t& b1 N# j! k  End If
/ S0 V) b9 Z$ p. e% M* ~% fEnd Sub
. r5 p. U! j; F% Z' `
'~~~ partitionTM ~~~
% i! W4 D! Q* GSub partitionTM() 'partitionTM

'link solidworks
/ x; S! _0 i. RSet swApp = Application.SldWorks
# C3 q& K# _% G% G: G2 E) LSet Part = swApp.ActiveDoc
& {! `/ ]+ ?) D+ r' g; nSet SelMgr = Part.SelectionManager
9 j# o7 Q& Q% e- P8 XswApp.ActiveDoc.ActiveView.FrameState = 1
'設(shè)定變量
% |  Z( b8 S" j2 G  W& f2 p) E; Q4 hc = swApp.ActiveDoc.GetTitle() '零件名
% g9 M" h* h& i8 M5 rstrmat = Chr(34) + Trim("SW-Material" + "@") + c + Chr(34)
. w9 m( @, @+ ['tempvalue = Part.CustomInfo2("", "材料")
blnretval = Part.DeleteCustomInfo2("", "代號(hào)")
- G$ t3 ~* N  H. G& w9 Fblnretval = Part.DeleteCustomInfo2("", "名稱")
( A- u" G% j/ Vblnretval = Part.DeleteCustomInfo2("", "材料")
7 Z# @) V4 E# q  s+ T. x/ }a = InStr(c, " ") - 1
! ~. Q5 w5 N2 R$ C! u( v  zIf a > 0 Then
5 j# h- Y9 K( m. v9 @1 E    k = Left(c, a)
    t = Left(LTrim(e), 3)
    If t = "GBT" Then
$ l" H% j7 w- _+ T# e( ^        e = "GB/T" + Mid(k, 4)
! r' C5 A3 n( O" M9 }2 I3 c" A    Else
( b% Y, ^; N8 ^2 V, [- s        e = k
    End If
    b = Mid(c, a + 2)
    t = Right(c, 7)
    If t = ".SLDPRT" Or t = ".SLDASM" Then
( J; S' n3 k! A+ U8 Q$ P        j = Len(b) - 7
8 q! }1 |( O$ a* {( o) _    Else
        j = Len(b)
    End If
    m = Left(b, j)
End If
# m, t5 W9 L4 `+ v& Oblnretval = Part.AddCustomInfo3("", "代號(hào)", swCustomInfoText, e)
! w9 x' L! }  \& Q9 w# U' `blnretval = Part.AddCustomInfo3("", "名稱", swCustomInfoText, m)
2 ?, O$ U7 m  l9 Rblnretval = Part.AddCustomInfo3("", "材料", swCustomInfoText, strmat)
blnretval = Part.AddCustomInfo3("", "單重", swCustomInfoText, " ")
/ @( ~+ h" i$ ablnretval = Part.AddCustomInfo3("", "備注", swCustomInfoText, " ")

End Sub
) u, M; T5 ~7 Y8 [
: V6 g: D% ]: z' `5 l$ F8 G& t

ryouss

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

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

sw2017 測(cè)試OK
7 r6 z( A  I; i& A有否顯示什麼錯(cuò)誤提示?


- @. y8 \0 V* |! m
) q6 W7 R) b. x; {2 u" F+ y& n( v1 I

arter_2006

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

ryouss

arter_2006 發(fā)表于 2018-11-26 17:00
  b& w: ?+ L- K% R( z" F5 L我的是Solidworks 2018，看來可能是版本的問題了

2018 沒版本能試
) Z% D2 |" ?) N# [( E" E: T

arter_2006

ryouss 發(fā)表于 2018-11-26 17:05
: L' V: v( L# p$ c" n2018 沒版本能試

非常感謝您，讓您費(fèi)心了。

arter_2006

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

) O9 Q9 u$ z$ i$ p9 D: K+ ]  n& c8 f能否把您的SWP文件發(fā)上來，我剛才用solidworks 2014也試了一下，發(fā)現(xiàn)也不行，但是別的宏都可以。
我從網(wǎng)頁(yè)上復(fù)制下來的都變成下面這個(gè)樣子了，所以要?jiǎng)h掉很多多出來的東西，我懷疑是不是這個(gè)原因?qū)е碌模�但是校�?duì)很費(fèi)時(shí)間，也難發(fā)現(xiàn)。

3 n9 A3 G6 _$ k" p( f6 k  g( S" `) u( q/ }' ******************************************************************************3 \3 X) J3 n, I6 @4 |0 x
3 u. Z  r9 E" U8 I) r* d8 M: ]' 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
! }) J7 j9 e( L& `: V' ******************************************************************************
/ ?7 c1 S. h7 z7 q% u5 T: 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
% r6 I5 f  N# ?. ~5 `8 qDim boolstatus As Boolean- I8 s/ Y$ i' W. N0 _
; [  l/ k/ o1 w6 T: B- |, R5 o+ JDim longstatus As Long, longwarnings As Long
1 W8 u' q( \3 d4 Y/ K1 v" N; D
4 g7 U0 Q* s* d9 k6 v7 @% G3 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 s$ z: N6 b! v  l! SDim a As Integer
- W+ A! }) B* d8 `9 [; k: B& 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
9 u( }, d8 g6 z& L9 ?Dim m As String+ ?/ w( `) D: S9 x
) n( J' G8 ^3 U3 v( k& a7 |* UDim e As String" t" l1 k  K7 K8 U: @# s; `
Dim k As String* ?4 t9 u7 n+ _
Dim t As String
' r, |+ R: Y' a: O' U% 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 A$ `0 s2 ^5 X. k: mDim strmat As String
" F! d7 t6 p- DDim tempvalue As String
" w  n0 _' v# V2 i/ m& E& r" D5 F  G0 |% Q: b, Y
- o) ?$ `2 a( G& L5 x7 Q- B3 Z( ISub main() '刪除所有配置屬性
6 n' b$ t) E$ ]4 l5 p- d; c8 H3 l/ z* n* R9 KSet swApp = Application.SldWorks9 g. p. p7 K6 u7 ?4 x4 W6 n
. `5 x) L! O1 F( oSet Part = swApp.ActiveDoc$ q6 |& ^2 b7 ~/ ]( ^0 R
CurCFGname = Part.GetConfigurationNames
; t! S7 S& t' H- u( m0 L9 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
/ Q# G' ~+ I& v7 `4 P1 Z    Set CusPropMgr = Part.Extension.CustomPropertyManager(CurCFGname(i))
/ X; j2 u6 l' r& ?. G( J! L$ ?  c% B6 }    Vnamearr = CusPropMgr.GetNames4 B$ N4 Q* X) q- [; f8 r0 ^5 {
6 b6 O' j" n7 Q. D+ ^    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
9 E5 L1 X' |4 T        Next- P& E; Z$ s7 V+ a( t' E% T
1 S, V. B" ?5 h8 c2 c5 D* C; q    End If
$ 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
" w, ^/ W0 u, A, S  @1 G2 A8 x% e; G6 r) ]# @' p
" D7 r# [' m2 U5 Z7 k9 B. O: ?'~~~ 刪除自定義屬性 ~~~
: Q6 `! G2 u. ]" |4 i. ?Sub 刪除自定義屬性()
  B# r$ |5 d2 b. o4 x5 W" n+ J'Dim swApp As Object2 Q# s7 O1 ~+ I" }
0 i: @# V+ Z& N( \! g( ~; ~! [5 CDim swModel2 As SldWorks.ModelDoc2
! P0 B. f+ F9 g! f' g# o6 S, e, W4 z+ EDim vCustInfoNameArr2 As Variant7 J* i  U% A! t0 \0 D! h, V
+ o0 w. e9 S# S( ^
, _. O- k( t& R7 H7 k; g- l; @- 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 {
! H" G( s- G# E! IvCustInfoNameArr2 = swModel2.GetCustomInfoNames- N/ C9 m0 n2 t* k9 u
  If Not IsEmpty(vCustInfoNameArr2) Then
3 g$ b: C& ?( o* A/ `! V# Z5 s; g8 P9 J( v  m% Z     For Each vCustInfoName2 In vCustInfoNameArr2- \% O7 w% [: r; T3 |5 M
8 M% f& f% B! D# A- L         bRet = swModel2.DeleteCustomInfo(vCustInfoName2)
# M/ t2 R0 c% I. ?" R/ r# I! y' x7 _' X      Next9 U+ R% V2 G# P
  End If
& 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
Sub partitionTM() 'partitionTM( j# ]! b. Q, G0 M9 E4 f8 B2 J
% l; E) x# ~4 [& t0 {8 [
'link solidworks( C, c- [# N+ Z* [
5 o7 {- }7 E  P2 ]" USet swApp = Application.SldWorks+ w1 D3 {4 b7 ^# i5 p4 ~2 p
( ?+ `2 Q; z. g8 bSet 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
'設(shè)定變量& }. N& d* J$ W) S
c = swApp.ActiveDoc.GetTitle() '零件名
$ b. C/ Z2 v0 I# W6 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("", "材料")
8 ~& d# U$ U6 ~2 h& 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
blnretval = Part.DeleteCustomInfo2("", "材料")
+ U) d- F; R- ]4 V0 e- k2 J; Sa = InStr(c, " ") - 1
" v0 S% D. r) K$ `' iIf a > 0 Then
! e  r2 [5 a  u) Z0 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
        e = "GB/T" + Mid(k, 4)0 C& x4 F4 D' ], i* s8 T
- L: \* G* q3 h3 X+ c    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)
0 {6 Q7 O* e6 L6 Z$ P1 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
) G; Q8 O; Q+ a- \) |* t, |6 u( 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
! P! }' y5 [* }' D6 |        j = Len(b); J( ?# E, |  ?
/ f8 F3 c1 A: K; K3 e    End If8 @/ x5 s, N; \. _& V# V
    m = Left(b, j)
( r1 i1 i9 c8 ~) ~- [( v. P: e' A' P) l4 b& \End If( o3 u- a' n" g; c4 t2 s& ]
blnretval = 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
blnretval = Part.AddCustomInfo3("", "材料", swCustomInfoText, strmat)
$ k: z; _- N: }9 }0 Q/ o7 o9 Z0 O2 e0 Q6 cblnretval = Part.AddCustomInfo3("", "單重", swCustomInfoText, " ")
1 J3 q; {7 P/ j- b! f% h6 R" _; x# T  V; G2 e# V. L; H; {2 wblnretval = Part.AddCustomInfo3("", "備註", swCustomInfoText, " ")
# I1 V/ r( R  _" u) e$ ~: i2 D6 }7 z- @1 t: i# Q, P, {! f% c" J- {6 u; t
End Sub
. T, m' c' l0 |% ^* H/ f

ryouss

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

& c+ W6 u* s+ _5 `$ r- W/ m3 R8 m" W$ @附swp繁體版   
  T( V/ X1 F/ s" |5 f( t8 I

ryouss

% N6 g. L2 H, w試試把   CurCFGname = swApp.GetConfigurationNames

& e/ w) X, A- i8 s" N改為      CurCFGname = swApp.GetConfigurationNames(swApp.ActiveDoc.GetPathName) '補(bǔ)加零件文件的路徑及名稱
' S- ]; \( k3 s) N
在沒補(bǔ)加 (swApp.ActiveDoc.GetPathName) 時(shí)在2012及2015版是會(huì)有提示錯(cuò)誤的(如附圖)
; u- b: \1 Y, f( x7 N5 `另VBA編程在   " '  " 符號(hào)后的文字是會(huì)跳過不執(zhí)行的.



: M* U- Q$ |- e% Y/ r1 f) i. Z

arter_2006

我試過了，改之前，改之后一個(gè)樣，而且執(zhí)行中沒有任何錯(cuò)誤提示。
& }4 p0 h$ m8 G  K' ******************************************************************************
' 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
4 l) |, C. S% R. E- o1 ^; _Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long

9 J" E" b/ z4 n* B5 t$ zDim SelMgr As Object
Dim Feature As Object
" d* v* F) C, [3 v, ZDim a As Integer
, F& U- o4 Z: W& b8 ~- }Dim b As String
) P6 h& {1 n: j  I* @, b/ GDim m As String
3 o" A( x5 C1 i1 bDim e As String
Dim k As String
1 g7 E9 h/ W: E. s, f1 c2 p# tDim t As String
Dim c As String
Dim j As Integer
+ f$ ~5 |/ p' F2 w8 z$ rDim strmat As String
Dim tempvalue As String
% U* p9 |5 [$ j- L# _" A- ^. s
& k( u9 c* v; |% B' ^! @Sub main() '刪除所有配置屬性
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
CurCFGname = swApp.GetConfigurationNames(swApp.ActiveDoc.GetPathName) '補(bǔ)加零件文件的路徑及名稱
/ y6 V5 K4 \- \CurCFGnameCount = Part.GetConfigurationCount
For i = 0 To CurCFGnameCount - 1
    Set CusPropMgr = Part.Extension.CustomPropertyManager(CurCFGname(i))
9 K1 t  A0 D. S- f. {% {5 o3 V    Vnamearr = CusPropMgr.GetNames
    If Not IsEmpty(Vnamearr) Then
        For Each Vnamearr2 In Vnamearr
            bRet = Part.DeleteCustomInfo2(CurCFGname(i), Vnamearr2)
        Next
    End If
7 R7 F- u1 c" l1 l% e) `0 W* f: {Next
' q! [: h, G) \! I- OCall 刪除自定義屬性
+ Y6 P( v, D$ {7 ZCall partitionTM
' y; m0 g; u3 J; i  ?. X
End Sub
8 ^# P) L7 B$ Y$ M
5 U9 b! D) J: `) l& c) i9 P; ]'~~~ 刪除自定義屬性 ~~~
+ X; k( }" O; m0 P1 HSub 刪除自定義屬性()
'Dim swApp As Object
Dim swModel2 As SldWorks.ModelDoc2
Dim vCustInfoNameArr2 As Variant

" [: f. \) c  e0 CSet swApp = Application.SldWorks
- r& k# a$ x8 A: M( q5 s" oSet swModel2 = swApp.ActiveDoc
8 k' M* n( @" ]vCustInfoNameArr2 = swModel2.GetCustomInfoNames
  If Not IsEmpty(vCustInfoNameArr2) Then
1 d7 W* `, t  @% p1 U; x     For Each vCustInfoName2 In vCustInfoNameArr2
0 q" F# }, [" K& e) f         bRet = swModel2.DeleteCustomInfo(vCustInfoName2)
      Next
: z! X* D6 V$ h1 l  End If
& y7 q0 s! B. ]4 S1 Y1 fEnd Sub
, K8 A1 A1 K) G6 B. k2 A
'~~~ partitionTM ~~~
7 H( I3 C( d8 P- R) ZSub partitionTM() 'partitionTM
) k, z* w, C' k  a
'link solidworks
0 N5 l0 U5 {5 a/ r. HSet swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
Set SelMgr = Part.SelectionManager
swApp.ActiveDoc.ActiveView.FrameState = 1
& K0 b3 [! y; z; q'設(shè)定變量
( S! F. F+ }: R, R$ g2 g* {' E4 Oc = swApp.ActiveDoc.GetTitle() '零件名
6 K+ J+ o- ^, `7 p# r- rstrmat = Chr(34) + Trim("SW-Material" + "@") + c + Chr(34)
'tempvalue = Part.CustomInfo2("", "材料")
blnretval = Part.DeleteCustomInfo2("", "代號(hào)")
6 s8 \) |; f# [blnretval = Part.DeleteCustomInfo2("", "名稱")
blnretval = Part.DeleteCustomInfo2("", "材料")

* k+ ~4 `8 m: E0 `0 a
! u3 q( s, W, ~! g" Pa = InStr(c, " ") - 1
, ^& ]0 T# p6 S$ w, W, \If a > 0 Then
    k = Left(c, a)
    t = Left(LTrim(e), 3)

    If t = "GBT" Then
/ u0 c: T# w$ }+ c        e = "GB/T" + Mid(k, 4)
2 w/ h/ Z% s& ~$ Z5 s    Else
' Q) }; X: \8 s: }6 W        e = k
$ _: O2 }1 U; G+ h; f6 \4 _    End If

    b = Mid(c, a + 2)
: `7 S+ o. P; H. D    t = Right(c, 7)
    If t = ".SLDPRT" Or t = ".SLDASM" Then
        j = Len(b) - 7
    Else
        j = Len(b)
    End If
    m = Left(b, j)
, F. ^. h1 Q$ Z" X- S$ s( LEnd If
6 W8 ~6 w- |- [% p# y
blnretval = Part.AddCustomInfo3("", "代號(hào)", swCustomInfoText, e)
blnretval = Part.AddCustomInfo3("", "名稱", swCustomInfoText, m)
0 H1 D( }: T9 m3 o3 O% Jblnretval = Part.AddCustomInfo3("", "材料", swCustomInfoText, strmat)
: u, E1 O+ D/ b9 {blnretval = Part.AddCustomInfo3("", "單重", swCustomInfoText, " ")
blnretval = Part.AddCustomInfo3("", "備注", swCustomInfoText, " ")
4 T. o& h: p8 G6 h  U
End Sub