国产精品乱码一区-性开放网站-少妇又紧又爽视频-西西大胆午夜人体视频-国产极品一区-欧美成人tv-四虎av在线-国产无遮挡无码视频免费软件-中文字幕亚洲乱码熟女一区二区-日产精品一区二区三区在线观看-亚洲国产亚综合在线区-五月婷婷综合色-亚洲日本视频在线观看-97精品人人妻人人-久久久久久一区二区三区四区别墅-www.免费av-波多野结衣绝顶大高潮-日本在线a一区视频高清视频-强美女免费网站在线视频-亚洲永久免费

機械社區

標題: SOLIDWORKS 宏合并執行的問題 [打印本頁]

作者: arter_2006 時間: 2018-11-23 12:41
標題: SOLIDWORKS 宏合并執行的問題

是這樣的，想做一個宏，通過這個宏，會先后調用其它的宏，請問如何編寫？非常感謝。
宏的名稱分別是：
刪除所有配置屬性.swp
刪除自定義屬性.swp
partitionTM.swp

作者: ryouss 時間: 2018-11-23 14:34
參考

Sub 刪除所有配置屬性()
.
.
.
Call 刪除自定義屬性 '呼叫 "刪除自定義屬性" 之宏
.
.
End Sub

Sub 刪除自定義屬性()
.
.
End Sub

作者: arter_2006 時間: 2018-11-24 12:51

ryouss 發表于 2018-11-23 14:345 Q" _3 I) Q; X) A
參考

非常感謝您的指點，根據我的淺薄理解，我的宏如下，但不起作用：
' ******************************************************************************
' C:\Users\admin\AppData\Local\Temp\swx10500\Macro1.swb - macro recorded on 11/24/18 by arter
' ******************************************************************************
Dim swApp As Object

Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Sub 刪除所有配置屬性()

Call 刪除自定義屬性

End Sub

Sub 刪除自定義屬性()

Call partitionTM

End Sub

Sub partitionTM()

End Sub

能否幫我改下？非常感謝。

作者: arter_2006 時間: 2018-11-24 12:53
不知道3個宏有沒有問題，這三個宏單獨執行的是沒問題的。上面提到的，就是想把附件壓縮包里的三個宏聯合執行。

作者: ryouss 時間: 2018-11-24 13:45

arter_2006 發表于 2018-11-24 12:53
/ o# w$ G) [+ c. e: ?$ R- L4 N不知道3個宏有沒有問題，這三個宏單獨執行的是沒問題的。上面提到的，就是想把附件壓縮包里的三個宏聯合執 ...

[attach]469814[/attach] [Run main() 試試!]

