SOLIDWORKS 宏合并执行的问题

ryouss

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

' R# R- O/ r3 O1 b8 O6 l7 n$ W2 V+ J4 ^" }
5 W" s3 S2 e. |! B* j/ y0 H/ D9 ?6 o

1. ' ******************************************************************************
   0 n& M7 }9 U& z& ], T$ z$ [
2. ' C:\Users\admin\AppData\Local\Temp\swx8144\Macro1.swb - macro recorded on 11/22/18 by mqlu
   * k  U8 q7 Q+ I
3. ' ******************************************************************************
   , ~' k8 T# f- }  P' M! }* W
4. Dim swApp As Object
   
5. Dim Part As Object
   & S/ z1 B$ m! N8 Y7 q
6. Dim boolstatus As Boolean
   
7. Dim longstatus As Long, longwarnings As Long
   
8. 
   6 s1 _2 y) K" I% y+ F/ `
9. Dim SelMgr As Object
   
10. Dim Feature As Object
    
11. Dim a As Integer
    $ E1 I2 m" h; P) T# r; P
12. Dim b As String
    
13. Dim m As String
    
14. Dim e As String
    
15. Dim k As String
    9 s. i" g9 I2 o5 Z2 V% N' v" c
16. Dim t As String
    
17. Dim c As String
    
18. Dim j As Integer
    3 B. L0 h. p$ [, C  Y% C; R+ i
19. Dim strmat As String
    ! H* O- Y& f. q) {' }. G- I; z
20. Dim tempvalue As String
    / C' d+ b1 z# E8 m* ?
21. 
    
22. Sub main() '刪除所有配置屬性
    
23. Set swApp = Application.SldWorks
    
24. Set Part = swApp.ActiveDoc
    4 Q2 t, D9 ]+ ?, F) U0 p6 h' s
25. CurCFGname = Part.GetConfigurationNames
    ; {2 r9 m) S3 g9 l- v4 B" F" m
26. CurCFGnameCount = Part.GetConfigurationCount
    
27. For i = 0 To CurCFGnameCount - 1
    
28.     Set CusPropMgr = Part.Extension.CustomPropertyManager(CurCFGname(i))
    , Z% N; R, \% }& X0 @7 u
29.     Vnamearr = CusPropMgr.GetNames
    
30.     If Not IsEmpty(Vnamearr) Then
    
31.         For Each Vnamearr2 In Vnamearr
    
32.             bRet = Part.DeleteCustomInfo2(CurCFGname(i), Vnamearr2)
    . X3 m4 q: a, b# j% L3 W
33.         Next
    % l3 M, f/ c0 r9 E& b# I
34.     End If
    
35. Next
    
36. Call 刪除自定義屬性
    
37. Call partitionTM
    3 v4 g# q; z, B: m2 n% m7 I5 \* N+ E
38. 
    # h2 [$ ]. ?3 [. p- W: E, z
39. End Sub
    
40. 
    & H2 p# |, ?3 R* m  q& k' G& B
