機械社區(qū)

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

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

是這樣的，想做一個宏，通過這個宏，會先后調(diào)用其它的宏，請問如何編寫？非常感謝。
宏的名稱分別是：
刪除所有配置屬性.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 發(fā)表于 2018-11-23 14:34
. J; u8 t/ H6 V. F( D9 j# |參考

非常感謝您的指點，根據(jù)我的淺薄理解，我的宏如下，但不起作用：
' ******************************************************************************
' 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個宏有沒有問題，這三個宏單獨執(zhí)行的是沒問題的。上面提到的，就是想把附件壓縮包里的三個宏聯(lián)合執(zhí)行。

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

arter_2006 發(fā)表于 2018-11-24 12:532 j" r( {- H' ]# k
不知道3個宏有沒有問題，這三個宏單獨執(zhí)行的是沒問題的。上面提到的，就是想把附件壓縮包里的三個宏聯(lián)合執(zhí) ...

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

' ******************************************************************************; i" [: t& w) \$ D: I
' C:\Users\admin\AppData\Local\Temp\swx8144\Macro1.swb - macro recorded on 11/22/18 by mqlu
9 \+ W0 g! e# ~! h0 n: ^ ^" T& o
' ******************************************************************************
- b: F: x9 U( g' M9 Z6 g
Dim swApp As Object' l) G) A5 s) l: e
Dim Part As Object' S) k$ o4 g- g
Dim boolstatus As Boolean
, L7 @8 J, g, p" x2 O
Dim longstatus As Long, longwarnings As Long
- ^& r* s3 p7 i; Y; [* D& ]7 U0 v
, k9 s; U* w* S( ]# W+ S
Dim SelMgr As Object- v1 ^- m/ V7 b7 g* |& `; e1 T( k1 r( `
Dim Feature As Object
0 d5 ?1 z; A4 D* k, y V
Dim a As Integer6 r+ H; P% u- g4 g
Dim b As String: E y2 L {1 W2 o+ M$ F3 k
Dim m As String
( Z" n# b( N; `* W1 n% \. H3 K; |
Dim e As String: e% y$ J& \: U$ q6 S$ h# P
Dim k As String$ L5 s8 K& @7 O; P4 D/ A. f5 q
Dim t As String x3 s- Z+ M& F
Dim c As String* l) b ]) R2 |' u# \
Dim j As Integer( `$ u: V `; U( H% z
Dim strmat As String
`7 W; B0 ?2 T! l
Dim tempvalue As String
# s A$ d$ H, v8 c
2 p! {/ {( V r& i% t3 ?: ?
Sub main() '刉壺垀衄饜離扽俶(刪除所有配置屬性)/ p6 {6 Q. @4 A8 m7 }% ?! T
Set swApp = Application.SldWorks' V1 |3 _4 p3 X g7 @; W
Set Part = swApp.ActiveDoc7 Q6 I c' y4 p: g) l( [
CurCFGname = Part.GetConfigurationNames8 R( A! o7 _# y. @
CurCFGnameCount = Part.GetConfigurationCount0 G& ]3 A, ?4 x& ~9 P
For i = 0 To CurCFGnameCount - 1
" @ @ ~. i" V' S) ~# d
Set CusPropMgr = Part.Extension.CustomPropertyManager(CurCFGname(i))% `; N1 q9 S; A* B
Vnamearr = CusPropMgr.GetNames
' [2 U g; L+ J) N5 i$ L$ b4 j
If Not IsEmpty(Vnamearr) Then% U+ N5 C8 Z1 l% C& U2 n9 G
For Each Vnamearr2 In Vnamearr) V) M' ?+ v1 u% d ~ `; w. }
bRet = Part.DeleteCustomInfo2(CurCFGname(i), Vnamearr2)
) j+ D, ]/ Y, j$ Y8 u5 l: y
Next3 h! i- o* [2 E
End If) c7 E& x$ v) ]+ Q" c3 Y
Next
) x6 `: t) Y; H# c0 G3 c
Call 刉壺赻隅砱扽俶 '(刪除自定義屬性)! v" G5 |9 @1 d* u8 g0 k
Call partitionTM2 @' [9 u% A5 ~* g* S
' y6 X1 ^% C$ b! _6 [9 n
End Sub% \% v0 c5 t: L% E1 t# ?7 s
* z. s8 b9 r$ ^/ S
'~~~ 刉壺赻隅砱扽俶 ~~~+ d1 m- i7 |+ M, w
Sub 刉壺赻隅砱扽俶() '(刪除自定義屬性) }) j0 k8 @. k) i2 i
'Dim swApp As Object# g* ?6 M {9 g# f v1 R8 ?
Dim swModel2 As SldWorks.ModelDoc2" z4 e3 ]1 B9 b( Z& \
Dim vCustInfoNameArr2 As Variant
& _$ m X2 l% b f k& R
$ g" K! C/ L( x& d1 b8 G5 u C
Set swApp = Application.SldWorks8 G2 O$ d/ D0 f0 g# c2 C4 X
Set swModel2 = swApp.ActiveDoc
3 Z% Y/ q: j5 K. B5 G
vCustInfoNameArr2 = swModel2.GetCustomInfoNames+ e7 U5 y) O6 u( s
If Not IsEmpty(vCustInfoNameArr2) Then
# v$ }& J# j3 g& Y" ?5 U' L
For Each vCustInfoName2 In vCustInfoNameArr2
. J6 ~) w7 Q, w: n
bRet = swModel2.DeleteCustomInfo(vCustInfoName2)
2 W0 D! n2 X/ d. A! n- b
Next
% O; p# m$ D; J+ ]# q
End If8 v3 N8 A! J/ X% p* r
End Sub
5 {5 n- Q7 Z! }* ^/ o) p
! P: v! k, W$ k4 m
'~~~ partitionTM ~~~
* @, B8 L7 z$ j. a+ {- F' ^
Sub partitionTM() 'partitionTM+ X7 [3 O5 o) d; s( ? G+ G6 F
\) ^/ O' Q+ Y a8 \& H) m
'link solidworks; E- h# X* I: |, l. [
Set swApp = Application.SldWorks! U3 O' _* i" N& t; {
Set Part = swApp.ActiveDoc
, V- n& u/ H V# x k+ f4 O4 \
Set SelMgr = Part.SelectionManager. n% S4 T0 ]# B' Z, ?: ~
swApp.ActiveDoc.ActiveView.FrameState = 1) F; G, B4 N; D) {/ W5 f
'扢隅曹講5 S8 B, [, l, [7 f! H" ~ q
c = swApp.ActiveDoc.GetTitle() '錨璃靡
* Z2 \) y' C, N+ G, s2 X
strmat = Chr(34) + Trim("SW-Material" + "@") + c + Chr(34)
$ E5 p- r: O2 B" ^% X
'tempvalue = Part.CustomInfo2("", "第蹋")
Q( w c) K. P8 B" o5 b$ y
blnretval = Part.DeleteCustomInfo2("", "測瘍")
# M/ v3 [% ^: `8 Z
blnretval = Part.DeleteCustomInfo2("", "靡備") N: l2 m: d. i( @" X# C
blnretval = Part.DeleteCustomInfo2("", "第蹋")
- O0 F( x' H7 }3 M" o7 x
a = InStr(c, " ") - 1
If a > 0 Then
. ^; g6 t7 W. k+ p3 L& `
k = Left(c, a)
* Y1 o: y) r: y$ C
t = Left(LTrim(e), 3)+ J R; o3 U3 k
If t = "GBT" Then
9 l, C; F& l0 u/ j3 G
e = "GB/T" + Mid(k, 4)
/ y& u( q- g4 h: {4 h( k- M s1 U
Else7 f [* i- ^9 F# f# q
e = k
3 g1 Y+ G9 Q( m$ q8 Y# i% X) X: M
End If
6 B3 d7 I7 a& `: _5 K) H$ Y- Z
b = Mid(c, a + 2)
( G3 P) J8 i6 ?( U0 x
t = Right(c, 7)
5 S! U* F' M6 r& ^8 D" a" N
If t = ".SLDPRT" Or t = ".SLDASM" Then
$ }3 T: w) \2 J9 O8 v; A+ k
j = Len(b) - 7
$ q, A1 @3 c; x) B2 |& H1 X/ q3 t8 O1 Z
Else* b T; d5 S1 q" W
j = Len(b)
8 l, x/ o( ~% ]1 A( D5 a
End If
5 h3 u$ n" f( {" y
m = Left(b, j)
; Q5 U4 i5 G0 n1 x8 i) U, m
End If
8 e$ p' N1 V: k7 H
blnretval = Part.AddCustomInfo3("", "測瘍", swCustomInfoText, e)
& k- Z. m- }! A @) z) P+ s
blnretval = Part.AddCustomInfo3("", "靡備", swCustomInfoText, m)
: \' V/ A. z4 Y! @0 B/ g- n7 j0 Y
blnretval = Part.AddCustomInfo3("", "第蹋", swCustomInfoText, strmat)6 G' T- Q: g: d7 Q' m @5 T" u
blnretval = Part.AddCustomInfo3("", "等笭", swCustomInfoText, " ")
* T. t2 }0 O, I/ c" [
blnretval = Part.AddCustomInfo3("", "掘蛁", swCustomInfoText, " ")! \( }2 z! @+ ?
5 M+ q* w; V8 C( b' v$ s6 k- O! A
End Sub
2 p0 w6 A# c) R+ J

復制代碼

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

ryouss 發(fā)表于 2018-11-24 13:45, P T! l5 J- C6 a6 a) g) I9 `
[Run main() 試試!]

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

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

arter_2006 發(fā)表于 2018-11-24 15:28
: s3 a, ]6 }8 z5 k4 [2 C. U5 i' ^能否把您改后的swp文件上傳上來？
( s' Y4 l3 I, f1 g非常感謝您的指點，上面的內(nèi)容從網(wǎng)頁上復制、黏貼到寫字板或宏文件里 ...

[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 發(fā)表于 2018-11-25 09:12
6 S. J/ n' P# r以下是我改過的宏，不知道哪里出了問題？附件壓縮包是寫字板格式的。( D! ~4 M f. ?0 Y
' ******************************** ...

[attach]469833[/attach]

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

' ******************************************************************************! p) \7 f& C: C- q8 W
' C:\Users\admin\AppData\Local\Temp\swx8144\Macro1.swb - macro recorded on 11/22/18 by mqlu! y3 E) L' g5 _, ?
' ******************************************************************************
4 |- C$ ~/ L* a
Dim swApp As Object
& [3 j/ n. m, h7 O1 X
Dim Part As Object
# q9 m: u; \& n' P
Dim boolstatus As Boolean
7 h: R' @4 r# I2 c' k2 ^
Dim longstatus As Long, longwarnings As Long
' @: N; e, y4 y1 c b
' s9 N. ?! w9 B3 L7 r+ n
Dim SelMgr As Object% S4 S5 C4 U* C* z- m/ r" f9 a- r
Dim Feature As Object$ \% z, Y9 q$ j" d, @
Dim a As Integer( R$ v& y" o5 B: U. D
Dim b As String
- C+ l2 X c$ S) v
Dim m As String& V, B; c8 v9 B7 {, l v
Dim e As String8 C; R1 T3 c; H$ H$ Q
Dim k As String( w# o: k- t/ X; ?* H
Dim t As String; _6 i7 T+ D) Q
Dim c As String6 o3 L( a, p2 w; H: K8 r
Dim j As Integer$ O# P7 l% w$ U0 o0 c+ s
Dim strmat As String$ R8 C$ F6 ~: D+ D y8 `2 p# e$ O9 m
Dim tempvalue As String
, p' a& p, n- z2 \; Y4 o/ y
& v* V0 q% t: r9 V7 S
Sub main() '刪除所有配置屬性$ s- v* Z$ W" ^. q
Set swApp = Application.SldWorks
' F9 U5 d2 q: Z6 j: M2 n1 ~
Set Part = swApp.ActiveDoc
6 m! L* Y5 G" i/ w( d. e
CurCFGname = Part.GetConfigurationNames5 c, E$ ~- _5 `- Q& I
CurCFGnameCount = Part.GetConfigurationCount5 _8 H6 U9 ]' v. D; G6 i" L; ]
For i = 0 To CurCFGnameCount - 1# S Q4 K2 J- ]
Set CusPropMgr = Part.Extension.CustomPropertyManager(CurCFGname(i))% [% b- a0 L& p+ F" v
Vnamearr = CusPropMgr.GetNames, f7 ]" G! r% b; C+ S: [, b! w5 b# P
If Not IsEmpty(Vnamearr) Then
# F, g& d& R& |- z. v/ F/ [( s
For Each Vnamearr2 In Vnamearr! p& Y' \) }' V" E
bRet = Part.DeleteCustomInfo2(CurCFGname(i), Vnamearr2)
! Z0 N2 Q1 k7 t1 P( C8 R
Next
z! }3 D; g8 h+ Y6 p7 M
End If- \% D& U5 {+ q* A
Next/ L5 \+ J1 L/ B" x2 {8 O+ H2 i/ E
Call 刪除自定義屬性; d' A" v' o h$ l n
Call partitionTM( I U" O5 r6 ^; @3 g; @5 |
! |) P- |% r: m" ]! ?
End Sub/ I" {9 t. F2 M7 [7 Z) j$ b E
' ?) _: ^6 r2 J
'~~~ 刪除自定義屬性 ~~~* ]: J; u" Q/ \3 W
Sub 刪除自定義屬性()3 u6 A( r7 |9 S1 T0 C* \
'Dim swApp As Object2 `$ }* P: D8 C9 j0 X' i
Dim swModel2 As SldWorks.ModelDoc2 v5 k8 _8 T& O5 x+ L
Dim vCustInfoNameArr2 As Variant. v" N5 _+ O9 [& {; {
" j6 F8 x9 U: K( @. C
Set swApp = Application.SldWorks; y" u# I# g1 |( M" ?6 U
Set swModel2 = swApp.ActiveDoc3 E0 T+ v! Q6 T- P
vCustInfoNameArr2 = swModel2.GetCustomInfoNames
9 @4 g1 D, q2 a! a1 Q9 o
If Not IsEmpty(vCustInfoNameArr2) Then
) m A8 k/ J- { ~' |" ]$ C
For Each vCustInfoName2 In vCustInfoNameArr2! a: R- ?% j+ b2 b* F
bRet = swModel2.DeleteCustomInfo(vCustInfoName2)
9 `5 @' }3 P+ v
Next4 s, @. T! g' C' f8 B
End If" Y. M% `7 p% {4 [, D
End Sub
0 O+ \% E5 q- J9 E; N3 r6 l
2 j2 T5 P# V% C2 D* C
'~~~ partitionTM ~~~
; i. ?; f1 d% m
Sub partitionTM() 'partitionTM
- o+ ` s! ^! e4 o' a/ \
8 |* R4 a4 Z! f' b: l% l
'link solidworks
% V7 t5 s2 w8 b. T1 P m
Set swApp = Application.SldWorks4 l' S2 x: u9 B4 I4 h; o
Set Part = swApp.ActiveDoc
9 p) }3 j6 ?' D3 C, k( ~3 C, l* a
Set SelMgr = Part.SelectionManager
* `8 v' M% k, c. j
swApp.ActiveDoc.ActiveView.FrameState = 1
. y8 @5 X9 E* Z
'設定變量3 d( m6 R. D% R+ b" G3 O
c = swApp.ActiveDoc.GetTitle() '零件名
+ K5 ]! g# j9 o: Q; P$ R+ F( W
strmat = Chr(34) + Trim("SW-Material" + "@") + c + Chr(34)) _% @8 H# y- y0 s" S
'tempvalue = Part.CustomInfo2("", "材料")1 r& Z: A+ a8 h. s
blnretval = Part.DeleteCustomInfo2("", "代號")2 ?" A, g. _! Q0 H
blnretval = Part.DeleteCustomInfo2("", "名稱")
5 M9 [; s" a I k3 u
blnretval = Part.DeleteCustomInfo2("", "材料")% q& K, ~, d- r9 X
a = InStr(c, " ") - 1( J$ b8 o! D1 _: t
If a > 0 Then
( ^4 r" ~' ~0 l; L! O. _6 K# u
k = Left(c, a)
! M; f; v! h: R1 p3 v! @6 J
t = Left(LTrim(e), 3)
& b+ V1 H9 b g( x
If t = "GBT" Then
) q; O. `$ E1 I1 H* l. n
e = "GB/T" + Mid(k, 4)/ d4 b! B# q! m, l, Q# G% c8 t
Else
& ?* W7 g* \" V6 L, `- s0 L8 B
e = k. V Q- P7 C8 |6 t$ I
End If
- x9 ?+ ]6 I) H. _' p& u
b = Mid(c, a + 2)2 { f- ~# |7 x+ f3 _( V
t = Right(c, 7)4 @0 p+ t7 n2 c7 R0 ?; ~
If t = ".SLDPRT" Or t = ".SLDASM" Then
: ^1 L4 T! T$ b- s' ^; M. _
j = Len(b) - 7
' p% M: P/ o; P* `: I1 {
Else
H( n0 W7 _- T) p/ N
j = Len(b)& C( ^; F- S8 G! y- F0 ~0 b
End If1 V! A% w" m( [2 [
m = Left(b, j)
: X( n2 A* V: X& P! L
End If
. e- [8 j3 l8 Y2 u0 X! y
blnretval = Part.AddCustomInfo3("", "代號", swCustomInfoText, e)$ F, W$ D" Y: @* v* F. [1 N
blnretval = Part.AddCustomInfo3("", "名稱", swCustomInfoText, m)' q" }3 Y$ o9 S
blnretval = Part.AddCustomInfo3("", "材料", swCustomInfoText, strmat)
; b- S8 c/ n/ U8 S' `/ |! Z
blnretval = Part.AddCustomInfo3("", "單重", swCustomInfoText, " ")
0 w+ _+ Z5 y) I7 w
blnretval = Part.AddCustomInfo3("", "備註", swCustomInfoText, " ")' ?( w# O9 x( o9 ^5 V
9 E, p. E) \6 i0 e1 i
End Sub

復制代碼

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

ryouss 發(fā)表于 2018-11-25 11:320 E5 K/ A+ e, Y. ]3 H: C- A$ X) j
就是如下的繁體字改為簡體字就是

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

' ******************************************************************************
' 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 發(fā)表于 2018-11-26 15:11
c& N6 ^' b0 S) z) _* r- F! }執(zhí)行后無反應，屬性都沒改，不知道問題出在哪里？讓您費心了。
! }8 r; f1 }. D; g+ R( ^# W6 v8 b; f) g8 h- S: Z+ J
' ********************************** ...

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

[attach]469919[/attach]

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

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

arter_2006 發(fā)表于 2018-11-26 17:00( D; ~( E& S5 X- o. J4 |, c
我的是Solidworks 2018，看來可能是版本的問題了

2018 沒版本能試

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

ryouss 發(fā)表于 2018-11-26 17:057 z+ L$ k p0 Y* i5 B o% u- U' b
2018 沒版本能試

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

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

ryouss 發(fā)表于 2018-11-26 17:052 e3 I; i1 @" E) G4 _) _1 Z
2018 沒版本能試

能否把您的SWP文件發(fā)上來，我剛才用solidworks 2014也試了一下，發(fā)現(xiàn)也不行，但是別的宏都可以。
我從網(wǎng)頁上復制下來的都變成下面這個樣子了，所以要刪掉很多多出來的東西，我懷疑是不是這個原因?qū)е碌�，但是校對很費時間，也難發(fā)現(xiàn)。

' ******************************************************************************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 發(fā)表于 2018-11-26 17:27; K* ?% j9 i% b4 ^# v. W
能否把您的SWP文件發(fā)上來，我剛才用solidworks 2014也試了一下，發(fā)現(xiàn)也不行，但是別的宏都可以。* X. }; G; b0 r: a
我從網(wǎng) ...

附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編程在 " ' " 符號后的文字是會跳過不執(zhí)行的.

[attach]469963[/attach]

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

執(zhí)行中沒有任何錯誤提示。
' ******************************************************************************
' 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個宏各自單獨執(zhí)行是沒問題的。不知道問題在哪里

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

arter_2006 發(fā)表于 2018-11-28 16:45
) z2 ^8 r3 h7 O5 s2014試過了，和2018一樣。但3個宏各自單獨執(zhí)行是沒問題的。不知道問題在哪里

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

