SOLIDWORKS 宏合并执行的问题

ryouss

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


; H" z/ N9 ]9 M  b

1. ' ******************************************************************************
   
2. ' C:\Users\admin\AppData\Local\Temp\swx8144\Macro1.swb - macro recorded on 11/22/18 by mqlu
   : j6 U6 V. P+ C$ y
3. ' ******************************************************************************
   
4. Dim swApp As Object
   
5. Dim Part As Object
   ; U9 ~0 N/ E) I* o3 C& A
6. Dim boolstatus As Boolean
   " O' l1 ]0 |! h4 o$ f
7. Dim longstatus As Long, longwarnings As Long
   % D. d& u5 J/ g6 q3 ~% C0 U
8. 
   
9. Dim SelMgr As Object
   
10. Dim Feature As Object
    
11. Dim a As Integer
    9 `5 e! v# _7 p) @- I
12. Dim b As String
    
13. Dim m As String
    
14. Dim e As String
    ! G+ W+ P! S& R2 ^7 J. F
15. Dim k As String
    
16. Dim t As String
    
17. Dim c As String
    / w+ w7 t6 F" X/ p9 g
18. Dim j As Integer
    
19. Dim strmat As String
    9 d; O  M9 p% [' H# Z% b3 B1 s
20. Dim tempvalue As String
    
21. 
    3 q* [- o9 ~& G8 u
22. Sub main() '刪除所有配置屬性
    ! E' H% [- a8 Z
23. Set swApp = Application.SldWorks
    4 Q" D% N* V3 _7 U! H( F
24. Set Part = swApp.ActiveDoc
    
25. CurCFGname = Part.GetConfigurationNames
    - D- }; P  L% C5 Z
26. CurCFGnameCount = Part.GetConfigurationCount
    / M2 P: L; s  \0 y6 `
27. For i = 0 To CurCFGnameCount - 1
    7 g- t4 z# `( P8 v- a
28.     Set CusPropMgr = Part.Extension.CustomPropertyManager(CurCFGname(i))
    
29.     Vnamearr = CusPropMgr.GetNames
    ) O! O% }* e9 c
30.     If Not IsEmpty(Vnamearr) Then
    6 |9 A' c! T4 P9 H  W. q0 ^8 j. `
31.         For Each Vnamearr2 In Vnamearr
    
32.             bRet = Part.DeleteCustomInfo2(CurCFGname(i), Vnamearr2)
    4 a% t3 f9 f8 Y2 C, t5 P* p
33.         Next
    9 w- C+ B2 l* J
34.     End If
    
35. Next
    & m6 w6 J" R6 J
36. Call 刪除自定義屬性
    ( @  h: m) n2 }
37. Call partitionTM
    
38. 
    
39. End Sub
    : O/ b  [- N! a$ _
40. 
    
41. '~~~ 刪除自定義屬性 ~~~
    
42. Sub 刪除自定義屬性()
    8 A* D' _( N+ r8 a& j2 Z6 S3 ^
43. 'Dim swApp As Object
    . o1 |4 q2 f# k# P8 E( _
44. Dim swModel2 As SldWorks.ModelDoc2
    8 g# G: r& P; Z
45. Dim vCustInfoNameArr2 As Variant
    
46. 
    " h" }) A' H# E. O  p/ ?- @% x
47. Set swApp = Application.SldWorks
    
48. Set swModel2 = swApp.ActiveDoc
    ) b, j5 l& m" g. l# M: I: b( \! k6 Y! v' X
49. vCustInfoNameArr2 = swModel2.GetCustomInfoNames
    
50.   If Not IsEmpty(vCustInfoNameArr2) Then
    ' i5 G) ^& K7 n
51.      For Each vCustInfoName2 In vCustInfoNameArr2
    1 f3 w/ s  z# ]
52.          bRet = swModel2.DeleteCustomInfo(vCustInfoName2)
    & B- b- O7 _! R9 v  p. ]
53.       Next
    
54.   End If
    
55. End Sub
    0 s% W* d" T0 K- ]1 b) _8 l6 A
56. 
    
57. '~~~ partitionTM ~~~
    / d: v* `. j9 l( c
58. Sub partitionTM() 'partitionTM
    
59. 
    : b& a3 k. ^; u8 q# [6 F3 n
60. 'link solidworks
    * u$ m7 i9 G' `) V% o- W# t/ t+ ]
61. Set swApp = Application.SldWorks
    
62. Set Part = swApp.ActiveDoc
    & o4 ^4 \; u2 r