41. '~~~ 刪除自定義屬性 ~~~
    . X- ?* d& i. u$ w( N1 a( z
42. Sub 刪除自定義屬性()
    6 s, i/ T; z: P3 l
43. 'Dim swApp As Object
    
44. Dim swModel2 As SldWorks.ModelDoc2
      Y! W/ f6 q0 s" K* C
45. Dim vCustInfoNameArr2 As Variant
    
46. 
    " D0 u) U6 E! e( r
47. Set swApp = Application.SldWorks
    
48. Set swModel2 = swApp.ActiveDoc
    
49. vCustInfoNameArr2 = swModel2.GetCustomInfoNames
    
50.   If Not IsEmpty(vCustInfoNameArr2) Then
    . Y. ]! ]2 I9 F& `, ^% v& K
51.      For Each vCustInfoName2 In vCustInfoNameArr2
    * u* r. Q( v* b0 m; F8 m' V  s- D% d
52.          bRet = swModel2.DeleteCustomInfo(vCustInfoName2)
    
53.       Next
    
54.   End If
    7 t( X* o7 P2 m: e! D* }; ^, V  [( G
55. End Sub
    3 w4 h8 i+ p$ A& ~
56. 
    
57. '~~~ partitionTM ~~~
    7 D) e4 q/ i' |9 ?) d
58. Sub partitionTM() 'partitionTM
    ( O+ M, P# B9 b' C6 @! G6 }
59. 
    0 M: M  R0 c: o& g; q
60. 'link solidworks
    
61. Set swApp = Application.SldWorks
    0 y8 y0 J' X9 I* s3 K* G
62. Set Part = swApp.ActiveDoc
    
63. Set SelMgr = Part.SelectionManager
    
64. swApp.ActiveDoc.ActiveView.FrameState = 1
    
65. '設定變量
    
66. c = swApp.ActiveDoc.GetTitle() '零件名
    & Q& K) Y7 b5 N" P6 t
67. strmat = Chr(34) + Trim("SW-Material" + "@") + c + Chr(34)
    / @1 y# t7 G" C7 T
68. 'tempvalue = Part.CustomInfo2("", "材料")
    
69. blnretval = Part.DeleteCustomInfo2("", "代號")
    
70. blnretval = Part.DeleteCustomInfo2("", "名稱")
    
71. blnretval = Part.DeleteCustomInfo2("", "材料")
    9 O/ I/ d4 [% x
72. a = InStr(c, " ") - 1
    ; A1 }$ {9 O; O' i0 p$ H
73. If a > 0 Then
    
74.     k = Left(c, a)
    
75.     t = Left(LTrim(e), 3)
    ( F0 A% T0 {& K4 w+ g) A0 y
76.     If t = "GBT" Then
    
77.         e = "GB/T" + Mid(k, 4)
    
78.     Else
    , i! m' q5 S6 P, @. F
79.         e = k
    ! B# Y: Q0 c8 z) l$ T% H
80.     End If
    
81.     b = Mid(c, a + 2)
    
82.     t = Right(c, 7)
    " G+ h& H0 \( u% V8 r
83.     If t = ".SLDPRT" Or t = ".SLDASM" Then
    * `. y( C+ G4 P. J2 ^1 j
84.         j = Len(b) - 7
    1 C# t' H. a( K; X8 h4 y0 i
85.     Else
    $ a0 S  @8 q+ n( f5 [9 K
86.         j = Len(b)
    ' L! d# b( U/ d; I
87.     End If
    + R2 k6 a- n7 f' p  d) L* N
88.     m = Left(b, j)
    
89. End If
    
90. blnretval = Part.AddCustomInfo3("", "代號", swCustomInfoText, e)
    7 W3 Q3 }6 D' t: T
91. blnretval = Part.AddCustomInfo3("", "名稱", swCustomInfoText, m)
    
92. blnretval = Part.AddCustomInfo3("", "材料", swCustomInfoText, strmat)
    
93. blnretval = Part.AddCustomInfo3("", "單重", swCustomInfoText, " ")
    
94. blnretval = Part.AddCustomInfo3("", "備註", swCustomInfoText, " ")
    
95. 
    2 o+ t5 K. z; [3 q% ]
96. End Sub

复制代码

* a) F0 W; b% Y

arter_2006

ryouss 发表于 2018-11-25 11:32
9 i9 R1 p8 d6 `5 L. y) J就是如下的繁体字改為簡体字就是

执行后无反应，属性都没改，不知道问题出在哪里？让您费心了。
1 R4 ]# f/ P' }: w. O9 Y
' ******************************************************************************
' C:\Users\admin\AppData\Local\Temp\swx8144\Macro1.swb - macro recorded on 11/22/18 by mqlu
# b3 U$ R4 |) i3 s1 f& C5 N0 l" X' ******************************************************************************
Dim swApp As Object
Dim Part As Object
  r  N; f; n9 z" W- jDim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
4 `) ?8 E, f* K5 W; M; m1 A
' I( S, @1 d1 d! m7 o2 i# wDim SelMgr As Object
$ t+ w3 F. m+ j7 P# n1 JDim Feature As Object
, M3 W& G9 a+ G/ @# m: @' GDim a As Integer
Dim b As String
Dim m As String
Dim e As String
- ?( p/ K; |8 I. @8 xDim k As String
4 l6 f1 y2 o. q/ H0 ~Dim t As String
7 l0 q# j) w# k4 \) ]- Z) vDim c As String
Dim j As Integer
Dim strmat As String
Dim tempvalue As String
/ B* E# O* H7 T6 ~* R5 |" B2 c
Sub main() '刪除所有配置属性
" N) n' v/ W, x2 y, PSet swApp = Application.SldWorks
6 E9 r1 _; S' g+ x$ BSet Part = swApp.ActiveDoc
1 k7 ~8 `1 `, G/ e7 L9 @CurCFGname = Part.GetConfigurationNames
CurCFGnameCount = Part.GetConfigurationCount
5 Y6 \8 z6 h0 P; ?" D" p  g# nFor i = 0 To CurCFGnameCount - 1
, B- B' x1 \' u# `    Set CusPropMgr = Part.Extension.CustomPropertyManager(CurCFGname(i))
    Vnamearr = CusPropMgr.GetNames
8 D* h0 a7 G( k: ~    If Not IsEmpty(Vnamearr) Then
        For Each Vnamearr2 In Vnamearr
            bRet = Part.DeleteCustomInfo2(CurCFGname(i), Vnamearr2)
) R0 s! P7 y  ?' V- R( x* L8 D# \        Next
    End If
# h' Q" z( y  M# [Next
Call 刪除自定义属性
Call partitionTM
. j1 T/ Y( R" `# u' ~- N7 I' r
; W) F6 ]/ D+ [7 \2 h# A3 k- w* n4 XEnd Sub
) k) f8 v: u5 Q8 r) z
6 k  M  C" ?- Q! N( \'~~~ 刪除自定义属性 ~~~
Sub 刪除自定义属性()
7 n. ^# X$ @7 n/ `& d5 A'Dim swApp As Object
; Z' m) s$ w) v0 L$ ?# tDim swModel2 As SldWorks.ModelDoc2
1 Z% h7 g, t9 |! ~! ?% \Dim vCustInfoNameArr2 As Variant
. W" O" d6 [8 W; K- L7 \
Set swApp = Application.SldWorks
- z6 L& P4 Q6 p2 {) `/ xSet swModel2 = swApp.ActiveDoc
7 f6 q" u* `8 k' {9 }+ S# w7 R' e$ v  ivCustInfoNameArr2 = swModel2.GetCustomInfoNames
  If Not IsEmpty(vCustInfoNameArr2) Then
     For Each vCustInfoName2 In vCustInfoNameArr2
         bRet = swModel2.DeleteCustomInfo(vCustInfoName2)
      Next
5 a, ]2 a8 T" m, n" y$ z5 F  End If
End Sub