[attach]470060[/attach]

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

ryouss 發(fā)表于 2018-11-28 17:11( H/ ~5 W$ X( a
2012版本 "引用項目" 作參考,看是否有打勾!

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

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

arter_2006 發(fā)表于 2018-11-28 18:54
/ E3 y% t7 ?/ t6 D1 ^8 l( u; ?打勾了，只是沒有solidworks 2012的選項，我從上到下都看過了

因是2018版沒2012是正常的.

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

[attach]470072[/attach]

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

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

作者: arter_2006 時間: 2018-11-29 08:23
又用solidworks 2014試了下，發(fā)現(xiàn)問題：

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

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

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

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

Option Explicit8 M8 m N3 J$ x3 I8 [& v7 ]
Dim swApp As SldWorks.SldWorks
# t ?* l( C! u) |' m* K
Dim runMacroError As Long
, y6 G' A3 N. K+ X
4 e" O, x0 g! \- M" n
Sub main()1 O+ [+ j2 H4 }7 d+ I3 J/ y
Set swApp = Application.SldWorks" t3 S/ {/ t/ e4 f* v% h7 V; P& ?
swApp.RunMacro2 "C:\Users\Administrator\Desktop\Macros\刪除所有配置屬性.swp", "配置1", "main", 0, runMacroError4 R: W0 J2 Q: o6 J& I) \4 V
swApp.RunMacro2 "C:\Users\Administrator\Desktop\Macros\刪除自定義屬性.swp", "配置1", "main", 0, runMacroError
+ C+ L1 z- J$ M3 i# I
swApp.RunMacro2 "C:\Users\Administrator\Desktop\Macros\partitionTM.swp", "partitionTM1", "main", 0, runMacroError) n" t% l/ l/ ^" Y7 p6 u0 h
End Sub- k1 F9 |, k: b1 H+ q8 h% }4 l

復制代碼

[attach]470181[/attach]

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

DaveChan 發(fā)表于 2018-11-30 11:112 A: T; a, L% k5 J+ ?$ Y
可使用RunMacro2函數(shù)執(zhí)行外部宏，如下參考

非常感謝您，成功了

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

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

歡迎光臨機械社區(qū) (http://e-learninguniversity.com/)