63. Set SelMgr = Part.SelectionManager
      o5 Y4 d& v. U. r& o4 R7 x9 z# j
64. swApp.ActiveDoc.ActiveView.FrameState = 1
    ; y/ b* T2 @* y5 i. r
65. '設定變量
    
66. c = swApp.ActiveDoc.GetTitle() '零件名
    7 X" G/ T' w1 {5 J3 j- O% \. }
67. strmat = Chr(34) + Trim("SW-Material" + "@") + c + Chr(34)
    
68. 'tempvalue = Part.CustomInfo2("", "材料")
    
69. blnretval = Part.DeleteCustomInfo2("", "代號")
    , q% _8 H8 K0 G& |) x
70. blnretval = Part.DeleteCustomInfo2("", "名稱")
    
71. blnretval = Part.DeleteCustomInfo2("", "材料")
    * J# @2 S7 L" _- F; ]# `
72. a = InStr(c, " ") - 1
    6 D+ {/ w. C. z! ]  q
73. If a > 0 Then
    
74.     k = Left(c, a)
    " d) D/ c$ F# {/ e; q
75.     t = Left(LTrim(e), 3)
    * P' B9 q2 n  t5 W7 q5 m' v
76.     If t = "GBT" Then
    9 \! e8 m1 ~6 n7 G9 m( W# w
77.         e = "GB/T" + Mid(k, 4)
    * N% b8 j0 ^, t% P' {
78.     Else
    , W% E  O0 N3 H
79.         e = k
    % {4 c& [+ p: q6 `5 A4 V/ q- W
80.     End If
    ( G; H5 u9 X; V: `5 A5 a7 v
81.     b = Mid(c, a + 2)
    1 k" j& `3 F5 b, `) c; a+ D
82.     t = Right(c, 7)
    ; s" w3 T; a7 X$ D/ H
83.     If t = ".SLDPRT" Or t = ".SLDASM" Then
    $ {, W$ p, A0 \( e+ e
84.         j = Len(b) - 7
    
85.     Else
    
86.         j = Len(b)
    
87.     End If
    
88.     m = Left(b, j)
    ' b- _& K6 c: f
89. End If
    
90. blnretval = Part.AddCustomInfo3("", "代號", swCustomInfoText, e)
    
91. blnretval = Part.AddCustomInfo3("", "名稱", swCustomInfoText, m)
    & }" N9 `: W8 Q* o3 w4 z: @0 m
92. blnretval = Part.AddCustomInfo3("", "材料", swCustomInfoText, strmat)
    
93. blnretval = Part.AddCustomInfo3("", "單重", swCustomInfoText, " ")
    " k+ x- P2 P) Q4 t6 [9 Z  [9 c
94. blnretval = Part.AddCustomInfo3("", "備註", swCustomInfoText, " ")
    # x, k6 c  B% k
95. 
    # W# @, f! e# Z' L
96. End Sub

复制代码

arter_2006

ryouss 发表于 2018-11-25 11:32
3 ~  c/ N0 m8 v+ v就是如下的繁体字改為簡体字就是

执行后无反应，属性都没改，不知道问题出在哪里？让您费心了。

+ w0 D; M" B4 [% z' ******************************************************************************
' 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
6 A8 d4 u; o5 c0 f" kDim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
$ B# `5 i* ]& r
& C/ N; |5 O* H3 w+ ]8 n1 }Dim SelMgr As Object
# A  E7 ?' w1 t; u2 x( lDim Feature As Object
; @: x) ]* z, zDim a As Integer
Dim b As String
Dim m As String
Dim e As String
9 ]  D. e( f8 q. S- uDim k As String
Dim t As String
# }' {/ w  G# H7 f3 y$ uDim c As String
2 Q2 C8 Z" M0 KDim j As Integer
1 E; e' X/ o+ _+ A* u( Y2 qDim strmat As String
Dim tempvalue As String

& `( j& V; B  F5 r& iSub main() '刪除所有配置属性
Set swApp = Application.SldWorks
' D' |4 }8 @: [8 Q# ASet Part = swApp.ActiveDoc
; q( f. C9 n3 U2 z3 FCurCFGname = Part.GetConfigurationNames
CurCFGnameCount = Part.GetConfigurationCount
For i = 0 To CurCFGnameCount - 1
    Set CusPropMgr = Part.Extension.CustomPropertyManager(CurCFGname(i))
/ t  i4 v5 l6 i. s1 _    Vnamearr = CusPropMgr.GetNames
. ^, a2 k' B5 X7 P    If Not IsEmpty(Vnamearr) Then
1 v& _  s  o6 i7 F+ B        For Each Vnamearr2 In Vnamearr
            bRet = Part.DeleteCustomInfo2(CurCFGname(i), Vnamearr2)
0 r9 M. A" q( u& i8 f1 o& {* i        Next
    End If
1 e* w, {9 |. D( m! ~6 xNext
9 i, p, q; h2 m. Z. U  @$ W9 BCall 刪除自定义属性
Call partitionTM

! y+ r* c: x; H  S' C3 SEnd Sub

'~~~ 刪除自定义属性 ~~~
Sub 刪除自定义属性()
5 u  |! M7 e* h; F+ l% J1 z'Dim swApp As Object
/ o, z' U6 z" N; x' Z2 mDim swModel2 As SldWorks.ModelDoc2
9 g3 W3 `  M. V0 wDim vCustInfoNameArr2 As Variant

Set swApp = Application.SldWorks
' `- J! N- S+ K( C5 bSet swModel2 = swApp.ActiveDoc
  F0 P" ?6 }1 V, fvCustInfoNameArr2 = swModel2.GetCustomInfoNames
: ]9 y; L* Q+ |) k& i  If Not IsEmpty(vCustInfoNameArr2) Then
9 `: i/ v: \3 L9 ]: i) f     For Each vCustInfoName2 In vCustInfoNameArr2
         bRet = swModel2.DeleteCustomInfo(vCustInfoName2)
/ u& Q. U) E/ x      Next
0 s% s, N# j9 y( D  End If
End Sub

'~~~ partitionTM ~~~
* f! H2 B% V9 D/ b, s3 FSub partitionTM() 'partitionTM

; ^  V4 ^* s9 J5 M'link solidworks
Set swApp = Application.SldWorks
- F0 Y$ p' C' e- W9 ~8 O! g! rSet Part = swApp.ActiveDoc
+ f: p9 o- d9 U0 w1 f% H5 l0 jSet SelMgr = Part.SelectionManager
swApp.ActiveDoc.ActiveView.FrameState = 1
'设定变量
c = swApp.ActiveDoc.GetTitle() '零件名
2 g. G1 Z1 A: cstrmat = Chr(34) + Trim("SW-Material" + "@") + c + Chr(34)
# c1 o* ?: L. u, ^3 [, u2 w'tempvalue = Part.CustomInfo2("", "材料")
blnretval = Part.DeleteCustomInfo2("", "代号")
blnretval = Part.DeleteCustomInfo2("", "名称")
blnretval = Part.DeleteCustomInfo2("", "材料")
a = InStr(c, " ") - 1
8 h3 k$ Y7 j) ?3 C' l  AIf a > 0 Then
    k = Left(c, a)
    t = Left(LTrim(e), 3)
    If t = "GBT" Then
        e = "GB/T" + Mid(k, 4)
    Else
        e = k
' U0 L5 K: Y! V+ D; w: C0 D    End If
6 r9 }) |; n. Q( @    b = Mid(c, a + 2)
6 [4 e' b8 [. z1 L    t = Right(c, 7)
    If t = ".SLDPRT" Or t = ".SLDASM" Then
        j = Len(b) - 7
    Else
; C- V5 Q5 G- f* F4 d  a        j = Len(b)
1 L  D, ]0 g- N9 h; m9 `3 g7 _6 {    End If
0 I) _- m3 g7 _$ H( g; e0 D    m = Left(b, j)
End If
blnretval = Part.AddCustomInfo3("", "代号", swCustomInfoText, e)
1 g* H* Q! p; T  Jblnretval = Part.AddCustomInfo3("", "名称", swCustomInfoText, m)
* k, k% q- H7 l( c3 dblnretval = Part.AddCustomInfo3("", "材料", swCustomInfoText, strmat)
blnretval = Part.AddCustomInfo3("", "单重", swCustomInfoText, " ")
blnretval = Part.AddCustomInfo3("", "备注", swCustomInfoText, " ")
! `1 J2 @" K2 {& [
End Sub

) s) L$ D) B/ D$ i

ryouss

arter_2006 发表于 2018-11-26 15:11
& M- [2 P$ b) v3 W; \7 d4 X0 a执行后无反应，属性都没改，不知道问题出在哪里？让您费心了。

( g1 A# d, }# H! i8 n* p0 @' ********************************** ...

sw2017 測試OK
& r" e8 x! {) C  s( a6 u  B+ c' t. b$ s有否顯示什麼錯誤提示?


" }, q; t4 J5 c$ N- c

arter_2006

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

ryouss

arter_2006 发表于 2018-11-26 17:00
- ^! C' k, p6 W7 k我的是Solidworks 2018，看来可能是版本的问题了

2018 沒版本能試
6 q5 I( e, h6 z0 e

arter_2006

ryouss 发表于 2018-11-26 17:05
! E& Q/ `, E) b7 U. {7 f2018 沒版本能試

4 ]) z6 k8 {9 K# `+ e7 M非常感谢您，让您费心了。
+ r9 x2 |) `9 I

arter_2006

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

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

& E- t4 _* u8 ^" A' ******************************************************************************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
  B0 g$ {- f: I9 [' ******************************************************************************
: 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
2 v- H5 |) r* Q& r. q' n( T& a+ M( x. wDim 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
3 J( R9 \8 _3 m& \) d/ \Dim SelMgr As Object
, }% i: V8 C% F: j  t$ 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
& 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
% ^7 T( |4 R9 H% jDim e As String" t" l1 k  K7 K8 U: @# s; `
Dim k As String* ?4 t9 u7 n+ _
Dim t As String
, f1 L: o' T% p% R* ?6 C5 B( @3 D& DDim c As String
& l7 ~- F" n/ O8 p  s3 v& \( Q! K3 d. @4 X+ d/ Q. _. p: yDim j As Integer3 N( z+ v  K2 q* v6 D
Dim strmat As String
7 k/ u! K% U$ f. c/ c% D" F! d7 t6 p- DDim tempvalue As String
& E& r" D5 F  G0 |% Q: b, Y
+ b# R5 t( `' w* {- 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
; t9 W& t6 S) d4 F8 i$ }! a( F8 t0 wCurCFGname = 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
3 J3 y* z3 n+ n7 N) b    Set CusPropMgr = Part.Extension.CustomPropertyManager(CurCFGname(i))
+ d2 w& X/ Q! a$ R+ S( y, H. 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
, l8 Z% p( }: [        For Each Vnamearr2 In Vnamearr
8 n+ W( J4 Y; M  f  @6 k1 ?- 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
7 E$ d+ Q+ Z& n$ 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
% e; G6 r) ]# @' p
" D7 r# [' m2 U5 Z7 k9 B. O: ?'~~~ 刪除自定義屬性 ~~~
( f# [8 ^) E! z! c; k" H* a+ 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" }
Dim swModel2 As SldWorks.ModelDoc2
! f' g# o6 S, e, W4 z+ EDim vCustInfoNameArr2 As Variant7 J* i  U% A! t0 \0 D! h, V
/ {; w8 S& C. ?0 n
- K" x+ X- v- E% b! h6 i* p! ], |9 USet swApp = Application.SldWorks
! S/ a; i- P2 ^8 y) d3 X% s4 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)
, b5 x( N* j2 j; K. ?" 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
* c. B+ O8 R. x* A9 y) W/ j9 |  ?( U5 a+ K'~~~ partitionTM ~~~7 O3 t. l4 R1 [+ ]3 K  G+ M
  ]6 h7 r0 o1 q: lSub partitionTM() 'partitionTM( j# ]! b. Q, G0 M9 E4 f8 B2 J
% l; E) x# ~4 [& t0 {8 [
'link solidworks( C, c- [# N+ 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
7 G& S) V5 d3 Q9 p: g: |6 aswApp.ActiveDoc.ActiveView.FrameState = 1& ?6 I  _. Y+ \4 m7 P" c% W/ h
2 D2 C  H7 L8 c- x; a3 Z+ M) G'設定變量& }. N& d* J$ W) S
' G& r7 P5 w3 S+ |c = 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("", "材料")
' [, P1 I" k, i+ ~1 a& U; y& P! d9 n  V  X0 H+ J1 Yblnretval = Part.DeleteCustomInfo2("", "代號")3 w1 A4 Q. Z1 \, x1 N/ e; R
$ l$ w- M9 K8 }+ @2 h( [5 n9 E% wblnretval = 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
' ]. h+ L9 ^# w0 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
# D& z/ k- f' q0 m( ~- Q    If t = "GBT" Then0 a: k4 H  }1 j) y
8 K4 u1 F$ v! c* K        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
8 |8 Q2 n4 I5 }2 G# Q    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)
3 n. W$ N  e4 w! p& O* p( 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' \
    Else& f9 y# D- W/ Y! i& w- H
1 F' W9 j% {2 d& `) L4 ]5 B# o, c        j = Len(b); J( ?# E, |  ?
    End If8 @/ x5 s, N; \. _& V# V
    m = Left(b, j)
" \1 _# ^9 P& C5 b0 D( L. P: e' A' P) l4 b& \End If( o3 u- a' n" g; c4 t2 s& ]
: L; L( M8 {: g/ D% X& `0 |# h$ {; Hblnretval = Part.AddCustomInfo3("", "代號", swCustomInfoText, e)
9 u; E6 F' D0 {2 B/ G/ I' K: F  K  N' M% L5 C4 Hblnretval = Part.AddCustomInfo3("", "名稱", swCustomInfoText, m)7 a/ m( J8 q$ B) ^& B( M# Q' V
7 m6 k: M+ t/ ^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, " ")
# x# M* s% i' F; i: i2 D6 }7 z- @1 t: i# Q, P, {! f% c" J- {6 u; t
& I9 G1 ^) G# b( d1 f$ b- `5 t0 j* BEnd Sub

ryouss

arter_2006 发表于 2018-11-26 17:27
+ W: `4 w/ R$ N' X6 t1 _能否把您的SWP文件发上来，我刚才用solidworks 2014也试了一下，发现也不行，但是别的宏都可以。
我从网 ...

附swp繁体版   

ryouss

試試把   CurCFGname = swApp.GetConfigurationNames
- L3 r3 {( s) A7 u4 l6 b4 a0 {
+ V- V& Q  P  F改為      CurCFGname = swApp.GetConfigurationNames(swApp.ActiveDoc.GetPathName) '補加零件文件的路徑及名稱
; F6 c1 D- Q. w8 B6 ~3 F
在沒補加 (swApp.ActiveDoc.GetPathName) 時在2012及2015版是會有提示錯誤的(如附图)
另VBA編程在   " '  " 符號后的文字是會跳過不執行的.


* D+ c' e8 s$ v9 B0 d

arter_2006

我试过了，改之前，改之后一个样，而且执行中没有任何错误提示。
1 l- x/ u  X: K) v0 E' ******************************************************************************
- q. K: ?* d: n' C:\Users\admin\AppData\Local\Temp\swx8144\Macro1.swb - macro recorded on 11/22/18 by mqlu
7 }7 \& Q# b5 q- g' ******************************************************************************
Dim swApp As Object
/ U# }) M' Y  r6 b3 x% |' ~Dim Part As Object
. a3 T4 G; L5 F5 L1 U+ K) m) IDim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
, T$ Q& Q. J& j% W; m. V3 L
Dim SelMgr As Object
Dim Feature As Object
Dim a As Integer
8 ]; L/ M9 v, gDim b As String
2 I# c+ ^( W5 M+ E' S" w# t. lDim m As String
- c/ A7 q3 X4 T5 Y6 |1 o* @3 y, i; LDim e As String
9 d* U$ @* S9 Z6 CDim k As String
Dim t As String
# ^+ E* u' n0 J: mDim c As String
* p% t3 g& {! i( ~% h- K2 YDim j As Integer
Dim strmat As String
Dim tempvalue As String

! k1 E# p8 m1 b$ d* v' mSub main() '刪除所有配置属性
Set swApp = Application.SldWorks
% ]& F& f8 ~: R( b; {: BSet Part = swApp.ActiveDoc
, r# w9 K( @  q" D# @0 S$ fCurCFGname = swApp.GetConfigurationNames(swApp.ActiveDoc.GetPathName) '补加零件文件的路径及名称
5 {% e1 k' y5 W: R3 bCurCFGnameCount = Part.GetConfigurationCount
For i = 0 To CurCFGnameCount - 1
: |( k3 j6 X& n3 t0 [    Set CusPropMgr = Part.Extension.CustomPropertyManager(CurCFGname(i))
% q& y: j5 d+ y- p1 O    Vnamearr = CusPropMgr.GetNames
) O) b$ S$ m9 R, ]9 e! E    If Not IsEmpty(Vnamearr) Then
        For Each Vnamearr2 In Vnamearr
. \* `5 r) P- W" v% P            bRet = Part.DeleteCustomInfo2(CurCFGname(i), Vnamearr2)
! _1 X& N- h" [" v) {- f1 v* q        Next
, d) `: V) ]7 L! Q; A    End If
+ v8 g; q+ [' N; o* U/ q8 M! wNext
Call 刪除自定义属性
0 d5 L5 i) ~5 G: ]/ {! sCall partitionTM
7 [# n- W+ z) [+ P
  J) Q( g) D# b" W! |9 pEnd Sub

; q( g/ \. Z; p$ [9 Z1 y5 K5 }- v4 Z'~~~ 刪除自定义属性 ~~~
2 I9 L0 e; s8 YSub 刪除自定义属性()
+ g3 M" a7 L. N'Dim swApp As Object
Dim swModel2 As SldWorks.ModelDoc2
1 F3 s$ R* \" i! _0 s( U: lDim vCustInfoNameArr2 As Variant

/ P9 e3 x. s3 u+ v6 ?- BSet swApp = Application.SldWorks
4 b* }7 M! o: R2 ~Set swModel2 = swApp.ActiveDoc
- b0 ~  z8 i0 G" a, S* N" O" e2 ]vCustInfoNameArr2 = swModel2.GetCustomInfoNames
( _2 K- F6 [/ m4 ?9 j$ z, o  If Not IsEmpty(vCustInfoNameArr2) Then
/ r1 M' D. x( n3 L' L3 Z' `" |     For Each vCustInfoName2 In vCustInfoNameArr2
! ~( P. b3 o: Z8 p) m         bRet = swModel2.DeleteCustomInfo(vCustInfoName2)
      Next
  End If
% E7 Q  r/ `; j: k; P. \End Sub
- D, z4 W% T6 L4 p" R' |+ K. H8 h
( g* S1 C4 I* ^- X! C'~~~ partitionTM ~~~
+ Y0 w9 U+ ]! y5 tSub partitionTM() 'partitionTM
2 [5 q6 ?6 M, B" p# p, y
9 ^8 R- R7 J: F7 |'link solidworks
; S  \" S- g, @3 U3 C7 ^- c* a3 aSet swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
. |9 H- G. M$ T! t6 j' lSet SelMgr = Part.SelectionManager
swApp.ActiveDoc.ActiveView.FrameState = 1
'设定变量
5 }4 H% h0 v$ d7 w% ^! E4 i  ~c = swApp.ActiveDoc.GetTitle() '零件名
, T, Z# q, j( Astrmat = Chr(34) + Trim("SW-Material" + "@") + c + Chr(34)
/ a4 X" P* B8 h7 {; b/ w" a9 c'tempvalue = Part.CustomInfo2("", "材料")
2 n0 d; g1 x3 `3 R# v7 f: w: t) K  jblnretval = Part.DeleteCustomInfo2("", "代号")
% ^2 v6 D2 E4 X# i( G; T- \blnretval = Part.DeleteCustomInfo2("", "名称")
blnretval = Part.DeleteCustomInfo2("", "材料")


a = InStr(c, " ") - 1
5 [* w6 w6 i( i/ G% R- HIf a > 0 Then
( F6 a2 ?0 c' W: t: M    k = Left(c, a)
4 u6 E9 @  B( k/ T    t = Left(LTrim(e), 3)

6 g. b8 ]/ {' e  t: Q" }    If t = "GBT" Then
        e = "GB/T" + Mid(k, 4)
5 H+ X9 b$ r! |, }    Else
        e = k
    End If
" G% {6 m3 k- `# b" G
, o( ]5 Z. I: M3 @, `( E$ O    b = Mid(c, a + 2)
    t = Right(c, 7)
4 x* ]" F7 U1 s) P4 U/ V% F    If t = ".SLDPRT" Or t = ".SLDASM" Then
        j = Len(b) - 7
) t/ e6 X( R# D+ x1 K2 B    Else
        j = Len(b)
% w1 \3 H5 @# r    End If
6 A) j$ L, {- y" q6 N+ z    m = Left(b, j)
End If

' A  P2 _8 `; }* ], _4 O) M! o( f; \blnretval = Part.AddCustomInfo3("", "代号", swCustomInfoText, e)
blnretval = Part.AddCustomInfo3("", "名称", swCustomInfoText, m)
8 n7 T( z/ w7 [8 ]( A" Jblnretval = Part.AddCustomInfo3("", "材料", swCustomInfoText, strmat)
, q1 o5 g9 ]4 n: N0 pblnretval = Part.AddCustomInfo3("", "单重", swCustomInfoText, " ")
blnretval = Part.AddCustomInfo3("", "备注", swCustomInfoText, " ")
* t( _; H& s) ?+ l
End Sub