SOLIDWORKS 宏合并执行的问题

ryouss

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

1. ' ******************************************************************************
   , h' Y( r  w1 I5 q; c0 F
2. ' C:\Users\admin\AppData\Local\Temp\swx8144\Macro1.swb - macro recorded on 11/22/18 by mqlu
   + U6 ]5 ]% D) @4 O2 q/ v
3. ' ******************************************************************************
   
4. Dim swApp As Object
   ; @; n( a; u; L$ E# F% T! n
5. Dim Part As Object
   
6. Dim boolstatus As Boolean
   
7. Dim longstatus As Long, longwarnings As Long
   ; e2 n  A% k' s
8. 
   
9. Dim SelMgr As Object
   
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
    
15. Dim k As String
    
16. Dim t As String
    
17. Dim c As String
    
18. Dim j As Integer
    ) Q' Y  k6 L1 S+ K5 P: ?: h
19. Dim strmat As String
    ' g! P: ]5 M! J% p9 R# f( ^
20. Dim tempvalue As String
    
21. 
    
22. Sub main() '刪除所有配置屬性
    
23. Set swApp = Application.SldWorks
    ! a5 P9 ]% T  C" u* ^/ N& [
24. Set Part = swApp.ActiveDoc
    : y- k% X. I1 v, n
25. CurCFGname = Part.GetConfigurationNames
    % P% A' L3 o8 Q3 K
26. CurCFGnameCount = Part.GetConfigurationCount
    
27. For i = 0 To CurCFGnameCount - 1
    
28.     Set CusPropMgr = Part.Extension.CustomPropertyManager(CurCFGname(i))
    
29.     Vnamearr = CusPropMgr.GetNames
    
30.     If Not IsEmpty(Vnamearr) Then
    2 J$ }- x6 M; a' ~
31.         For Each Vnamearr2 In Vnamearr
    
32.             bRet = Part.DeleteCustomInfo2(CurCFGname(i), Vnamearr2)
    # K6 m+ @7 `$ t( v
33.         Next
    
34.     End If
    # P8 f, h, {& B" D/ V" ]6 X! Q
35. Next
    9 `6 _/ ~( T+ O; U; {. B. o  S& k$ j
36. Call 刪除自定義屬性
    1 N. {5 |5 j( o  m
37. Call partitionTM
    
38. 
    + T( j/ m; E; e7 ?! q
39. End Sub
    
40. 
    
41. '~~~ 刪除自定義屬性 ~~~
    ; B7 A7 u; g! J! r. E
42. Sub 刪除自定義屬性()
    7 n* V1 G4 m( v% t+ M* Y& ^; L  ^  W2 C. P
43. 'Dim swApp As Object
    
44. Dim swModel2 As SldWorks.ModelDoc2
    
45. Dim vCustInfoNameArr2 As Variant
    % X. @. z$ e: W# K
46. 
    6 V! k1 H8 w3 z! C/ S, v4 r
47. Set swApp = Application.SldWorks
    - v1 F8 x) P5 M0 T/ r
48. Set swModel2 = swApp.ActiveDoc
    * L$ K; s- ]7 a! r, @$ h- W* l
49. vCustInfoNameArr2 = swModel2.GetCustomInfoNames
    3 w' y2 H0 N7 j! H& e$ `
50.   If Not IsEmpty(vCustInfoNameArr2) Then
    9 H' J' C, _% E" i7 V" h
51.      For Each vCustInfoName2 In vCustInfoNameArr2
    
52.          bRet = swModel2.DeleteCustomInfo(vCustInfoName2)
    * _7 j# g% ^8 T4 m- }; t6 Z9 c2 T
53.       Next
    
54.   End If
    