' ******************************************************************************
$ i2 o, V# \- t" Y! k+ n; K) S4 D
' C:\Users\admin\AppData\Local\Temp\swx8144\Macro1.swb - macro recorded on 11/22/18 by mqlu
% |' E/ p' o! W( R
' ******************************************************************************% a/ z8 g# _) ^' n; u' F, j
Dim swApp As Object
3 ~' A( b- {6 ]
Dim Part As Object
/ r. F0 Y3 ~$ i1 r; @% R
Dim boolstatus As Boolean
0 {$ w9 P2 Z0 b8 |4 o8 ~% r! X
Dim longstatus As Long, longwarnings As Long4 `# H, _0 n7 B& b. f" J
* O8 c5 F% ?& k. f2 ^+ ~
Dim SelMgr As Object
# n1 M8 L9 H) f# ^7 J* F
Dim Feature As Object. F1 e3 r. h0 \( _% p. e
Dim a As Integer# e: r* ^6 o" s/ b
Dim b As String1 [& f( h: j" R( e9 E; M; J, o8 f
Dim m As String
$ P9 V$ n+ ~* n# ~
Dim e As String
/ \- A" d# x4 o! P2 r4 h
Dim k As String
* c! y$ j9 Z& O
Dim t As String& a9 A6 b3 \8 P3 m3 V5 [9 k
Dim c As String: y. W4 H7 v6 g/ E8 Z) o
Dim j As Integer
, H9 K9 E/ B3 G3 s) ~2 e- t8 t
Dim strmat As String" F+ v2 q" @0 g' e
Dim tempvalue As String
- m/ [& e+ k5 F: o9 c% ^: ]
: B9 a3 b. {8 m( M- y: [
Sub main() '刉壺垀衄饜離扽俶(刪除所有配置屬性)
; F: i6 F; b6 k: l* q( [3 K" z
Set swApp = Application.SldWorks
8 M9 G( E2 y; ~/ M5 M) ]
Set Part = swApp.ActiveDoc3 z3 n1 K6 }3 d5 e/ a8 v
CurCFGname = Part.GetConfigurationNames
5 g3 q8 v( h) u8 f* t
CurCFGnameCount = Part.GetConfigurationCount
% ]7 h4 u3 S! R
For i = 0 To CurCFGnameCount - 14 b$ K& W; Q6 I4 w- J, i
Set CusPropMgr = Part.Extension.CustomPropertyManager(CurCFGname(i))
/ e/ J; @3 f! g, V, m0 r% L
Vnamearr = CusPropMgr.GetNames
/ B7 s/ L6 a4 b, e2 _* I. [# _$ X
If Not IsEmpty(Vnamearr) Then) G: Y N% v% w: `5 Y4 R6 j6 j
For Each Vnamearr2 In Vnamearr/ _" V# d! Q0 F- F3 h
bRet = Part.DeleteCustomInfo2(CurCFGname(i), Vnamearr2)1 w. Y: N8 I# H' c$ u5 I+ T
Next
& |. N, t5 b r6 G
End If* S8 f; v# _" t# r/ y
Next; l: [+ b- c1 x2 }- L! s; _* |
Call 刉壺赻隅砱扽俶 '(刪除自定義屬性)$ c: Z6 v. [. @* j
Call partitionTM
& u/ B$ f, ~; E+ T, v7 Z( X" }
r+ x/ p: n5 I. ?1 C6 `2 @
End Sub! F% ~% R/ y' w$ j4 x
2 S+ `: B( L. r- J, Z
'~~~ 刉壺赻隅砱扽俶 ~~~
, R2 Q* t# J/ _' m$ B$ _) M* Y! t
Sub 刉壺赻隅砱扽俶() '(刪除自定義屬性) I/ w% m: ?$ T5 D3 Q: s
'Dim swApp As Object
. F O6 H& {" N8 E1 Z, ~6 D0 Z* Q
Dim swModel2 As SldWorks.ModelDoc2
( H' u4 m! y2 ~& F
Dim vCustInfoNameArr2 As Variant" M; o. ?; p+ _
1 Q3 [8 X. E( G2 F$ \" q# t
Set swApp = Application.SldWorks
! [) S t4 g% C) @- }
Set swModel2 = swApp.ActiveDoc# V/ z/ a# Z$ h' F" m: b8 q
vCustInfoNameArr2 = swModel2.GetCustomInfoNames
9 ^ G) `' `) I3 ^
If Not IsEmpty(vCustInfoNameArr2) Then8 p' B, ? U! E" |
For Each vCustInfoName2 In vCustInfoNameArr2
9 T: k7 a. r! X
bRet = swModel2.DeleteCustomInfo(vCustInfoName2)5 z9 t" n7 G3 C, A( N) o
Next
]7 H3 [% m: f6 ]0 j! ~- ~
End If$ X& R" R& D# m6 G
End Sub
5 C% r, B& E* \0 Q5 v+ [
" [( f1 @' Z; Y. E( {' z% I/ e
'~~~ partitionTM ~~~8 O, b! o+ [. Q. E
Sub partitionTM() 'partitionTM9 j h4 p+ h8 D; w+ ~
W; ] N# }/ j% } P( V2 V- ?
'link solidworks6 \6 Z" \$ x, }1 p, l+ a1 A2 e
Set swApp = Application.SldWorks% ?0 e* D6 O- g$ u, l1 T0 P
Set Part = swApp.ActiveDoc
# o1 h& f4 O/ T
Set SelMgr = Part.SelectionManager$ x! G n+ q' F( s, m$ `' s# H2 n
swApp.ActiveDoc.ActiveView.FrameState = 19 ~" y5 N+ F5 l6 s) A7 v
'扢隅曹講
4 F% C" V# M" ]1 u/ R, j
c = swApp.ActiveDoc.GetTitle() '錨璃靡% r/ R$ r# C- X% ~
strmat = Chr(34) + Trim("SW-Material" + "@") + c + Chr(34)2 f8 }, }: W8 f
'tempvalue = Part.CustomInfo2("", "第蹋")- Y% D/ Y) _8 G% }) D
blnretval = Part.DeleteCustomInfo2("", "測瘍")7 C0 I+ ?* Z" ]" N) X
blnretval = Part.DeleteCustomInfo2("", "靡備")
# h& {% \/ ]: @' Y j6 m9 _$ }- n2 L
blnretval = Part.DeleteCustomInfo2("", "第蹋")% v& D! h# q6 F$ o0 O' y
a = InStr(c, " ") - 1) v. X) P6 o$ E' w! a" E
If a > 0 Then0 N. r0 D4 }' z2 h V6 Q- z
k = Left(c, a)
8 ~- m+ D8 Z9 @6 u% } ]0 V4 E
t = Left(LTrim(e), 3)
' ^' g. B+ S3 N* u! S* ]
If t = "GBT" Then
1 @( ?4 V. H/ A. d
e = "GB/T" + Mid(k, 4)# Q) z' B, j( G. q* K+ W2 D9 k% K
Else
_! t" q6 I7 n* X
e = k; E: K) P* ~- Y& _
End If1 I6 T1 f, j$ \% M$ Z
b = Mid(c, a + 2)( o! a. X1 d5 g4 n% q% c
t = Right(c, 7)
+ H) G) ]- N/ ^" O
If t = ".SLDPRT" Or t = ".SLDASM" Then
# }6 C. e; ^" f# K: b$ F4 i0 L
j = Len(b) - 7
, E2 @$ m: I/ B6 T0 r# U
Else! n+ S4 R ~( t+ f# z% @4 Q9 A
j = Len(b)( E! ?+ U3 H, f0 l7 P$ P1 o
End If
! g+ [* Z9 R+ n' X
m = Left(b, j); ?: `3 r, V! T. i
End If# [6 {+ n+ B8 J2 ]8 Q/ W
blnretval = Part.AddCustomInfo3("", "測瘍", swCustomInfoText, e)
8 w" ], F; |4 u7 W/ F3 j
blnretval = Part.AddCustomInfo3("", "靡備", swCustomInfoText, m)
% b/ d' c% Q8 V ~3 w) @
blnretval = Part.AddCustomInfo3("", "第蹋", swCustomInfoText, strmat)' T: Z6 {: Y/ Z. f0 f! K- S
blnretval = Part.AddCustomInfo3("", "等笭", swCustomInfoText, " ")
7 `( {. r3 o6 [
blnretval = Part.AddCustomInfo3("", "掘蛁", swCustomInfoText, " ")$ o8 M2 p* y4 `- \
* j( B. N; Z0 ^! F/ M
End Sub
. t0 \0 x2 ^/ o' p, r* Q6 w

復制代碼

作者: arter_2006 時間: 2018-11-24 15:28
本帖最后由 arter_2006 于 2018-11-24 15:30 編輯

ryouss 發表于 2018-11-24 13:45* k( `& S8 ~9 ]) c) x/ n
[Run main() 試試!]

能否把您改后的swp文件上傳上來？
非常感謝您的指點，上面的內容從網頁上復制、黏貼到寫字板或宏文件里后，都是亂碼，執行不了，非常感謝您，讓您費心了。

作者: ryouss 時間: 2018-11-24 16:13

arter_2006 發表于 2018-11-24 15:280 G+ h9 {4 r/ P9 R! J
能否把您改后的swp文件上傳上來？' k/ ~) a% u' |3 ?1 \- {& r) e! l8 z
非常感謝您的指點，上面的內容從網頁上復制、黏貼到寫字板或宏文件里 ...

[attach]469824[/attach]

作者: 遠祥 時間: 2018-11-24 17:41
在原來的基礎上改會方便一些。

作者: arter_2006 時間: 2018-11-25 09:12
以下是我改過的宏，不知道哪里出了問題？附件壓縮包是寫字板格式的。
' ******************************************************************************
' 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
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long

Dim SelMgr As Object
Dim Feature As Object
Dim a As Integer
Dim b As String
Dim m As String
Dim e As String
Dim k As String
Dim t As String
Dim c As String
Dim j As Integer
Dim strmat As String
Dim tempvalue As String

Sub main() '刪除所有配置屬性
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
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
      For Each Vnamearr2 In Vnamearr
         bRet = Part.DeleteCustomInfo2(CurCFGname(i), Vnamearr2)
      Next
End If
Next
Call 刪除自定義屬性
Call partitionTM

End Sub

'~~~ 刪除自定義屬性 ~~~
Sub  '刪除自定義屬性
'Dim swApp As Object
Dim swModel2 As SldWorks.ModelDoc2
Dim vCustInfoNameArr2 As Variant

Set swApp = Application.SldWorks
Set swModel2 = swApp.ActiveDoc
vCustInfoNameArr2 = swModel2.GetCustomInfoNames
  If Not IsEmpty(vCustInfoNameArr2) Then
   For Each vCustInfoName2 In vCustInfoNameArr2
      bRet = swModel2.DeleteCustomInfo(vCustInfoName2)
   Next
  End If
End Sub

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

'link solidworks
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
Set SelMgr = Part.SelectionManager
swApp.ActiveDoc.ActiveView.FrameState = 1
'扢隅曹講
c = swApp.ActiveDoc.GetTitle() '錨璃靡
strmat = Chr(34) + Trim("SW-Material" + "@") + c + Chr(34)
'tempvalue = Part.CustomInfo2("", "第蹋")
blnretval = Part.DeleteCustomInfo2("", "測瘍")
blnretval = Part.DeleteCustomInfo2("", "靡備")
blnretval = Part.DeleteCustomInfo2("", "第蹋")
a = InStr(c, " ") - 1
If 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
End If'
b = Mid(c, a + 2)
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)
End If
blnretval = Part.AddCustomInfo3("", "測瘍", swCustomInfoText, e)
blnretval = Part.AddCustomInfo3("", "靡備", swCustomInfoText, m)
blnretval = Part.AddCustomInfo3("", "第蹋", swCustomInfoText, strmat)
blnretval = Part.AddCustomInfo3("", "等笭", swCustomInfoText, " ")
blnretval = Part.AddCustomInfo3("", "掘蛁", swCustomInfoText, " ")

End Sub

作者: ryouss 時間: 2018-11-25 10:28
本帖最后由 ryouss 于 2018-11-25 10:59 編輯

arter_2006 發表于 2018-11-25 09:12
9 [' k' A* T- } E$ E( y以下是我改過的宏，不知道哪里出了問題？附件壓縮包是寫字板格式的。
b& s, N" J( c; J0 W9 t$ \' ******************************** ...

[attach]469833[/attach]

作者: ryouss 時間: 2018-11-25 11:32
就是如下的繁體字改為簡體字就是

' ******************************************************************************" a- i' M! f1 ]0 ]7 @
' C:\Users\admin\AppData\Local\Temp\swx8144\Macro1.swb - macro recorded on 11/22/18 by mqlu
" N% t/ C5 H; Q7 s8 s/ S
' ******************************************************************************! w* D& [) E4 G6 Z& {; q9 x
Dim swApp As Object. q) v7 [% X0 W5 M
Dim Part As Object
& ] A y! K) U$ O' |: e
Dim boolstatus As Boolean
2 d7 u/ E7 ?8 p( v `6 z
Dim longstatus As Long, longwarnings As Long5 O/ D* G: A8 Q+ O# f4 d( x2 ?
% O' B/ o5 r) ` `& ]
Dim SelMgr As Object
H! E4 u. \& p0 i+ W& o
Dim Feature As Object
; @: s* [3 _' ?3 w. o
Dim a As Integer2 y) ]* ~) q/ B5 S
Dim b As String+ K! w2 e# A. \1 V. |) h
Dim m As String
& d& I8 S& e4 O- J3 I# H# ~
Dim e As String: H9 V, Z: o: ^* c3 V2 z, j
Dim k As String0 K, t& v% G" i3 _! R' _# D2 n* ^
Dim t As String
- u4 i% O K9 D' J
Dim c As String3 Z+ L$ g. M2 s) |
Dim j As Integer
/ I/ j8 b& ?9 `7 P! h Z
Dim strmat As String
5 O/ g; P+ ~; J/ U
Dim tempvalue As String& \- R% c2 A9 m: b* D" E- O6 ^
& H# l! N* m1 M y( z4 i1 D8 G, D
Sub main() '刪除所有配置屬性
2 ]& U4 N, ~+ |' a. H( V
Set swApp = Application.SldWorks
& W" Q( v1 d' A) S/ o& j
Set Part = swApp.ActiveDoc
a# {6 X3 U1 F) C& r' K- Y
CurCFGname = Part.GetConfigurationNames/ e, j/ c7 J' \4 v8 h
CurCFGnameCount = Part.GetConfigurationCount" `# T9 ]( A- b+ b; j$ K. \$ `, o
For i = 0 To CurCFGnameCount - 1, C4 s9 N, m0 }
Set CusPropMgr = Part.Extension.CustomPropertyManager(CurCFGname(i))
. u1 d& q/ c2 s
Vnamearr = CusPropMgr.GetNames
6 Y$ A& Q; Q- M4 R8 `/ i9 }+ w
If Not IsEmpty(Vnamearr) Then
7 a( R( _8 K/ n/ f' f6 ~+ k
For Each Vnamearr2 In Vnamearr
/ H) w7 |$ I: c. ?
bRet = Part.DeleteCustomInfo2(CurCFGname(i), Vnamearr2)# R t9 k; `7 b+ z; \
Next( }/ R* h% ?3 V6 b3 Z, W [
End If
2 u- K% i$ j# Z5 o* t7 Q" r
Next
$ R4 W) A) w& a
Call 刪除自定義屬性3 G; M5 ]0 F" c9 Y: \$ s
Call partitionTM3 `* y5 f& \+ @) b4 o
5 b$ F" k- Q9 r
End Sub4 P. H i' F0 W* O+ t# D
+ H0 O2 K2 M; ^* G2 k! x" n
'~~~ 刪除自定義屬性 ~~~
3 F8 W* z$ t: J% ]
Sub 刪除自定義屬性()
, w" T' b3 R& S* _" Q/ y
'Dim swApp As Object
9 ` B( ]' a- I7 q- W; J$ U! t
Dim swModel2 As SldWorks.ModelDoc2! j3 u+ e" d1 Q, r0 \, K
Dim vCustInfoNameArr2 As Variant5 U7 W; k! u3 X. d7 {
" N& N+ ]" W* @. f) ~
Set swApp = Application.SldWorks( j/ s" g( r6 e8 P
Set swModel2 = swApp.ActiveDoc
9 W3 {+ Z2 v" S- v I$ f
vCustInfoNameArr2 = swModel2.GetCustomInfoNames8 v, f' o& ]1 o6 j8 O, K) W
If Not IsEmpty(vCustInfoNameArr2) Then; l' A+ O( D) [4 ?, c
For Each vCustInfoName2 In vCustInfoNameArr21 c1 q+ k; ~% r8 ^: r C
bRet = swModel2.DeleteCustomInfo(vCustInfoName2)) T% P1 b8 s5 C6 ?' H8 _
Next4 ~7 E7 j* }& u% Y+ r
End If
* \! f, V2 [0 ?7 |$ P5 U7 ]4 I
End Sub o% `; l$ m2 U
5 L7 P5 x1 x/ ?* Z
'~~~ partitionTM ~~~* Z8 V' R! N) _
Sub partitionTM() 'partitionTM
' e$ a$ x: V0 E/ I1 p+ c9 X1 F
( O' M& R: V4 J; A' d
'link solidworks
: y! c1 \ z8 y) M+ @/ M* p( j
Set swApp = Application.SldWorks" `/ f1 c6 H; m$ T/ {
Set Part = swApp.ActiveDoc/ y/ E6 _) }( Q2 |5 q# h
Set SelMgr = Part.SelectionManager
( m$ y# z6 C; K3 }1 g9 g
swApp.ActiveDoc.ActiveView.FrameState = 1- G# ]1 b- j' K% X0 `
'設定變量
" c( A9 n( z% X% H. d
c = swApp.ActiveDoc.GetTitle() '零件名; s+ b G# a5 S6 U2 b5 H' V- Q& D
strmat = Chr(34) + Trim("SW-Material" + "@") + c + Chr(34), u7 x6 R5 |& d8 f# ~( x" {
'tempvalue = Part.CustomInfo2("", "材料")7 k/ H6 L' f8 j4 B9 ~
blnretval = Part.DeleteCustomInfo2("", "代號")
# N# }+ Q. h, r0 m: _
blnretval = Part.DeleteCustomInfo2("", "名稱")1 Q1 V+ N- J" m
blnretval = Part.DeleteCustomInfo2("", "材料")
. s2 L4 [+ x0 n0 X
a = InStr(c, " ") - 1
8 J; Z7 Q8 g/ Z4 q. @
If a > 0 Then' ^6 @1 n2 K! N3 v8 `$ D6 I! W
k = Left(c, a). I: T; J* Q. M# U* e
t = Left(LTrim(e), 3)
! J3 D9 @5 f Q9 }' G
If t = "GBT" Then
+ C+ d# Q: W5 H5 P1 n7 K/ r
e = "GB/T" + Mid(k, 4)
% V& Q- A. c: W8 N; X& v: j
Else4 u# ?) b2 ^6 U8 q- a ~" w
e = k
" K. n9 {8 d3 ^, e( |' F
End If
b = Mid(c, a + 2)! q0 a5 S }8 E+ [6 m0 C
t = Right(c, 7)5 V* N" O. b, `8 r( Y& z; k
If t = ".SLDPRT" Or t = ".SLDASM" Then) e) k) x6 e7 i$ q% _4 p% l% T1 |
j = Len(b) - 7 v& ]: R2 Z) S% u" N+ Y7 c
Else
) I% O, p. ~% t! r$ w
j = Len(b)
+ x l+ s& P/ C( h/ Y
End If
, n' d0 R; r5 ?9 @
m = Left(b, j)
$ M+ |) k+ v7 K2 }: Q7 o6 q
End If
# ]3 r( F; l% b$ V+ V* |
blnretval = Part.AddCustomInfo3("", "代號", swCustomInfoText, e)
% {( n& a- Q7 m; F% V5 S+ \8 }, _
blnretval = Part.AddCustomInfo3("", "名稱", swCustomInfoText, m)
* F4 {3 l% n( @/ [# G
blnretval = Part.AddCustomInfo3("", "材料", swCustomInfoText, strmat)
( i3 s+ G& V9 C6 j% E5 B8 h
blnretval = Part.AddCustomInfo3("", "單重", swCustomInfoText, " ")
2 p) q4 p3 V; H5 M' S" u
blnretval = Part.AddCustomInfo3("", "備註", swCustomInfoText, " ")) Z+ ~! L- ^6 N5 `
5 t2 ^4 {9 k3 e. a' m& \
End Sub

復制代碼

作者: arter_2006 時間: 2018-11-26 15:11

ryouss 發表于 2018-11-25 11:32
$ e6 u. {! q3 ^" v就是如下的繁體字改為簡體字就是

執行后無反應，屬性都沒改，不知道問題出在哪里？讓您費心了。

' ******************************************************************************
' 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
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long

Dim SelMgr As Object
Dim Feature As Object
Dim a As Integer
Dim b As String
Dim m As String
Dim e As String
Dim k As String
Dim t As String
Dim c As String
Dim j As Integer
Dim strmat As String
Dim tempvalue As String

Sub main() '刪除所有配置屬性
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
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
      For Each Vnamearr2 In Vnamearr
         bRet = Part.DeleteCustomInfo2(CurCFGname(i), Vnamearr2)
      Next
End If
Next
Call 刪除自定義屬性
Call partitionTM

End Sub

'~~~ 刪除自定義屬性 ~~~
Sub 刪除自定義屬性()
'Dim swApp As Object
Dim swModel2 As SldWorks.ModelDoc2
Dim vCustInfoNameArr2 As Variant

Set swApp = Application.SldWorks
Set swModel2 = swApp.ActiveDoc
vCustInfoNameArr2 = swModel2.GetCustomInfoNames
  If Not IsEmpty(vCustInfoNameArr2) Then
   For Each vCustInfoName2 In vCustInfoNameArr2
      bRet = swModel2.DeleteCustomInfo(vCustInfoName2)
   Next
  End If
End Sub

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

'link solidworks
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
Set SelMgr = Part.SelectionManager
swApp.ActiveDoc.ActiveView.FrameState = 1
'設定變量
c = swApp.ActiveDoc.GetTitle() '零件名
strmat = Chr(34) + Trim("SW-Material" + "@") + c + Chr(34)
'tempvalue = Part.CustomInfo2("", "材料")
blnretval = Part.DeleteCustomInfo2("", "代號")
blnretval = Part.DeleteCustomInfo2("", "名稱")
blnretval = Part.DeleteCustomInfo2("", "材料")
a = InStr(c, " ") - 1
If 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
End If
b = Mid(c, a + 2)
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)
End If
blnretval = Part.AddCustomInfo3("", "代號", swCustomInfoText, e)
blnretval = Part.AddCustomInfo3("", "名稱", swCustomInfoText, m)
blnretval = Part.AddCustomInfo3("", "材料", swCustomInfoText, strmat)
blnretval = Part.AddCustomInfo3("", "單重", swCustomInfoText, " ")
blnretval = Part.AddCustomInfo3("", "備注", swCustomInfoText, " ")

End Sub

作者: ryouss 時間: 2018-11-26 16:58
本帖最后由 ryouss 于 2018-11-26 17:04 編輯

arter_2006 發表于 2018-11-26 15:114 N! M! P7 t2 l9 M
執行后無反應，屬性都沒改，不知道問題出在哪里？讓您費心了。
* p9 C9 _1 q/ k, D# q0 Z5 d3 j
' ********************************** ...

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

[attach]469919[/attach]

作者: arter_2006 時間: 2018-11-26 17:00
我的是Solidworks 2018，看來可能是版本的問題了

作者: ryouss 時間: 2018-11-26 17:05

arter_2006 發表于 2018-11-26 17:00
: r8 x3 F9 a2 H7 Q* | K7 w我的是Solidworks 2018，看來可能是版本的問題了

2018 沒版本能試

作者: arter_2006 時間: 2018-11-26 17:19

ryouss 發表于 2018-11-26 17:053 I" y2 |( x) l$ W) E
2018 沒版本能試

非常感謝您，讓您費心了。

作者: arter_2006 時間: 2018-11-26 17:27

ryouss 發表于 2018-11-26 17:057 T" C1 p: b6 D$ x2 r6 H/ x! H& T
2018 沒版本能試

能否把您的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
' ******************************************************************************
: 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
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
& 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
Dim e As String" t" l1 k  K7 K8 U: @# s; `
Dim k As String* ?4 t9 u7 n+ _
Dim t As String
% 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
Dim strmat As String
" 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() '刪除所有配置屬性
; 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 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 {
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
      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

2 @8 q. ~" b  {% q" `4 h6 {End Sub
% 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" }
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 {
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)
. ?" 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* [
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() '零件名
. {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("", "材料")
& 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
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
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
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
! 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)
1 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' \
Else& f9 y# D- W/ Y! i& w- H
      j = Len(b); J( ?# E, |  ?
End If8 @/ x5 s, N; \. _& V# V
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
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, " ")
: i2 D6 }7 z- @1 t: i# Q, P, {! f% c" J- {6 u; t
End Sub

作者: ryouss 時間: 2018-11-26 18:42

arter_2006 發表于 2018-11-26 17:27
% o8 O# K8 z2 a% V! G7 o; H能否把您的SWP文件發上來，我剛才用solidworks 2014也試了一下，發現也不行，但是別的宏都可以。
- D0 q! X& [$ Y0 A0 W9 z我從網 ...

附swp繁體版 [attach]469923[/attach]

作者: ryouss 時間: 2018-11-27 13:26
本帖最后由 ryouss 于 2018-11-27 13:31 編輯

試試把 CurCFGname = swApp.GetConfigurationNames

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

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

[attach]469963[/attach]

作者: arter_2006 時間: 2018-11-28 13:49
我試過了，改之前，改之后一個樣，而且

執行中沒有任何錯誤提示。
' ******************************************************************************
' 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
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long

Dim SelMgr As Object
Dim Feature As Object
Dim a As Integer
Dim b As String
Dim m As String
Dim e As String
Dim k As String
Dim t As String
Dim c As String
Dim j As Integer
Dim strmat As String
Dim tempvalue As String

Sub main() '刪除所有配置屬性
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
CurCFGname = swApp.GetConfigurationNames(swApp.ActiveDoc.GetPathName) '補加零件文件的路徑及名稱
CurCFGnameCount = Part.GetConfigurationCount
For i = 0 To CurCFGnameCount - 1
Set CusPropMgr = Part.Extension.CustomPropertyManager(CurCFGname(i))
Vnamearr = CusPropMgr.GetNames
If Not IsEmpty(Vnamearr) Then
      For Each Vnamearr2 In Vnamearr
         bRet = Part.DeleteCustomInfo2(CurCFGname(i), Vnamearr2)
      Next
End If
Next
Call 刪除自定義屬性
Call partitionTM

End Sub

'~~~ 刪除自定義屬性 ~~~
Sub 刪除自定義屬性()
'Dim swApp As Object
Dim swModel2 As SldWorks.ModelDoc2
Dim vCustInfoNameArr2 As Variant

Set swApp = Application.SldWorks
Set swModel2 = swApp.ActiveDoc
vCustInfoNameArr2 = swModel2.GetCustomInfoNames
  If Not IsEmpty(vCustInfoNameArr2) Then
   For Each vCustInfoName2 In vCustInfoNameArr2
      bRet = swModel2.DeleteCustomInfo(vCustInfoName2)
   Next
  End If
End Sub

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

'link solidworks
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
Set SelMgr = Part.SelectionManager
swApp.ActiveDoc.ActiveView.FrameState = 1
'設定變量
c = swApp.ActiveDoc.GetTitle() '零件名
strmat = Chr(34) + Trim("SW-Material" + "@") + c + Chr(34)
'tempvalue = Part.CustomInfo2("", "材料")
blnretval = Part.DeleteCustomInfo2("", "代號")
blnretval = Part.DeleteCustomInfo2("", "名稱")
blnretval = Part.DeleteCustomInfo2("", "材料")

a = InStr(c, " ") - 1
If 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
End If

b = Mid(c, a + 2)
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)
End If

blnretval = Part.AddCustomInfo3("", "代號", swCustomInfoText, e)
blnretval = Part.AddCustomInfo3("", "名稱", swCustomInfoText, m)
blnretval = Part.AddCustomInfo3("", "材料", swCustomInfoText, strmat)
blnretval = Part.AddCustomInfo3("", "單重", swCustomInfoText, " ")
blnretval = Part.AddCustomInfo3("", "備注", swCustomInfoText, " ")

End Sub

作者: arter_2006 時間: 2018-11-28 16:45
2014試過了，和2018一樣。但3個宏各自單獨執行是沒問題的。不知道問題在哪里

作者: ryouss 時間: 2018-11-28 17:11

arter_2006 發表于 2018-11-28 16:45. k1 J( l' U3 |# q
2014試過了，和2018一樣。但3個宏各自單獨執行是沒問題的。不知道問題在哪里

2012版本 "引用項目" 作參考,看是否有打勾!

[attach]470060[/attach]

作者: arter_2006 時間: 2018-11-28 18:54

ryouss 發表于 2018-11-28 17:11
* L* j- b5 h/ ~3 o2 v7 n) `2012版本 "引用項目" 作參考,看是否有打勾!

打勾了，只是沒有solidworks 2012的選項，我從上到下都看過了

作者: ryouss 時間: 2018-11-28 20:18

arter_2006 發表于 2018-11-28 18:54# H3 Q9 E6 n0 W4 A9 V& M3 _
打勾了，只是沒有solidworks 2012的選項，我從上到下都看過了

因是2018版沒2012是正常的.

另試 "逐步執行" 看程式如何執行!(一搬在抓程式臭蟲就要用到"逐步執行")

[attach]470072[/attach]

作者: arter_2006 時間: 2018-11-29 08:18
本帖最后由 arter_2006 于 2018-11-29 08:49 編輯

2018沒有偵錯按鈕，但有“逐語句”按鈕，點了后沒發現任何問題。
下面是截屏。

作者: arter_2006 時間: 2018-11-29 08:23
又用solidworks 2014試了下，發現問題：

作者: arter_2006 時間: 2018-11-29 08:57
對于solidworks 2014,我試了兩個宏，一個是昨天的宏，及宏的名字為中文名，如”刪除當前配置屬性.swp“，但
"CurCFGname = Part.GetConfigurationNames"
這一句沒有改，
我進行了逐句檢查，沒有發現問題。
后來我把宏的名字改為英文名，但上面的語句改為了
CurCFGname = swApp.GetConfigurationNames(swApp.ActiveDoc.GetPathName) '補加零件文件的路徑及名稱
，執行逐句檢查，沒有再發現問題。
上面的兩個版本在solidworks 2018，及在sw2014里發現問題的宏，都沒有發現任何問題。

補充一點，我剛剛發現，這幾個宏，無論是在sw2014還是2018里，都能夠執行”partitionTM.swp“宏里的內容，但另外兩個宏里的內容都不能起到任何作用，即不能刪除自定義屬性、及所有配置屬性里的內容。

作者: arter_2006 時間: 2018-11-29 10:18
@ryouss,謝謝，讓您費心了。

作者: DaveChan 時間: 2018-11-30 11:11
可使用RunMacro2函數執行外部宏，如下參考

Option Explicit
3 W5 Y0 }/ a2 u
Dim swApp As SldWorks.SldWorks+ G1 j- s1 }5 n; x% Z3 z
Dim runMacroError As Long7 X: V% \4 s4 A% Z. x4 g$ P, J2 r
& b) {: {2 W# n% ^( \$ {$ G8 g' {
Sub main()
0 {1 L, T4 a, m; Y7 }/ L6 G
Set swApp = Application.SldWorks
/ Q4 F+ _: o! `' D- f* p% C* m8 G
swApp.RunMacro2 "C:\Users\Administrator\Desktop\Macros\刪除所有配置屬性.swp", "配置1", "main", 0, runMacroError6 {: M" g) I3 x/ {% d/ @
swApp.RunMacro2 "C:\Users\Administrator\Desktop\Macros\刪除自定義屬性.swp", "配置1", "main", 0, runMacroError9 Q% M8 i$ D, O `
swApp.RunMacro2 "C:\Users\Administrator\Desktop\Macros\partitionTM.swp", "partitionTM1", "main", 0, runMacroError7 j8 v* C- q2 V, ^& Z7 v+ `
End Sub7 Q* a3 P5 V W* ?

復制代碼

[attach]470181[/attach]

作者: arter_2006 時間: 2018-11-30 12:52

DaveChan 發表于 2018-11-30 11:11
9 U. }! N4 a" }) M9 e3 p) s S可使用RunMacro2函數執行外部宏，如下參考

非常感謝您，成功了

作者: hdgd501 時間: 2018-12-29 13:05
好好學習下，謝謝樓主

作者: de0830 時間: 2019-3-9 15:10
謝謝，太好了

歡迎光臨機械社區 (http://www.whclglass.com.cn/)