SOLIDWORKS 宏合并執(zhí)行的問題

arter_2006 · 發(fā)表于 2018-11-23 12:41:43

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

ryouss · 發(fā)表于 2018-11-23 14:34:19

參考

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

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

arter_2006 · 發(fā)表于 2018-11-24 12:51:08

ryouss 發(fā)表于 2018-11-23 14:34
5 V% g% O8 Y; J; a參考

非常感謝您的指點(diǎn),，根據(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 · 發(fā)表于 2018-11-24 12:53:47

不知道3個(gè)宏有沒有問題,，這三個(gè)宏單獨(dú)執(zhí)行的是沒問題的,。上面提到的，就是想把附件壓縮包里的三個(gè)宏聯(lián)合執(zhí)行,。

ryouss · 發(fā)表于 2018-11-24 13:45:49

arter_2006 發(fā)表于 2018-11-24 12:53" `( N- w2 O! n. Z: R
不知道3個(gè)宏有沒有問題,，這三個(gè)宏單獨(dú)執(zhí)行的是沒問題的,。上面提到的，就是想把附件壓縮包里的三個(gè)宏聯(lián)合執(zhí) ...

[Run main() 試試!]

' ******************************************************************************
% c( X# L& P) b: @
' C:\Users\admin\AppData\Local\Temp\swx8144\Macro1.swb - macro recorded on 11/22/18 by mqlu4 B+ Z- w; n/ y+ x( r8 r& I
' ******************************************************************************/ I9 T) Z: F9 k: n) c; o
Dim swApp As Object5 y. q0 r% H# I
Dim Part As Object, A; {8 d q/ v/ X
Dim boolstatus As Boolean% h4 u/ z3 @" U3 l3 ]
Dim longstatus As Long, longwarnings As Long
- K1 U4 h& D) d" i3 [
\ ^* j$ Y6 D0 [. n3 l
Dim SelMgr As Object
- i6 p, ]6 {/ Y! s& e! k
Dim Feature As Object
* ]/ {% k% M7 `# {% j. J3 C
Dim a As Integer
& a3 }. y$ E% w8 N
Dim b As String+ x0 g, ^0 @$ E' Y, n. z/ H: f& n
Dim m As String0 S; e7 ]3 {' s
Dim e As String
2 q4 f& j& S2 B5 ^
Dim k As String1 u( b! \4 I, Q; O2 t
Dim t As String8 V# {( E. `* F/ {0 ]
Dim c As String
3 R2 b+ ~7 s* D0 N9 Z# k3 h
Dim j As Integer7 D8 U3 `7 j ?2 s: I8 M2 ^
Dim strmat As String+ z0 r( P+ K) \9 O
Dim tempvalue As String& ]4 a. o- e( H2 V ~1 ^# _
! S0 f3 O# K s$ U* E% o& f7 i
Sub main() '刉壺垀衄饜離扽俶(刪除所有配置屬性)$ l! T. u/ \/ I0 T- q/ t5 z
Set swApp = Application.SldWorks7 O' s& l- }9 _. }8 v
Set Part = swApp.ActiveDoc: ^/ g7 _" Z: e0 C
CurCFGname = Part.GetConfigurationNames" F! B/ u$ p- c# f
CurCFGnameCount = Part.GetConfigurationCount) v2 ^& E( ?4 n
For i = 0 To CurCFGnameCount - 1
2 J; |* g' j9 j! z! y5 z1 E/ r7 J
Set CusPropMgr = Part.Extension.CustomPropertyManager(CurCFGname(i)); u) r4 n2 p. Y$ s: }+ T/ j
Vnamearr = CusPropMgr.GetNames
- N/ W, ]$ E) S* \& v
If Not IsEmpty(Vnamearr) Then# V% h5 q ` r6 K/ }( O& F- Q
For Each Vnamearr2 In Vnamearr6 y4 G# f3 }5 G
bRet = Part.DeleteCustomInfo2(CurCFGname(i), Vnamearr2)6 D9 v1 F1 [! _% {
Next; _) ], l9 s. v9 C
End If
2 H9 y0 I$ F7 Y9 l' ~/ X
Next1 O3 V# K) x' w& U- Y% x
Call 刉壺赻隅砱扽俶 '(刪除自定義屬性)
/ b1 b. r( ~0 c H+ _2 I
Call partitionTM6 ^! a% K# _8 e c9 g) z
: U3 f" c) h8 A
End Sub/ g3 c! h; D/ h1 s, P
! s& H$ S+ C. }5 }3 I
'~~~ 刉壺赻隅砱扽俶 ~~~+ M% E+ f9 I1 A+ o/ o
Sub 刉壺赻隅砱扽俶() '(刪除自定義屬性)* G! W; X5 w% f; a
'Dim swApp As Object0 N8 G {: N/ A9 Z& ^- O- a5 e3 p
Dim swModel2 As SldWorks.ModelDoc2
' f: a/ z' I4 Y0 c5 ^
Dim vCustInfoNameArr2 As Variant$ i& I( O& v# f" I0 s3 x! ^" V
; }8 F7 s4 _: x" B$ s8 ?
Set swApp = Application.SldWorks
4 }9 [( _0 d5 K& j+ `+ a
Set swModel2 = swApp.ActiveDoc
8 a0 f# d( [; j/ Z$ I4 ^
vCustInfoNameArr2 = swModel2.GetCustomInfoNames
, v( |1 K; F& O+ S1 O
If Not IsEmpty(vCustInfoNameArr2) Then
- v6 M0 I2 M, X1 j. c% X
For Each vCustInfoName2 In vCustInfoNameArr2
0 U o+ v! m) {. |" W8 f
bRet = swModel2.DeleteCustomInfo(vCustInfoName2)8 g8 [; F7 a+ s7 I- V) J
Next
. U: e6 X/ c7 d- L" S
End If
7 I) o9 F$ u4 w! c% R; p; q
End Sub( T/ M% w& R+ C' Y
8 S# D+ }- R6 b
'~~~ partitionTM ~~~. `2 K# w0 O3 y2 W, p I* H4 y. M
Sub partitionTM() 'partitionTM
5 }" O8 m& L8 A# E
& e' G* H( W5 L6 I
'link solidworks6 h( @& g. g$ x. J: x/ U7 T' q
Set swApp = Application.SldWorks8 K5 U* z6 L% x/ h; e( C( q: ^. i
Set Part = swApp.ActiveDoc
8 U/ P. D/ K# H! J5 \ T `
Set SelMgr = Part.SelectionManager, j- n) _2 c7 J
swApp.ActiveDoc.ActiveView.FrameState = 1
; j z# F6 t' \) m: [4 w% O, _* q
'扢隅曹講
* G$ T% c6 a( ~4 _' V1 R3 _
c = swApp.ActiveDoc.GetTitle() '錨璃靡
6 g' \" |* d6 _! F. a4 n8 v$ q4 C
strmat = Chr(34) + Trim("SW-Material" + "@") + c + Chr(34)
0 o: A G5 f* C9 i$ m, ?; i
'tempvalue = Part.CustomInfo2("", "第蹋")" O; g3 h2 w7 Y1 I8 r
blnretval = Part.DeleteCustomInfo2("", "測瘍")
% o; F) ?5 m6 s* W% d
blnretval = Part.DeleteCustomInfo2("", "靡備")
2 P* V U# m" ^ |$ q+ u
blnretval = Part.DeleteCustomInfo2("", "第蹋")1 R* B7 P) }& c) Q. ~
a = InStr(c, " ") - 18 |- f" o! K! o0 m/ ]" Q6 q& g3 I
If a > 0 Then: d6 P3 X1 n+ j b+ s
k = Left(c, a)
. D$ ~; m1 q5 J$ Q
t = Left(LTrim(e), 3)9 M8 P& m; L& ~. N
If t = "GBT" Then. L; K( j* f& l7 G+ |
e = "GB/T" + Mid(k, 4). r5 X% I6 g: X$ i4 z+ ?7 s+ U2 P
Else- D' o8 v5 R; r0 e2 L
e = k& `4 D+ q6 z) B1 P$ | N$ j
End If9 K2 k z$ l1 H( W O! w. f
b = Mid(c, a + 2)
2 J( G. I+ L( p- \8 f6 b" ]
t = Right(c, 7)
9 Q% L) T# @8 V( J
If t = ".SLDPRT" Or t = ".SLDASM" Then
1 p% p& H* A9 @- s
j = Len(b) - 7
' O& i* a( ~/ G6 w" _
Else
; e! ^8 Z4 K, w0 }: [
j = Len(b)# A& U* T, M' R% I8 k
End If
% R/ m0 K8 r) \8 Y' g$ {
m = Left(b, j)4 B& P+ x7 J3 S+ O) R
End If) ?, h% e- c: Q: t' T) U
blnretval = Part.AddCustomInfo3("", "測瘍", swCustomInfoText, e)2 y9 ?2 Q6 b& K3 B9 m u% o# z
blnretval = Part.AddCustomInfo3("", "靡備", swCustomInfoText, m)
( w3 J! y, i0 b$ b3 S. y
blnretval = Part.AddCustomInfo3("", "第蹋", swCustomInfoText, strmat)) {3 K" w5 C7 ^0 j. \& E
blnretval = Part.AddCustomInfo3("", "等笭", swCustomInfoText, " ")3 m% W& x/ Q' N9 J% F; }
blnretval = Part.AddCustomInfo3("", "掘蛁", swCustomInfoText, " ")! R4 L; @: u2 ^
% j5 X- \' Q. i! R
End Sub" i" _6 o* Z2 o' B5 Y

復(fù)制代碼

arter_2006 · 發(fā)表于 2018-11-24 15:28:59

本帖最后由 arter_2006 于 2018-11-24 15:30 編輯

ryouss 發(fā)表于 2018-11-24 13:453 U5 q% d' _* b3 @3 w, ~; V. [
[Run main() 試試!]

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

ryouss · 發(fā)表于 2018-11-24 16:13:31

arter_2006 發(fā)表于 2018-11-24 15:28
- l3 p S- _0 a) T能否把您改后的swp文件上傳上來,？
7 [' T* U" c, M5 C! C3 R非常感謝您的指點(diǎn)，上面的內(nèi)容從網(wǎng)頁上復(fù)制,、黏貼到寫字板或宏文件里 ...

遠(yuǎn)祥 · 發(fā)表于 2018-11-24 17:41:46

在原來的基礎(chǔ)上改會(huì)方便一些。

arter_2006 · 發(fā)表于 2018-11-25 09:12:54

以下是我改過的宏,，不知道哪里出了問題,？附件壓縮包是寫字板格式的。
' ******************************************************************************
' 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 · 發(fā)表于 2018-11-25 10:28:57

本帖最后由 ryouss 于 2018-11-25 10:59 編輯

arter_2006 發(fā)表于 2018-11-25 09:12* y2 s, v: {7 Z$ T: I) X
以下是我改過的宏，不知道哪里出了問題,？附件壓縮包是寫字板格式的,。4 v" D; g0 I5 q" T' i. [4 L" t
' ******************************** ...

		自動(dòng)登錄	找回密碼
密碼			注冊會(huì)員

SOLIDWORKS 宏合并執(zhí)行的問題

本帖子中包含更多資源

本帖子中包含更多資源

本帖子中包含更多資源

本帖子中包含更多資源

本帖子中包含更多資源