55. End Sub
    + ^& `  l' j3 I+ T9 e7 k) g
56. 
    
57. '~~~ partitionTM ~~~
    
58. Sub partitionTM() 'partitionTM
    , q( l* e9 I2 B- x. G) h
59. 
    
60. 'link solidworks
    - H" h# h6 W1 T$ ?3 h
61. Set swApp = Application.SldWorks
    
62. Set Part = swApp.ActiveDoc
    ( F7 x* v& G' q2 P4 n
63. Set SelMgr = Part.SelectionManager
    , Z- P4 m5 R' I0 }* H! \" ~# m
64. swApp.ActiveDoc.ActiveView.FrameState = 1
    
65. '設定變量
    , A3 I1 I4 J( f! H. b+ x: A
66. c = swApp.ActiveDoc.GetTitle() '零件名
    
67. strmat = Chr(34) + Trim("SW-Material" + "@") + c + Chr(34)
    0 G; d1 x4 G! U1 F- M  X
68. 'tempvalue = Part.CustomInfo2("", "材料")
    ) a, a: S4 p  p" v( b( \7 @
69. blnretval = Part.DeleteCustomInfo2("", "代號")
    
70. blnretval = Part.DeleteCustomInfo2("", "名稱")
    
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)
    
76.     If t = "GBT" Then
    
77.         e = "GB/T" + Mid(k, 4)
    
78.     Else
    . Q( D+ E5 u3 T3 u# s
79.         e = k
    
80.     End If
    
81.     b = Mid(c, a + 2)
    6 }4 F; Z* |; a! I
82.     t = Right(c, 7)
    
83.     If t = ".SLDPRT" Or t = ".SLDASM" Then
    3 t' |  p5 P) K8 X7 \- }
84.         j = Len(b) - 7
    5 l. |" i" |: K( v: H" C+ E
85.     Else
    " H- {, j2 c+ ~
86.         j = Len(b)
    
87.     End If
    
88.     m = Left(b, j)
    
89. End If
    
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, " ")
    ) ~  ], b& O/ Q
95. 
    # a) y' k# h7 e
96. End Sub

复制代码

: C) |0 V0 t2 Y* W8 Y
/ M" D! ?; d) v& L/ S9 m

$ T* A. a; F6 w/ Q# c' [% M5 j

arter_2006

ryouss 发表于 2018-11-25 11:32
就是如下的繁体字改為簡体字就是

$ D0 m6 q* e$ b5 h2 W! r1 t+ H; O执行后无反应，属性都没改，不知道问题出在哪里？让您费心了。

1 @5 g* {& B7 U" t3 ~9 b' ******************************************************************************
5 P. A' ~* n' s; ]) Y) t' C:\Users\admin\AppData\Local\Temp\swx8144\Macro1.swb - macro recorded on 11/22/18 by mqlu
' ******************************************************************************
3 A" ]5 d1 t  b- [Dim swApp As Object
Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
0 V( K# x" \& _' x6 Z/ d1 N( v7 z$ Y
Dim SelMgr As Object
Dim Feature As Object
Dim a As Integer
Dim b As String
! u) U0 Y: K7 Q9 w! A2 D4 n6 eDim m As String
3 \% X& s' N5 O4 m$ A+ T  CDim e As String
, o3 h7 o$ V& C# u3 k: r- T8 ?: lDim k As String
Dim t As String
Dim c As String
9 e- S& W3 p7 M7 C# qDim j As Integer
Dim strmat As String
Dim tempvalue As String
- Q) l. b4 s1 b8 l; j; Z
& s7 H9 Q, o' k9 c) k" O! ISub main() '刪除所有配置属性
- ?/ {' s1 g4 g8 ]4 J: bSet swApp = Application.SldWorks
+ W, ~3 h# X  a& X5 x. q! `3 YSet Part = swApp.ActiveDoc
6 f7 J! \, \6 D% P' j# A% }CurCFGname = Part.GetConfigurationNames
CurCFGnameCount = Part.GetConfigurationCount
For i = 0 To CurCFGnameCount - 1
    Set CusPropMgr = Part.Extension.CustomPropertyManager(CurCFGname(i))
    Vnamearr = CusPropMgr.GetNames
    If Not IsEmpty(Vnamearr) Then