'~~~ partitionTM ~~~
Sub partitionTM() 'partitionTM
/ k' T6 |! o7 |; R% o4 U
2 P- b4 A& K7 M5 \4 e  ^7 v'link solidworks
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
! H  P" u0 f1 H  W( ZSet SelMgr = Part.SelectionManager
swApp.ActiveDoc.ActiveView.FrameState = 1
'设定变量
c = swApp.ActiveDoc.GetTitle() '零件名
strmat = Chr(34) + Trim("SW-Material" + "@") + c + Chr(34)
4 d7 u% `" e/ m/ [/ Y  Z  j% T'tempvalue = Part.CustomInfo2("", "材料")
  _: m. Z: r1 i# W$ R- l0 v. Mblnretval = Part.DeleteCustomInfo2("", "代号")
blnretval = Part.DeleteCustomInfo2("", "名称")
blnretval = Part.DeleteCustomInfo2("", "材料")
& j' G& v& e1 Q; e, x( v6 \a = InStr(c, " ") - 1
4 U& J. `2 k7 f4 W$ yIf a > 0 Then
* H0 O+ H) f- M9 k, }    k = Left(c, a)
5 y' @, z9 y  {$ r    t = Left(LTrim(e), 3)
: W7 N$ O. b/ h& w' r    If t = "GBT" Then
        e = "GB/T" + Mid(k, 4)
