SOLIDWORKS 宏合并执行的问题

ryouss

就是如下的繁体字改為簡体字就是
/ C8 N9 o5 l8 P) G

1. ' ******************************************************************************
   - p* b* D+ h$ p, @% M/ y" Q( v
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
   & \' I2 ~+ `8 \( B7 ^/ a9 l9 s
7. Dim longstatus As Long, longwarnings As Long
   + `9 n' J4 t& s& I- p2 m
8. 
   % d+ r, [7 {  p! A* L2 x
9. Dim SelMgr As Object
   ' J4 B* t$ I. O$ U% ^$ T
10. Dim Feature As Object
    8 Y# y0 u, b7 d3 N' c& T
11. Dim a As Integer
    / G' M8 j: T: y7 j+ A
12. Dim b As String
    / k$ H1 Z" ]# s$ o4 v
13. Dim m As String
    : T9 g% c: Q2 I  Z
14. Dim e As String
    
15. Dim k As String
    2 X, W5 K0 z. E0 o$ J* Z9 Z
16. Dim t As String
    
17. Dim c As String
    
18. Dim j As Integer
    
19. Dim strmat As String
    5 E* Y4 C8 H/ u+ C
20. Dim tempvalue As String
    ! j% [. t$ r8 a2 m) g
21. 
    
22. Sub main() '刪除所有配置屬性
    # m8 U' O5 E: S1 s
23. Set swApp = Application.SldWorks
    7 k/ g8 w' p; _$ Z  k7 _
24. Set Part = swApp.ActiveDoc
    
25. CurCFGname = Part.GetConfigurationNames
    
26. CurCFGnameCount = Part.GetConfigurationCount
    
27. For i = 0 To CurCFGnameCount - 1
    $ T- u# Z5 X: d( m# X. ]4 c4 b
28.     Set CusPropMgr = Part.Extension.CustomPropertyManager(CurCFGname(i))
    - t3 V9 }3 t5 I4 @. H& h% ]# \6 }
29.     Vnamearr = CusPropMgr.GetNames
    + u% M6 c6 }- Z$ ]0 w1 w7 `
30.     If Not IsEmpty(Vnamearr) Then
    