# U7 Q! T* ], d. y        For Each Vnamearr2 In Vnamearr
# ^1 A  i: }( F( v' z: `( L, q' }, K( }            bRet = Part.DeleteCustomInfo2(CurCFGname(i), Vnamearr2)
# N: a/ s5 L' m; O9 Q        Next
    End If
Next
Call 刪除自定义属性
) D( S( O: {: @& `% \; Q4 ~2 A: oCall partitionTM
; X! Y. D+ g! L+ o; O5 y
" P3 S. F/ S& g+ VEnd Sub

3 u$ h" A. K9 k% v1 Q( t, Q'~~~ 刪除自定义属性 ~~~
* ]; g& @( W' ?' F) I5 V" uSub 刪除自定义属性()
; s+ Y( g+ X( M! w. g* o7 p3 s'Dim swApp As Object
% O( }- q5 c+ ~- o' O! }Dim swModel2 As SldWorks.ModelDoc2
* Q( j  X" |9 G) I; O8 pDim vCustInfoNameArr2 As Variant

Set swApp = Application.SldWorks
Set swModel2 = swApp.ActiveDoc
7 f, o: j7 m+ |1 e: O2 _8 F1 B: Y5 cvCustInfoNameArr2 = swModel2.GetCustomInfoNames
  If Not IsEmpty(vCustInfoNameArr2) Then
     For Each vCustInfoName2 In vCustInfoNameArr2
         bRet = swModel2.DeleteCustomInfo(vCustInfoName2)
      Next
  End If
End Sub

$ l" m6 l8 m/ U! @'~~~ partitionTM ~~~
Sub partitionTM() 'partitionTM
* q8 F# m. M- ?2 v( o. e
'link solidworks
Set swApp = Application.SldWorks
2 C- Q9 u; P$ R" t1 ZSet Part = swApp.ActiveDoc
: Q. V: ^0 l. R; ~3 S3 pSet SelMgr = Part.SelectionManager
' @  v3 Y9 b2 ], y; F# WswApp.ActiveDoc.ActiveView.FrameState = 1
) Q! M/ D9 F5 @# |: X'设定变量
c = swApp.ActiveDoc.GetTitle() '零件名
; l& S7 x# s1 e0 [4 l1 n3 Q2 hstrmat = Chr(34) + Trim("SW-Material" + "@") + c + Chr(34)
'tempvalue = Part.CustomInfo2("", "材料")
2 }) b# j0 t3 _. r: a* ^blnretval = Part.DeleteCustomInfo2("", "代号")
9 B4 n3 ]: n. nblnretval = Part.DeleteCustomInfo2("", "名称")
blnretval = Part.DeleteCustomInfo2("", "材料")
+ k/ ~+ m" v" y8 v3 M  [; la = InStr(c, " ") - 1
If a > 0 Then
  B& z* A8 z5 R" G    k = Left(c, a)
    t = Left(LTrim(e), 3)
    If t = "GBT" Then
        e = "GB/T" + Mid(k, 4)
3 m, B" t& ^) X& q0 ^    Else
        e = k
    End If
    b = Mid(c, a + 2)
0 y/ x7 _' k2 U9 n    t = Right(c, 7)
+ v- a/ Q, p: s    If t = ".SLDPRT" Or t = ".SLDASM" Then
( q! x' \5 Z: _, ~- P, u, p# f' f        j = Len(b) - 7
    Else
  V4 k. `- B4 e        j = Len(b)
6 c0 o2 x4 r+ k/ R; Z; u8 |; K    End If
    m = Left(b, j)
End If
+ P. x5 Q9 w$ J7 Z  e1 E# x) }blnretval = Part.AddCustomInfo3("", "代号", swCustomInfoText, e)
! `/ u, f7 F) _" bblnretval = Part.AddCustomInfo3("", "名称", swCustomInfoText, m)
blnretval = Part.AddCustomInfo3("", "材料", swCustomInfoText, strmat)
blnretval = Part.AddCustomInfo3("", "单重", swCustomInfoText, " ")
blnretval = Part.AddCustomInfo3("", "备注", swCustomInfoText, " ")

) s/ k8 d% ]4 \/ l9 KEnd Sub
2 f  H) o9 G3 v* j

ryouss

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

$ p) u. [$ ?# H; W- g# ^# o0 d# u' ********************************** ...

# h( R. D( s% s7 C  G1 esw2017 測試OK
有否顯示什麼錯誤提示?


. [4 V) U: u/ {  u# D

# F9 _% A3 C7 u; ^

arter_2006

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

ryouss

arter_2006 发表于 2018-11-26 17:00
9 B) S; v# m; E% z: w8 F7 _, e我的是Solidworks 2018，看来可能是版本的问题了

2018 沒版本能試

arter_2006

ryouss 发表于 2018-11-26 17:05
; q, q7 I1 a: K6 S& p2018 沒版本能試

9 y( F" \6 ?$ n$ F& t非常感谢您，让您费心了。

arter_2006

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

能否把您的SWP文件发上来，我刚才用solidworks 2014也试了一下，发现也不行，但是别的宏都可以。
% O1 ?6 b  k8 J3 p. a9 K3 y0 Q我从网页上复制下来的都变成下面这个样子了，所以要删掉很多多出来的东西，我怀疑是不是这个原因导致的，但是校对很费时间，也难发现。

& O' d6 Q2 b) e* O! O) P3 I2 }. A' ******************************************************************************3 \3 X) J3 n, I6 @4 |0 x
2 S5 h* I% i) m3 \8 T" S6 [8 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
- Z2 W: I2 ~' _  W' ******************************************************************************
: 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
5 K& Q2 T1 D" u1 W2 N' t/ m7 Y3 J( R9 \8 _3 m& \) d/ \Dim SelMgr As Object
: [9 p5 h9 v3 s6 z: 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
% r4 H9 ?) ]) j) T, J7 G& 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
4 s1 Y6 A5 E- l, UDim m As String+ ?/ w( `) D: S9 x
6 n# U, k9 o5 S+ D* |Dim e As String" t" l1 k  K7 K8 U: @# s; `
6 v2 X/ H, L/ j9 UDim k As String* ?4 t9 u7 n+ _
' r3 G2 B6 n+ C" C+ b* hDim t As String
% R* ?6 C5 B( @3 D& DDim c As String
5 ~* r8 U5 q" n/ A0 J1 i; b! K3 d. @4 X+ d/ Q. _. p: yDim j As Integer3 N( z+ v  K2 q* v6 D
  H& W- n& e2 uDim strmat As String
* v" D2 |* n% h3 D" F! d7 t6 p- DDim tempvalue As String
& E& r" D5 F  G0 |% Q: b, Y
4 ^  v( W" J! j: h. U3 `- 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
Set Part = swApp.ActiveDoc$ q6 |& ^2 b7 ~/ ]( ^0 R
CurCFGname = Part.GetConfigurationNames
; [* \  |5 _3 x% C- [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 {
6 u! H4 Z! N7 p; G& |& r( ]2 g    If Not IsEmpty(Vnamearr) Then' t" n; u" h( T
! m" y% `3 a; F8 K8 n" q: c) p        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
$ A3 @6 S" n' d2 eNext
  k" k4 f; K$ vCall 刪除自定義屬性
( A- x) f" C" d8 G6 }) {# {' iCall partitionTM4 }2 o$ e' E7 t
8 q. e2 |; K" l1 {8 E
* j: ~6 u% v6 B! X# H6 f% p2 @8 q. ~" b  {% q" `4 h6 {End Sub
9 T7 ~1 g  B4 ^% 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" }
3 A+ [2 G4 X. p4 cDim swModel2 As SldWorks.ModelDoc2
! 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
3 s  I( e/ a% J5 G4 S  i4 [' W6 ]0 I* U0 V' O' B+ NSet swModel2 = swApp.ActiveDoc3 u) Z+ D2 D4 z; M# d4 {
vCustInfoNameArr2 = swModel2.GetCustomInfoNames- N/ C9 m0 n2 t* k9 u
  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)
' D8 x# ?2 \  V4 F# ]5 o. ?" R/ r# I! y' x7 _' X      Next9 U+ R% V2 G# P
  End If
& V, L( M& Q4 l& b0 TEnd Sub
; n" e+ t0 v' u# z6 M- K7 `: z' w) T+ c$ V; G
$ y5 r( x9 D6 i" P! E; M" F/ j9 |  ?( U5 a+ K'~~~ partitionTM ~~~7 O3 t. l4 R1 [+ ]3 K  G+ M
9 y1 u6 K7 B/ z4 X0 mSub partitionTM() 'partitionTM( j# ]! b. Q, G0 M9 E4 f8 B2 J
% l; E) x# ~4 [& t0 {8 [
'link solidworks( C, c- [# N+ Z* [
- s' {1 f0 m, H* N6 d2 \/ z/ |Set 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
' o6 t! h9 j- PswApp.ActiveDoc.ActiveView.FrameState = 1& ?6 I  _. Y+ \4 m7 P" c% W/ h
'設定變量& }. N& d* J$ W) S
5 x+ y* _% _4 ^& ?c = swApp.ActiveDoc.GetTitle() '零件名
- p# t) ]' @" j6 g" Q. {8 L5 ~" z0 y# g! I" Estrmat = Chr(34) + Trim("SW-Material" + "@") + c + Chr(34). w+ f3 v( W- `* D! G! v. z
; k/ J/ m7 w- _  j9 k6 k5 s* q% @3 D'tempvalue = Part.CustomInfo2("", "材料")
. x9 c. r, ]6 r( I, t* {8 {  y& 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
5 U$ A8 Y- w+ jblnretval = Part.DeleteCustomInfo2("", "材料")
+ U) d- F; R- ]4 V0 e- k2 J; Sa = InStr(c, " ") - 1
" v0 S% D. r) K$ `' iIf a > 0 Then
# l) X$ ]& o% B4 R+ f0 D& _% k+ M" K3 ~    k = Left(c, a)0 D( T  G4 u* @' Z: h# g5 h) k
( S5 L6 Z. {' s& h( D; \/ d7 F6 V    t = Left(LTrim(e), 3)0 |: d+ H% K1 I5 d; ^& r
    If t = "GBT" Then0 a: k4 H  }1 j) y
7 c5 A0 r; z9 _! V3 H% t        e = "GB/T" + Mid(k, 4)0 C& x4 F4 D' ], i* s8 T
    Else
: I1 v; o/ W$ {$ K! A! W2 i7 C- b( f1 H* X4 B; P        e = k& O7 M7 ]$ E: v$ n5 ]  ?0 p$ z
6 c, k$ H3 b+ i" c5 T( A2 U    End If! C- h9 R! k; n% D6 G+ S; P
    b = Mid(c, a + 2)
. Z1 k* X8 H3 J0 I8 V# K1 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' \
; S, _8 p5 N  T" G. i1 k    Else& f9 y# D- W/ Y! i& w- H
$ t  b% p8 N8 Q1 R        j = Len(b); J( ?# E, |  ?
1 K2 P. ^7 q. c! a8 F    End If8 @/ x5 s, N; \. _& V# V
5 y% Q3 O  B' p. S7 G# _5 p* X    m = Left(b, j)
. P: e' A' P) l4 b& \End If( o3 u- a' n" g; c4 t2 s& ]
blnretval = Part.AddCustomInfo3("", "代號", swCustomInfoText, e)
" j4 l. d, y1 t, ^3 E: F  K  N' M% L5 C4 Hblnretval = Part.AddCustomInfo3("", "名稱", swCustomInfoText, m)7 a/ m( J8 q$ B) ^& B( M# Q' V
; p, v8 |' p# [: A, Sblnretval = Part.AddCustomInfo3("", "材料", swCustomInfoText, strmat)
9 Z0 O2 e0 Q6 cblnretval = Part.AddCustomInfo3("", "單重", swCustomInfoText, " ")
, a! F* Y# c- i: P9 }) v4 Z. P+ D  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
" m5 |; T& i: j2 D5 FEnd Sub

' Z) U* R" e) z9 c7 W% j" q  y2 v

ryouss

arter_2006 发表于 2018-11-26 17:27
" k, _) I1 l7 }能否把您的SWP文件发上来，我刚才用solidworks 2014也试了一下，发现也不行，但是别的宏都可以。
8 D! P5 T8 \% Q3 l$ c& e我从网 ...

附swp繁体版   
, H5 {. }; B% `! q

ryouss

* r2 ~" Y0 E# u1 `4 ?& k試試把   CurCFGname = swApp.GetConfigurationNames

7 O) [9 D0 F3 Y( d7 A改為      CurCFGname = swApp.GetConfigurationNames(swApp.ActiveDoc.GetPathName) '補加零件文件的路徑及名稱

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

8 |) ]1 ?! V7 O6 m2 a
9 |3 R4 l- Y' M8 o7 `

arter_2006

我试过了，改之前，改之后一个样，而且执行中没有任何错误提示。
' ******************************************************************************
' C:\Users\admin\AppData\Local\Temp\swx8144\Macro1.swb - macro recorded on 11/22/18 by mqlu
' ******************************************************************************
4 q" d, H( t3 TDim swApp As Object
0 C5 X: H3 Y6 e$ d* U6 YDim Part As Object
" W. m, s  H6 B0 Y4 ZDim boolstatus As Boolean
2 }0 C# G( t1 M/ @/ KDim longstatus As Long, longwarnings As Long
) m$ H1 \  H( K8 Z1 H$ |: F- E
1 }) f, n# e9 z4 z. ODim SelMgr As Object
! ^( D' Q  T' ODim Feature As Object
Dim a As Integer
Dim b As String
, [0 b1 }/ Y7 ]5 RDim m As String
Dim e As String
/ p$ ?2 e/ g7 _# p( l0 mDim k As String
Dim t As String
Dim c As String
6 T* d$ G, P/ z: PDim j As Integer
, p+ b2 p8 T, ?0 `/ lDim strmat As String
Dim tempvalue As String

Sub main() '刪除所有配置属性
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
CurCFGname = swApp.GetConfigurationNames(swApp.ActiveDoc.GetPathName) '补加零件文件的路径及名称
5 R$ j/ j7 \  r! ~CurCFGnameCount = Part.GetConfigurationCount
- v- X% W& ~+ p. L7 B/ t3 K% r! w7 x2 V- MFor i = 0 To CurCFGnameCount - 1
0 B5 I% C4 j  R: V+ G0 E, p) @    Set CusPropMgr = Part.Extension.CustomPropertyManager(CurCFGname(i))
9 l* M8 [6 p' N, }! ]: u7 f    Vnamearr = CusPropMgr.GetNames
    If Not IsEmpty(Vnamearr) Then
2 G* f! E) v4 Y( Z2 d9 ]* \        For Each Vnamearr2 In Vnamearr
. Q+ W# h( [5 Q5 }            bRet = Part.DeleteCustomInfo2(CurCFGname(i), Vnamearr2)
9 Z. F' ?  ]/ k2 P7 e' l        Next
    End If
Next
Call 刪除自定义属性
; w+ C8 d# d; ?  G1 J6 ZCall partitionTM
9 y+ y9 l6 c- D/ k2 E3 x
$ q" H- W8 N' I$ i- u4 m# wEnd Sub
" j+ m8 t/ t  `2 p- V
. B. P0 p" {% |4 ^- i'~~~ 刪除自定义属性 ~~~
- \7 A7 x& J) N; v& SSub 刪除自定义属性()
2 V  R% L* y8 [( G* H'Dim swApp As Object
* r) }( {* }) DDim swModel2 As SldWorks.ModelDoc2
' |; a; R% |$ w5 ?6 hDim vCustInfoNameArr2 As Variant

' @4 E) m+ C/ X2 r" z# q' `% MSet swApp = Application.SldWorks
8 m  q4 q0 _" G' d9 t, eSet swModel2 = swApp.ActiveDoc
vCustInfoNameArr2 = swModel2.GetCustomInfoNames
! h- ~% |" [7 L) J' \* D, p. W  If Not IsEmpty(vCustInfoNameArr2) Then
* u" v4 v2 ?8 t; O/ B     For Each vCustInfoName2 In vCustInfoNameArr2
" I9 n2 q2 ^; y6 b! K         bRet = swModel2.DeleteCustomInfo(vCustInfoName2)
      Next
  End If
" q+ w8 |1 p0 Q0 g& w2 DEnd Sub

'~~~ partitionTM ~~~
Sub partitionTM() 'partitionTM

'link solidworks
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
* C: R$ U, ?2 y9 Z( m: C5 ^2 m' u* E. aSet SelMgr = Part.SelectionManager
swApp.ActiveDoc.ActiveView.FrameState = 1
* T4 Z! R1 ^* _1 S% {'设定变量
0 q0 d% c5 d+ hc = swApp.ActiveDoc.GetTitle() '零件名
8 R1 U2 ^7 ^3 n$ ^, _+ R, gstrmat = Chr(34) + Trim("SW-Material" + "@") + c + Chr(34)
* u8 x5 x& |  z" D6 m, U'tempvalue = Part.CustomInfo2("", "材料")
blnretval = Part.DeleteCustomInfo2("", "代号")
blnretval = Part.DeleteCustomInfo2("", "名称")
" N# N! ?& x# E8 Mblnretval = Part.DeleteCustomInfo2("", "材料")
- e) V9 D) B- [( o8 ^; Y& p% _

a = InStr(c, " ") - 1
If a > 0 Then
    k = Left(c, a)
    t = Left(LTrim(e), 3)

* U# @6 S4 r2 B' m) ^    If t = "GBT" Then
        e = "GB/T" + Mid(k, 4)
' w) q+ k# N: E% ]    Else
        e = k
7 e: M8 e- j* c; L0 P, B    End If

' Y1 C# X: M. E8 b% S    b = Mid(c, a + 2)
! E% N8 F1 a. r/ W    t = Right(c, 7)
    If t = ".SLDPRT" Or t = ".SLDASM" Then
* q: A0 E# x5 ]& Z8 k' R# j, b        j = Len(b) - 7
, R( J+ \6 a- E/ x" \) l    Else
) Y+ L5 _  b2 e- i" H        j = Len(b)
    End If
    m = Left(b, j)
/ F1 L0 m$ [$ W, K# r- dEnd If

" b$ P  {! `' w" m, Gblnretval = Part.AddCustomInfo3("", "代号", swCustomInfoText, e)
! V, p$ m  s$ q6 x% A2 R( zblnretval = Part.AddCustomInfo3("", "名称", swCustomInfoText, m)
- w* @7 N% U6 U" ^, bblnretval = Part.AddCustomInfo3("", "材料", swCustomInfoText, strmat)
blnretval = Part.AddCustomInfo3("", "单重", swCustomInfoText, " ")
: I, `9 D- }5 q3 C% N" r6 r' bblnretval = Part.AddCustomInfo3("", "备注", swCustomInfoText, " ")

End Sub