: Y( Z. R( v* m- U( k    Else
        e = k
9 d( v$ d: g( A    End If
    b = Mid(c, a + 2)
: i" C( A) E. @2 p* H/ a    t = Right(c, 7)
    If t = ".SLDPRT" Or t = ".SLDASM" Then
% I  u  x! u% y* O* x4 U2 q        j = Len(b) - 7
    Else
. F2 \) C, W6 k/ `% ^- T- ]        j = Len(b)
    End If
    m = Left(b, j)
End If
blnretval = Part.AddCustomInfo3("", "代号", swCustomInfoText, e)
& s$ v1 Y! y1 o. I* z6 u8 bblnretval = Part.AddCustomInfo3("", "名称", swCustomInfoText, m)
blnretval = Part.AddCustomInfo3("", "材料", swCustomInfoText, strmat)
& _5 ?5 c1 u; t* i! P% s, Ublnretval = Part.AddCustomInfo3("", "单重", swCustomInfoText, " ")
+ r( r( |- }( ~7 H, Iblnretval = Part.AddCustomInfo3("", "备注", swCustomInfoText, " ")
2 a( ~7 ~2 p& E
End Sub

ryouss

8 W, F( n( {. O

arter_2006 发表于 2018-11-26 15:11
/ @4 k9 F3 [, }- z执行后无反应，属性都没改，不知道问题出在哪里？让您费心了。

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

# @3 l5 L# |! f3 b: |) Dsw2017 測試OK
7 J$ }! [  |" o3 \5 K有否顯示什麼錯誤提示?

. c: f# D$ H3 H
5 j: H& W6 Q) B, T1 Z
4 K1 g4 a# S. Y$ B
6 L9 ?6 v0 F2 ~9 n

arter_2006

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

ryouss

arter_2006 发表于 2018-11-26 17:00
/ u  x5 D% _) O0 H我的是Solidworks 2018，看来可能是版本的问题了

) T# P0 K0 x' V! ~2018 沒版本能試
, v2 @: Y9 \; o: P$ E3 i

arter_2006

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

7 Y7 k! g5 Y2 M9 R2 C6 m非常感谢您，让您费心了。
% i4 J, @3 j# p3 ~7 v" w, F' J0 b

arter_2006

ryouss 发表于 2018-11-26 17:05
: ]; M& C3 c/ b2 A/ `. a4 k2018 沒版本能試

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

$ P4 Q* n) W* Q' ******************************************************************************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
' 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 _
! `0 v' k( V! u: rDim 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
: 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
' [2 V+ J% n! d* A# m& 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
' C9 j0 d, w  M5 i6 w" `Dim m As String+ ?/ w( `) D: S9 x
+ o" R: Y- V% w+ i* LDim e As String" t" l1 k  K7 K8 U: @# s; `
- s' ?- C0 @8 L' U# i9 T* [Dim k As String* ?4 t9 u7 n+ _
3 t4 e& C7 T+ G6 E4 [Dim t As String
% R* ?6 C5 B( @3 D& DDim c As String
! a, ~9 A* w/ ]/ E( _! K3 d. @4 X+ d/ Q. _. p: yDim j As Integer3 N( z+ v  K2 q* v6 D
4 U% |1 n7 C0 y9 G8 E5 N8 w0 [: LDim strmat As String
: p% L$ y$ P( ?3 m" 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() '刪除所有配置屬性
' j  r% @$ P' I; c8 H3 l/ z* n* R9 KSet swApp = Application.SldWorks9 g. p. p7 K6 u7 ?4 x4 W6 n
  c3 F* G; f0 g9 CSet Part = swApp.ActiveDoc$ q6 |& ^2 b7 ~/ ]( ^0 R
CurCFGname = 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
& d1 ?2 {% S, @& H0 H    Set CusPropMgr = Part.Extension.CustomPropertyManager(CurCFGname(i))
8 ~  q$ V* n. w. 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
! @" f3 G, Z6 V/ ], s* M$ I: z        For Each Vnamearr2 In Vnamearr
" n4 ^$ |9 n- l' N' E9 x# B& f- n8 t& |, B: B/ V9 S4 d, F7 Z            bRet = Part.DeleteCustomInfo2(CurCFGname(i), Vnamearr2)+ h. {$ P6 Q5 M: i
2 _8 w$ A- f$ e8 T        Next- P& E; Z$ s7 V+ a( t' E% T
    End If
$ A3 @6 S" n' d2 eNext
- ^+ |6 t: r, J" w- V2 i; N* U  k" k4 f; K$ vCall 刪除自定義屬性
+ n! z; X' \9 M& N" O8 o) X% J8 T( A- x) f" C" d8 G6 }) {# {' iCall partitionTM4 }2 o$ e' E7 t
6 k/ Q; W$ [! r+ v& W% n* P
+ a' b6 Q' S( O2 z% t$ D) u2 @8 q. ~" b  {% q" `4 h6 {End Sub
% e; G6 r) ]# @' p
" D7 r# [' m2 U5 Z7 k9 B. O: ?'~~~ 刪除自定義屬性 ~~~
6 Z4 T+ Q1 m+ e: i- B/ W, c: Q6 `! G2 u. ]" |4 i. ?Sub 刪除自定義屬性()
( [( B( s) ]* |; c  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
2 r& z! o5 w5 f. M) ]
- K" x+ X- v- E% b! h6 i* p! ], |9 USet swApp = Application.SldWorks
! {; a' c8 U, v9 w% P4 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
3 W; E5 S, w3 u2 O7 `5 S& l9 M1 W! V# Z5 s; g8 P9 J( v  m% Z     For Each vCustInfoName2 In vCustInfoNameArr2- \% O7 w% [: r; T3 |5 M
         bRet = swModel2.DeleteCustomInfo(vCustInfoName2)
. ?" R/ r# I! y' x7 _' X      Next9 U+ R% V2 G# P
  End If
% d9 i0 p3 w) r2 k* b$ o/ @# b& V, L( M& Q4 l& b0 TEnd Sub
+ |) V. J  X0 E) V: U) ]- O6 M- K7 `: z' w) T+ c$ V; G
4 C! Q  U: F& [, t. l% f1 B/ 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
0 G' Z/ v$ l" C) ~0 K% C% l; E) x# ~4 [& t0 {8 [
'link solidworks( C, c- [# N+ Z* [
8 W* n  O. [; r% n  q! `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
swApp.ActiveDoc.ActiveView.FrameState = 1& ?6 I  _. Y+ \4 m7 P" c% W/ h
'設定變量& }. N& d* J$ W) S
c = swApp.ActiveDoc.GetTitle() '零件名
# l4 H* ^9 C+ V9 f4 a7 R) Z. {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("", "材料")
3 S% T; `# Q3 q8 H& s& U; y& P! d9 n  V  X0 H+ J1 Yblnretval = Part.DeleteCustomInfo2("", "代號")3 w1 A4 Q. Z1 \, x1 N/ e; R
6 \4 {  `3 I. J( h4 J9 Kblnretval = Part.DeleteCustomInfo2("", "名稱"). }" r" K0 E! E
blnretval = Part.DeleteCustomInfo2("", "材料")
+ U) d- F; R- ]4 V0 e- k2 J; Sa = InStr(c, " ") - 1
' e! f+ e# F, S7 ~& C" 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
    t = Left(LTrim(e), 3)0 |: d+ H% K1 I5 d; ^& r
  v; ]/ M1 T3 P, _6 _" y3 c  {    If t = "GBT" Then0 a: k4 H  }1 j) y
5 c/ i5 H$ S. Z- {9 F        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
    End If! C- h9 R! k; n% D6 G+ S; P
    b = Mid(c, a + 2)
+ b  b8 ~. K$ {. L  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
( m# n+ r. ]5 p& Q/ I! e        j = Len(b) - 7: f; _- _+ L% W8 E) q2 `; Z9 B' \
, K, ?- P" }2 Q7 P    Else& f9 y# D- W/ Y! i& w- H
        j = Len(b); J( ?# E, |  ?
4 Y+ c  ~5 w' V; Q+ F6 Z    End If8 @/ x5 s, N; \. _& V# V
& ]  Z# Q9 n8 T& w    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)
: F  K  N' M% L5 C4 Hblnretval = Part.AddCustomInfo3("", "名稱", swCustomInfoText, m)7 a/ m( J8 q$ B) ^& B( M# Q' V
  G* e% `' j* }" _* G% M% L$ yblnretval = Part.AddCustomInfo3("", "材料", swCustomInfoText, strmat)
! l( t; E/ E5 X- G9 Z0 O2 e0 Q6 cblnretval = Part.AddCustomInfo3("", "單重", swCustomInfoText, " ")
  V; G2 e# V. L; H; {2 wblnretval = Part.AddCustomInfo3("", "備註", swCustomInfoText, " ")
2 x* i8 X+ K; t! Y: i2 D6 }7 z- @1 t: i# Q, P, {! f% c" J- {6 u; t
* E8 F/ f" M) F- R  Y7 m2 uEnd Sub
* H1 r! K) W( j. Z  X. {+ G7 ^

ryouss

arter_2006 发表于 2018-11-26 17:27
能否把您的SWP文件发上来，我刚才用solidworks 2014也试了一下，发现也不行，但是别的宏都可以。
6 f% V  n" q! N8 V! n我从网 ...

( `0 Z$ Z4 y2 Y) X7 z+ @, _附swp繁体版   
% r6 C# i2 m7 i4 W; Q. }

ryouss

  k/ K' G+ i$ m
9 Y% |$ m0 e* Q1 ^, c8 c0 `試試把   CurCFGname = swApp.GetConfigurationNames
0 i* q3 l3 E/ @6 e+ ^
' g1 u- U0 W2 |9 l9 G3 n: ]& u/ G改為      CurCFGname = swApp.GetConfigurationNames(swApp.ActiveDoc.GetPathName) '補加零件文件的路徑及名稱
; ~. [( R2 J2 }/ X1 V! J
在沒補加 (swApp.ActiveDoc.GetPathName) 時在2012及2015版是會有提示錯誤的(如附图)
& \% \6 `7 \: a4 o# \+ u9 Z; L另VBA編程在   " '  " 符號后的文字是會跳過不執行的.
* C' d& F/ y3 E: N  s

arter_2006

我试过了，改之前，改之后一个样，而且执行中没有任何错误提示。
' ******************************************************************************
; {6 D6 E2 ]! j8 V- p8 S' C:\Users\admin\AppData\Local\Temp\swx8144\Macro1.swb - macro recorded on 11/22/18 by mqlu
' ******************************************************************************
( [9 X" ?! O4 u2 }/ _Dim swApp As Object
Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long

Dim SelMgr As Object
Dim Feature As Object
Dim a As Integer
, y7 o% {" Z* T" F! G- m% eDim b As String
& V/ e( P6 P, M" X% H, L% }0 VDim m As String
Dim e As String
Dim k As String
: _: v9 p* E7 a1 JDim t As String
Dim c As String
Dim j As Integer
# U5 U& s* P/ N' eDim strmat As String
Dim tempvalue As String

2 x6 F& p  g9 g% Y, I3 YSub main() '刪除所有配置属性
  Y4 o. N/ _2 G, ]' P" h/ jSet swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
CurCFGname = swApp.GetConfigurationNames(swApp.ActiveDoc.GetPathName) '补加零件文件的路径及名称
2 t" W+ @8 [1 Q$ cCurCFGnameCount = Part.GetConfigurationCount
/ G" u7 M7 i( tFor i = 0 To CurCFGnameCount - 1
+ C& Q4 M  Q- g4 g. \- @    Set CusPropMgr = Part.Extension.CustomPropertyManager(CurCFGname(i))
    Vnamearr = CusPropMgr.GetNames
" \+ Q, T2 s+ d) U9 @. Z6 e( C    If Not IsEmpty(Vnamearr) Then
/ V2 o$ V- O9 f0 v$ i        For Each Vnamearr2 In Vnamearr
            bRet = Part.DeleteCustomInfo2(CurCFGname(i), Vnamearr2)
        Next
4 M4 U5 O8 G* U. _9 W& x4 E    End If
6 X% O; w8 l0 j) N" pNext
Call 刪除自定义属性
% k) h2 C3 W6 D4 Y* @: }; |Call partitionTM
0 t. Q' [5 T( V+ B# n- u$ [
! p$ t; z1 e+ p) r, LEnd Sub
* j9 j6 Y! k( ~# B1 x
'~~~ 刪除自定义属性 ~~~
! `1 {6 v: ?+ B4 j3 q" m) g1 r3 lSub 刪除自定义属性()
'Dim swApp As Object
% Y# N$ H7 `5 c0 v' JDim swModel2 As SldWorks.ModelDoc2
; S- S' w3 A2 x  s" q8 e$ }Dim vCustInfoNameArr2 As Variant
2 L' Q5 [0 z" J3 ?7 I- S/ H
2 D; o, P  g" U! F7 NSet swApp = Application.SldWorks
Set swModel2 = swApp.ActiveDoc
" _, m% N! A4 H% avCustInfoNameArr2 = swModel2.GetCustomInfoNames
2 t0 c, P- Q( I  If Not IsEmpty(vCustInfoNameArr2) Then
     For Each vCustInfoName2 In vCustInfoNameArr2
% W9 I* {  _1 I         bRet = swModel2.DeleteCustomInfo(vCustInfoName2)
      Next
: A4 g6 g4 n. P' X  End If
End Sub
3 m; [: m. ~0 z. U
$ v4 a7 |# Z1 j$ q5 ]'~~~ partitionTM ~~~
Sub partitionTM() 'partitionTM

: v# _& h( C) U/ x  d'link solidworks
+ g# H8 \- v/ F1 KSet swApp = Application.SldWorks
& n) w: T' H: T1 l* h( RSet Part = swApp.ActiveDoc
$ u; d$ ~6 k& Z3 T& ISet SelMgr = Part.SelectionManager
swApp.ActiveDoc.ActiveView.FrameState = 1
'设定变量
c = swApp.ActiveDoc.GetTitle() '零件名
% g* f7 A4 j, Sstrmat = Chr(34) + Trim("SW-Material" + "@") + c + Chr(34)
'tempvalue = Part.CustomInfo2("", "材料")
) q: r1 L; j! x4 |/ Zblnretval = Part.DeleteCustomInfo2("", "代号")
/ R; a5 z& i4 V7 @blnretval = Part.DeleteCustomInfo2("", "名称")
blnretval = Part.DeleteCustomInfo2("", "材料")


a = InStr(c, " ") - 1
If a > 0 Then
  p6 t9 s3 W5 ~7 {8 n    k = Left(c, a)
    t = Left(LTrim(e), 3)
7 z$ T: t, x% T, V6 V
& ^( v. n/ q7 b9 j$ V1 v    If t = "GBT" Then
* O: l" N5 b1 h; u        e = "GB/T" + Mid(k, 4)
& _# Y& p* a/ B+ y" o    Else
        e = k
* W9 d1 g: |( o! z. Q4 {    End If

    b = Mid(c, a + 2)
2 |* m- F& H: ?' T. S; h1 ]. Q8 I0 U! V    t = Right(c, 7)
3 u: ]# P" c5 x- H. }    If t = ".SLDPRT" Or t = ".SLDASM" Then
        j = Len(b) - 7
: {/ v8 {, {0 a/ F    Else
        j = Len(b)
    End If
    m = Left(b, j)
" J2 o& q5 W. _End If

2 M/ F: A9 B: a2 u7 I9 }& e0 Eblnretval = Part.AddCustomInfo3("", "代号", swCustomInfoText, e)
& W; ?  O* r) |7 Ublnretval = Part.AddCustomInfo3("", "名称", swCustomInfoText, m)
blnretval = Part.AddCustomInfo3("", "材料", swCustomInfoText, strmat)
9 E) T2 Z3 r# V4 E% Dblnretval = Part.AddCustomInfo3("", "单重", swCustomInfoText, " ")
blnretval = Part.AddCustomInfo3("", "备注", swCustomInfoText, " ")

End Sub