31.         For Each Vnamearr2 In Vnamearr
    / h- [5 B7 _6 u# E. Z/ G
32.             bRet = Part.DeleteCustomInfo2(CurCFGname(i), Vnamearr2)
    
33.         Next
    
34.     End If
    0 V8 m6 p* Y+ t( R, r3 J8 i" R
35. Next
    
36. Call 刪除自定義屬性
    
37. Call partitionTM
    
38. 
    1 K7 c% C* J, M: n  n4 P
39. End Sub
    % c6 C- A5 D0 A* t+ i* Q6 X
40. 
    
41. '~~~ 刪除自定義屬性 ~~~
    0 p, O. k; g6 z4 g5 K- O
42. Sub 刪除自定義屬性()
    , ^' f3 \) y2 ~8 R6 b3 b( O
43. 'Dim swApp As Object
    8 u. F8 p* {7 M' X; g$ X. ~0 [
44. Dim swModel2 As SldWorks.ModelDoc2
    & `; {. n* h  K$ I$ [
45. Dim vCustInfoNameArr2 As Variant
    3 h$ x  Q( N. m1 ^# t" {( V  T
46. 
    7 ^% e0 g: q1 [
47. Set swApp = Application.SldWorks
    
48. Set swModel2 = swApp.ActiveDoc
    3 [& |3 X. A, |  C2 R1 M9 q
49. vCustInfoNameArr2 = swModel2.GetCustomInfoNames
    
50.   If Not IsEmpty(vCustInfoNameArr2) Then
    4 s6 c+ c5 N/ v
51.      For Each vCustInfoName2 In vCustInfoNameArr2
    
52.          bRet = swModel2.DeleteCustomInfo(vCustInfoName2)
    ' e6 A& d" h3 t: {! ~
53.       Next
    
54.   End If
    3 u; E/ ^+ P' d  h2 Z
55. End Sub
    
56. 
    ; q  e' A. L( P8 F" w6 c
57. '~~~ partitionTM ~~~
    
58. Sub partitionTM() 'partitionTM
    
59. 
    * L2 q0 s0 o' x: B9 y
60. 'link solidworks
    
61. Set swApp = Application.SldWorks
    
62. Set Part = swApp.ActiveDoc
    0 c% G" O/ |2 g# m
63. Set SelMgr = Part.SelectionManager
    
64. swApp.ActiveDoc.ActiveView.FrameState = 1
    
65. '設定變量
    $ j2 F( o6 n( N, w3 h7 b
66. c = swApp.ActiveDoc.GetTitle() '零件名
    
67. strmat = Chr(34) + Trim("SW-Material" + "@") + c + Chr(34)
    
68. 'tempvalue = Part.CustomInfo2("", "材料")
    
69. blnretval = Part.DeleteCustomInfo2("", "代號")
    0 E3 j+ \( z! I! n( ^! S* I
70. blnretval = Part.DeleteCustomInfo2("", "名稱")
    , p: h. |* ^3 K: \, Z$ n
71. blnretval = Part.DeleteCustomInfo2("", "材料")
    
72. a = InStr(c, " ") - 1
    9 }) H! j' q* D& d6 c
73. If a > 0 Then
    4 B( D% f0 J: J  F$ Q0 p5 d
74.     k = Left(c, a)
    
75.     t = Left(LTrim(e), 3)
    % j; m1 \  z  C7 j0 Z$ s3 [
76.     If t = "GBT" Then
    * M* t  X; x5 E; ^  W5 I, y, ~
77.         e = "GB/T" + Mid(k, 4)
    
78.     Else
    
79.         e = k
    
80.     End If
    - P' L! Q2 v. C& h! m
81.     b = Mid(c, a + 2)
    $ L& [( X" [  q, M
82.     t = Right(c, 7)
    , ]  {* S- o5 ~" v3 `3 `- Q2 ]$ Z
83.     If t = ".SLDPRT" Or t = ".SLDASM" Then
    : \, O. g8 z2 D, z+ ?
84.         j = Len(b) - 7
    7 F$ I% H; p& r) K. W9 s+ Z
85.     Else
    
86.         j = Len(b)
    
87.     End If
    + s' R; ]% }1 q3 ^/ ^
88.     m = Left(b, j)
    4 }. ^; w6 c/ R# ~! t
89. End If
    2 b8 l4 H8 w1 j9 r! I, u
90. blnretval = Part.AddCustomInfo3("", "代號", swCustomInfoText, e)
    ' |% c+ g& n! N5 I4 E, @# Z
91. blnretval = Part.AddCustomInfo3("", "名稱", swCustomInfoText, m)
    % z9 \4 \# q3 g+ X
92. blnretval = Part.AddCustomInfo3("", "材料", swCustomInfoText, strmat)
    
93. blnretval = Part.AddCustomInfo3("", "單重", swCustomInfoText, " ")
    
94. blnretval = Part.AddCustomInfo3("", "備註", swCustomInfoText, " ")
    $ C" w6 i5 s7 S5 z# T8 h! X
95. 
    - P; l+ N- n( B* ]3 B4 y2 ~3 B
96. End Sub

复制代码

/ H" n' {- B# R- X

arter_2006

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

' e- A, ~( }+ d执行后无反应，属性都没改，不知道问题出在哪里？让您费心了。

' ******************************************************************************
' C:\Users\admin\AppData\Local\Temp\swx8144\Macro1.swb - macro recorded on 11/22/18 by mqlu
. l8 M. }0 k/ U4 [* f' ******************************************************************************
' D# X' R: p" W/ ?: R! o3 [Dim swApp As Object
8 Z5 N) Y# x7 C  e; B1 L/ TDim Part As Object
Dim boolstatus As Boolean
# y! C2 s! ]0 D/ D) ]' ], pDim longstatus As Long, longwarnings As Long
, o' f4 X: V1 _; O4 _+ L2 g
& G( l! j: j2 iDim SelMgr As Object
Dim Feature As Object
Dim a As Integer
Dim b As String
Dim m As String
/ T* l4 j3 F# C  p$ jDim e As String
3 [; E2 l- A& y% m' @, VDim k As String
Dim t As String
Dim c As String
Dim j As Integer
, a9 @' A6 }5 B0 p( l' QDim strmat As String
Dim tempvalue As String

Sub main() '刪除所有配置属性
Set swApp = Application.SldWorks
) |, o/ h8 D2 l4 V% zSet Part = swApp.ActiveDoc
CurCFGname = Part.GetConfigurationNames
CurCFGnameCount = Part.GetConfigurationCount
For i = 0 To CurCFGnameCount - 1
* w% ^! A# S" z" A" I1 r    Set CusPropMgr = Part.Extension.CustomPropertyManager(CurCFGname(i))
    Vnamearr = CusPropMgr.GetNames
    If Not IsEmpty(Vnamearr) Then
        For Each Vnamearr2 In Vnamearr
  B* z8 t1 l( m7 o0 r! G* r            bRet = Part.DeleteCustomInfo2(CurCFGname(i), Vnamearr2)
# ]( _2 u; ^) I! c& e8 A3 Y3 t        Next
    End If
Next
- N7 [7 i! u/ O/ ], ]5 O6 x7 xCall 刪除自定义属性
3 |& K2 ^/ b2 g3 F4 s- HCall partitionTM
% E" J3 V4 ^& E4 w+ M3 G/ g6 x
End Sub
7 i  J1 a5 n' c) b  \
'~~~ 刪除自定义属性 ~~~
; {% w) v# p5 K3 B3 A( tSub 刪除自定义属性()
'Dim swApp As Object
1 U; O/ K9 m& T9 qDim swModel2 As SldWorks.ModelDoc2
Dim vCustInfoNameArr2 As Variant

' g0 v3 ~6 n3 r, {: jSet swApp = Application.SldWorks
9 a+ p& t8 {- ?) [Set swModel2 = swApp.ActiveDoc
6 @5 [* E* ?; ^& m  E% avCustInfoNameArr2 = swModel2.GetCustomInfoNames
  If Not IsEmpty(vCustInfoNameArr2) Then
     For Each vCustInfoName2 In vCustInfoNameArr2
5 c9 \' e! B  F* }# N; l' r2 ^# v         bRet = swModel2.DeleteCustomInfo(vCustInfoName2)
3 V; T' G: G- X      Next
: {, Q, m7 h+ }  End If
End Sub

: e* }6 F' H7 ]3 K! ~1 w) A'~~~ partitionTM ~~~
2 C9 s: X' X1 a7 s* u4 B$ TSub partitionTM() 'partitionTM

  t0 H. C1 T9 n'link solidworks
Set swApp = Application.SldWorks
8 F  l1 l# x; n0 F1 `4 f2 fSet Part = swApp.ActiveDoc
Set SelMgr = Part.SelectionManager
swApp.ActiveDoc.ActiveView.FrameState = 1
7 U6 T# ^( f, m: P. }7 V! s'设定变量
7 U6 a' `" P- D* h! hc = swApp.ActiveDoc.GetTitle() '零件名
strmat = Chr(34) + Trim("SW-Material" + "@") + c + Chr(34)
'tempvalue = Part.CustomInfo2("", "材料")
  p. V/ n% M6 @  U- _blnretval = Part.DeleteCustomInfo2("", "代号")
8 M7 d  _( j6 }* jblnretval = Part.DeleteCustomInfo2("", "名称")
blnretval = Part.DeleteCustomInfo2("", "材料")
- q6 P1 w7 r6 U: E/ C( sa = InStr(c, " ") - 1
If a > 0 Then
: F( o# `8 I' C1 F9 V8 q    k = Left(c, a)
5 r  b+ r6 s3 S% E, p/ s    t = Left(LTrim(e), 3)
    If t = "GBT" Then
        e = "GB/T" + Mid(k, 4)
" u( T: X0 W1 {) V$ t2 g& s    Else
        e = k
    End If
' K3 Y4 s" A5 L  @* l( w( K    b = Mid(c, a + 2)
) v& G! T0 i! e; J! L- L( ~    t = Right(c, 7)
    If t = ".SLDPRT" Or t = ".SLDASM" Then
$ |6 M; Z& q) B6 A- D0 L        j = Len(b) - 7
* n, a6 p- s6 @$ W    Else
        j = Len(b)
8 u" n/ Y+ i8 _1 {1 {    End If
    m = Left(b, j)
End If
7 Q# B) Y8 f) t/ R0 A# k& m4 B, ~blnretval = Part.AddCustomInfo3("", "代号", swCustomInfoText, e)
blnretval = Part.AddCustomInfo3("", "名称", swCustomInfoText, m)
' m6 f, X; e& a; m& Dblnretval = Part.AddCustomInfo3("", "材料", swCustomInfoText, strmat)
blnretval = Part.AddCustomInfo3("", "单重", swCustomInfoText, " ")
* O) U- H. F, o: q$ @  ]$ T' Kblnretval = Part.AddCustomInfo3("", "备注", swCustomInfoText, " ")

% S' Y: j" C( y4 ~" }1 J; ]End Sub
' ]4 [4 L8 d0 Q; c2 A; A- b* t

ryouss

" V/ J; Q& Q; N9 y1 F( `" E' d1 M( w' ~

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

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

sw2017 測試OK
有否顯示什麼錯誤提示?

9 o- p) c) I1 e* S0 T  u3 T4 i3 L; Y
6 ]; [  i% }3 u+ E+ S/ N  M
2 X, i2 o) k0 q8 Z

arter_2006

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

ryouss

arter_2006 发表于 2018-11-26 17:00
2 ?/ T, @' C/ f我的是Solidworks 2018，看来可能是版本的问题了

2018 沒版本能試

arter_2006

ryouss 发表于 2018-11-26 17:05
( [, I" z2 A6 j  N; ^7 t' n( _2018 沒版本能試

% N' o( Z+ \- v非常感谢您，让您费心了。

arter_2006

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

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

' ******************************************************************************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
' ******************************************************************************
$ ~7 h/ \7 E" a4 O# p( x0 ?$ y: n% \( F) I, C+ j: _& m6 bDim swApp As Object
. U/ |1 h* K# Z9 P- _' e* i- B# F; m% [6 c9 t+ \0 }Dim Part As Object! t9 ?1 q2 c' K2 l9 ^4 X" G
& f' I. d. W1 o. DDim 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
; |7 S5 X7 q3 ~9 f2 U# T3 Z' I" b3 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
" R% ~+ y8 C" \3 z& 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
* M% E4 d/ W! JDim e As String" t" l1 k  K7 K8 U: @# s; `
Dim k As String* ?4 t9 u7 n+ _
0 w5 Q" t8 F; v1 qDim t As String
# o. N/ f" `6 B. |! J% R* ?6 C5 B( @3 D& DDim c As String
7 w& e" B5 w8 |. F! K3 d. @4 X+ d/ Q. _. p: yDim j As Integer3 N( z+ v  K2 q* v6 D
Dim strmat As String
+ X; h  {9 I& w" }: [0 U" 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, G9 X# |, X* g+ q4 R/ Y' n6 x$ P; c8 H3 l/ z* n* R9 KSet swApp = Application.SldWorks9 g. p. p7 K6 u7 ?4 x4 W6 n
5 C- j& x+ @2 WSet Part = swApp.ActiveDoc$ q6 |& ^2 b7 ~/ ]( ^0 R
CurCFGname = Part.GetConfigurationNames
3 ~* V6 ~1 L% E; d2 F6 E- [5 v: x. U8 U( V* kCurCFGnameCount = Part.GetConfigurationCount
8 ]0 C( T# |% K3 j# h" y: [  n" 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 {
    If Not IsEmpty(Vnamearr) Then' t" n; u" h( T
8 `0 t( D; R+ u( u$ L* w8 U' R        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 U& C: L' I, k1 o: [$ o9 Z" e
+ _. k4 k9 p" P" `0 s2 @8 q. ~" b  {% q" `4 h6 {End Sub
0 [$ b5 A9 ^  Q" \+ x' q% e; G6 r) ]# @' p
" D7 r# [' m2 U5 Z7 k9 B. O: ?'~~~ 刪除自定義屬性 ~~~
0 [, a' k! ~2 ^* v: Q6 `! G2 u. ]" |4 i. ?Sub 刪除自定義屬性()
7 V+ V" [9 \8 B/ Z; q& {+ u" ?  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

- 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 {
. ^) U3 R* t" k9 B1 v1 v# jvCustInfoNameArr2 = swModel2.GetCustomInfoNames- N/ C9 m0 n2 t* k9 u
7 P! [! Q6 c5 ~  If Not IsEmpty(vCustInfoNameArr2) Then
* v$ z4 W' G9 }* d! V# Z5 s; g8 P9 J( v  m% Z     For Each vCustInfoName2 In vCustInfoNameArr2- \% O7 w% [: r; T3 |5 M
% A! T  Y9 A- i% h+ M  Y' V         bRet = swModel2.DeleteCustomInfo(vCustInfoName2)
0 S0 f) c7 n- G2 [8 D. ?" R/ r# I! y' x7 _' X      Next9 U+ R% V2 G# P
0 c* Q* {& K9 X) o" ]* ?4 H  End If
& V, L( M& Q4 l& b0 TEnd Sub
" J5 `0 \8 I+ }2 s6 M- K7 `: z' w) T+ c$ V; G
! D9 Y0 u4 f( C$ R/ 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
/ s$ O- o8 Z/ `4 R) a% 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
swApp.ActiveDoc.ActiveView.FrameState = 1& ?6 I  _. Y+ \4 m7 P" c% W/ h
' P# V1 U8 D. k8 s: K3 i0 s'設定變量& }. N& d* J$ W) S
c = swApp.ActiveDoc.GetTitle() '零件名
% ]9 x- G# Q- `5 Z, S/ t( R. {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("", "材料")
% P% s& \- S  z: O5 a7 B& 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
; }+ _& d1 u$ _7 \& K# e' {$ ^) v/ `blnretval = Part.DeleteCustomInfo2("", "材料")
+ U) d- F; R- ]4 V0 e- k2 J; Sa = InStr(c, " ") - 1
$ U4 M% `* L4 V/ G" v0 S% D. r) K$ `' iIf a > 0 Then
/ Q# j# e- B# F9 E3 Q. i# D0 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
    Else
: C2 h; L  [6 m" W' H! W2 i7 C- b( f1 H* X4 B; P        e = k& O7 M7 ]$ E: v$ n5 ]  ?0 p$ z
: \  y9 ]) `0 T! w    End If! C- h9 R! k; n% D6 G+ S; P
! ^2 M7 s; ]0 \    b = Mid(c, a + 2)
1 a, _" o% b/ ^0 j8 S  T    t = Right(c, 7)
+ }8 U; H' q0 W2 m* p6 o; w( 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' \
3 T& B6 W2 N- c: r% g- ]/ U! j5 I    Else& f9 y# D- W/ Y! i& w- H
" W) V2 M! u: H        j = Len(b); J( ?# E, |  ?
) p8 n# j2 b0 P1 ^" `    End If8 @/ x5 s, N; \. _& V# V
    m = Left(b, j)
1 J/ T) h" @1 b. P: e' A' P) l4 b& \End If( o3 u- a' n" g; c4 t2 s& ]
, H# H( H& B0 S; S1 J1 ublnretval = Part.AddCustomInfo3("", "代號", swCustomInfoText, e)
1 J6 t( E7 F; \: 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)
! H# f4 P# y& i2 j$ m* c& g& R1 k9 Z0 O2 e0 Q6 cblnretval = Part.AddCustomInfo3("", "單重", swCustomInfoText, " ")
  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

ryouss

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

附swp繁体版   
$ y8 q, V& v9 N

ryouss

6 i. d. U) F. T
& W* ]7 W1 n2 v4 ]+ r試試把   CurCFGname = swApp.GetConfigurationNames

改為      CurCFGname = swApp.GetConfigurationNames(swApp.ActiveDoc.GetPathName) '補加零件文件的路徑及名稱

在沒補加 (swApp.ActiveDoc.GetPathName) 時在2012及2015版是會有提示錯誤的(如附图)
另VBA編程在   " '  " 符號后的文字是會跳過不執行的.
# E7 k# {1 p! g8 P( f0 L
) v9 n1 k2 F* R( s6 `/ v

8 m; J8 B5 `! W$ ]

arter_2006

我试过了，改之前，改之后一个样，而且执行中没有任何错误提示。
' ******************************************************************************
* }% _, c! q; R( x: |7 s' C:\Users\admin\AppData\Local\Temp\swx8144\Macro1.swb - macro recorded on 11/22/18 by mqlu
' ******************************************************************************
Dim swApp As Object
" W8 I1 b( A  i' dDim Part As Object
7 Q8 U) z* H% W2 t" R+ mDim boolstatus As Boolean
. \6 n& p( U( x/ }' J( j0 rDim longstatus As Long, longwarnings As Long

% L+ \* \7 o" H3 n8 G# a: q3 @; ^Dim SelMgr As Object
- H+ e% O; r3 g' _% n% I1 |+ BDim Feature As Object
$ @, |4 Z1 ?# M. T. ]- x7 i2 H9 `Dim a As Integer
' g0 X& u4 z$ ~5 r) A) QDim b As String
) P& a: o  P$ ?# ?; X, ]; cDim m As String
7 n- @) _# u$ Z9 t6 |: WDim e As String
Dim k As String
7 H7 X' x* m) D% P' W8 CDim t As String
% I  e) ?  y; O. ~Dim c As String
( a4 E( i3 D9 b# [6 i7 oDim j As Integer
1 P7 \) t! w! p% @/ w+ dDim strmat As String
& {6 S- u" v6 w$ \4 K& gDim tempvalue As String

Sub main() '刪除所有配置属性
# A* \# v& t0 DSet swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
CurCFGname = swApp.GetConfigurationNames(swApp.ActiveDoc.GetPathName) '补加零件文件的路径及名称
8 b* @& R5 O" k6 ]4 }1 I: bCurCFGnameCount = Part.GetConfigurationCount
For i = 0 To CurCFGnameCount - 1
4 S+ o( @4 c, N4 Z/ |    Set CusPropMgr = Part.Extension.CustomPropertyManager(CurCFGname(i))
    Vnamearr = CusPropMgr.GetNames
    If Not IsEmpty(Vnamearr) Then
, ?* C- t& e5 }/ V. o6 E        For Each Vnamearr2 In Vnamearr
            bRet = Part.DeleteCustomInfo2(CurCFGname(i), Vnamearr2)
        Next
    End If
" z, q& D& S  B! ZNext
- Y$ F- d# o. V; N" Y; j8 cCall 刪除自定义属性
Call partitionTM

+ k3 o7 f" z% L7 dEnd Sub
9 W# @* s' I7 k1 P
'~~~ 刪除自定义属性 ~~~
4 N5 t& K( ?4 t  u# r& g7 ~: T( b/ qSub 刪除自定义属性()
'Dim swApp As Object
Dim swModel2 As SldWorks.ModelDoc2
Dim vCustInfoNameArr2 As Variant

" l  T$ ~% ~3 q1 u- ^: C5 ^+ tSet swApp = Application.SldWorks
0 B3 k7 o* n- P9 ZSet swModel2 = swApp.ActiveDoc
vCustInfoNameArr2 = swModel2.GetCustomInfoNames
' ?% B# p1 R& l4 Y1 m. p7 t  If Not IsEmpty(vCustInfoNameArr2) Then
     For Each vCustInfoName2 In vCustInfoNameArr2
         bRet = swModel2.DeleteCustomInfo(vCustInfoName2)
      Next
  End If
End Sub
7 B! l1 `- D: O4 O/ U$ K
" v* W) a  a" P, V'~~~ partitionTM ~~~
! a0 A) h% N; o0 x7 Y' e/ C, t- @- aSub partitionTM() 'partitionTM

$ R, O/ D5 A2 i5 ^% s'link solidworks
  J: ~  y5 Z1 j+ \5 e8 O& f+ DSet swApp = Application.SldWorks
* }; X* T  \7 v- ~Set Part = swApp.ActiveDoc
( r  A8 Y$ j+ r% G  }Set SelMgr = Part.SelectionManager
; d9 c% d2 `& K5 k2 N/ E% r3 e" ~/ MswApp.ActiveDoc.ActiveView.FrameState = 1
'设定变量
c = swApp.ActiveDoc.GetTitle() '零件名
strmat = Chr(34) + Trim("SW-Material" + "@") + c + Chr(34)
9 E) u  q2 {/ s+ t- Z0 y'tempvalue = Part.CustomInfo2("", "材料")
blnretval = Part.DeleteCustomInfo2("", "代号")
9 D/ H, c) e# @3 U# kblnretval = Part.DeleteCustomInfo2("", "名称")
blnretval = Part.DeleteCustomInfo2("", "材料")
5 ~% Y% ~  f. o" o  F1 U2 t

a = InStr(c, " ") - 1
2 {! ~- ~, ?& c0 B8 @& HIf a > 0 Then
- F2 |* V3 o* R* R, Q! i    k = Left(c, a)
    t = Left(LTrim(e), 3)
  u/ E2 r2 |; g; o7 E9 p" {
$ ^" O3 O% J! Y+ O    If t = "GBT" Then
7 A" V# t" b4 P        e = "GB/T" + Mid(k, 4)
0 I' V  x, }+ Q5 [    Else
        e = k
  i/ B* D! u4 D; A7 S    End If

3 k3 H, Q3 C$ m8 `& Q+ j    b = Mid(c, a + 2)
    t = Right(c, 7)
/ P' ^, `) Z4 q1 r6 t9 i4 D    If t = ".SLDPRT" Or t = ".SLDASM" Then
        j = Len(b) - 7
; ]% Q" F: O/ G9 i    Else
3 g" B* I$ R+ a% p' N5 r        j = Len(b)
0 k: o9 C  P: k    End If
    m = Left(b, j)
End If

blnretval = Part.AddCustomInfo3("", "代号", swCustomInfoText, e)
blnretval = Part.AddCustomInfo3("", "名称", swCustomInfoText, m)
blnretval = Part.AddCustomInfo3("", "材料", swCustomInfoText, strmat)
( D3 R; W2 Y* V# H' Z8 Z8 H( lblnretval = Part.AddCustomInfo3("", "单重", swCustomInfoText, " ")
blnretval = Part.AddCustomInfo3("", "备注", swCustomInfoText, " ")

End Sub