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

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

是這樣的,，想做一個宏,，通過這個宏,，會先后調(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
/ ^1 ?* r) p5 ^參考

非常感謝您的指點，根據(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個宏有沒有問題，這三個宏單獨執(zhí)行的是沒問題的,。上面提到的,，就是想把附件壓縮包里的三個宏聯(lián)合執(zhí)行。

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

arter_2006 發(fā)表于 2018-11-24 12:53
1 K4 e( }4 {3 d0 M. w不知道3個宏有沒有問題，這三個宏單獨執(zhí)行的是沒問題的,。上面提到的,，就是想把附件壓縮包里的三個宏聯(lián)合執(zhí) ...

[Run main() 試試!]

' ******************************************************************************
0 z) }6 P. F% A* Y5 m" d- H0 Z
' C:\Users\admin\AppData\Local\Temp\swx8144\Macro1.swb - macro recorded on 11/22/18 by mqlu
$ K( t/ Y6 V4 [, _7 D7 H# I
' ******************************************************************************0 W8 ?3 c) |% J9 O/ H
Dim swApp As Object
0 g# B% b8 R& P
Dim Part As Object! k! O8 \: N- B$ m ? {6 b
Dim boolstatus As Boolean g( y% z! h c E- ]
Dim longstatus As Long, longwarnings As Long
Y, D, n# @" T6 C- K
2 I- l- l! h: W) y
Dim SelMgr As Object8 u. L3 a% d5 w
Dim Feature As Object3 U: x& t8 v6 n% e4 V
Dim a As Integer H, S* C$ p8 u
Dim b As String
- @1 }2 n4 C# ^2 p' T' Y' V
Dim m As String; Y& t, }/ ^* p2 e# q, C- V0 w
Dim e As String
2 H' q6 F$ u% z5 D# ]9 |" ^6 [
Dim k As String
; t, `# m8 h3 n
Dim t As String" X! V- N8 |( K. ^2 `
Dim c As String
/ c2 X: A, Z; l) K
Dim j As Integer
3 O7 s* u; S! B ]. Y% K( C, Z
Dim strmat As String' t+ L9 C; B7 i. C u
Dim tempvalue As String8 K* X4 j" L3 A0 {/ d' J
5 i/ w2 w3 K x' ]1 I1 C- m" g( n1 @
Sub main() '刉壺垀衄饜離扽俶(刪除所有配置屬性)* `( _* \* x7 ?: N2 G9 L
Set swApp = Application.SldWorks
, {- W- n1 H( F" F1 t/ H3 w
Set Part = swApp.ActiveDoc* N4 ?: x2 |9 k
CurCFGname = Part.GetConfigurationNames3 ]3 M+ _& C& [, J
CurCFGnameCount = Part.GetConfigurationCount! A# A6 j( m, `3 ]) ], S4 o! A) y
For i = 0 To CurCFGnameCount - 19 L- k4 y. s# ?% F9 T; K
Set CusPropMgr = Part.Extension.CustomPropertyManager(CurCFGname(i))$ M3 s" h& k$ C5 J6 J' q; m, p$ O% F
Vnamearr = CusPropMgr.GetNames3 A- i! n- f3 `8 Q
If Not IsEmpty(Vnamearr) Then1 Y+ Y6 J w Y% f; y' r% u
For Each Vnamearr2 In Vnamearr) z/ m( K1 {7 P% c
bRet = Part.DeleteCustomInfo2(CurCFGname(i), Vnamearr2)
8 @9 V2 |" q, w7 g; o) K
Next* F/ m" K+ [1 T, M3 V
End If: D% l5 a8 m \" P9 n- a
Next- h; `, g& g3 w0 R
Call 刉壺赻隅砱扽俶 '(刪除自定義屬性)# @3 F0 i9 x/ Z' Z2 y, r7 [4 i
Call partitionTM
6 C1 `/ W7 D" N1 Y& W0 s, E) W
End Sub
4 | A' |0 s2 I
/ F- F3 A9 D b" Z0 o
'~~~ 刉壺赻隅砱扽俶 ~~~
% j: p1 L- N' w2 z3 v* Q1 J4 q s
Sub 刉壺赻隅砱扽俶() '(刪除自定義屬性)
( v5 ]/ y) @1 O3 i' Q+ Z
'Dim swApp As Object
9 e: _0 a7 k: C3 O" {" M
Dim swModel2 As SldWorks.ModelDoc2
8 w: i3 v* w* p6 u% |, p
Dim vCustInfoNameArr2 As Variant5 L3 d/ p! z3 B
2 _- @) C4 f5 l
Set swApp = Application.SldWorks# W# q& h9 L2 `: T X" @
Set swModel2 = swApp.ActiveDoc3 Y7 ^- A: ?( u5 M$ k; ?
vCustInfoNameArr2 = swModel2.GetCustomInfoNames# k3 d5 s4 V) @5 K+ A
If Not IsEmpty(vCustInfoNameArr2) Then
' }! Y$ V+ \5 m
For Each vCustInfoName2 In vCustInfoNameArr2, X4 E3 j! b. Z1 B/ c
bRet = swModel2.DeleteCustomInfo(vCustInfoName2)
% W* ~& @1 Q) b* |% E1 w
Next
9 U6 U% U! F: k8 [8 p+ D# q( J
End If) K& f9 |) n' J
End Sub) u- K2 d* q* ^: {. \/ v
# S" C& O) [4 U
'~~~ partitionTM ~~~
6 F U! J2 s, M. m1 J j3 ^
Sub partitionTM() 'partitionTM
" u% }, N3 P/ s+ X1 X) x0 o
9 @, ~* W2 c. o7 ~5 N! p9 C. C
'link solidworks
+ C/ J z# O* ]1 Z
Set swApp = Application.SldWorks! k( w0 A) L' a0 d+ M6 |
Set Part = swApp.ActiveDoc; d. J- J: | }2 ?9 S; f# x6 K- X
Set SelMgr = Part.SelectionManager) N8 Y; K) V: F' ^' H. j
swApp.ActiveDoc.ActiveView.FrameState = 1$ m8 d0 j/ j6 [9 H1 h
'扢隅曹講. [2 x' p5 m, t4 @$ ~
c = swApp.ActiveDoc.GetTitle() '錨璃靡 `+ A4 e( s* Q
strmat = Chr(34) + Trim("SW-Material" + "@") + c + Chr(34)9 ?5 `: z. ^1 {/ z5 `
'tempvalue = Part.CustomInfo2("", "第蹋")
) [; A7 _% B0 K9 t S
blnretval = Part.DeleteCustomInfo2("", "測瘍"); Z7 F7 i* ?# Q' H2 S
blnretval = Part.DeleteCustomInfo2("", "靡備")/ K8 l1 T# J1 m
blnretval = Part.DeleteCustomInfo2("", "第蹋")& G% g* J0 B9 u0 ~% }* ^
a = InStr(c, " ") - 1
2 F+ ~, G0 v# |% f; r
If a > 0 Then2 b' O6 D5 @* G% f4 @" F
k = Left(c, a)
5 w: N/ S; u* B4 d6 c
t = Left(LTrim(e), 3)( k. b+ t$ `8 Q9 V2 L
If t = "GBT" Then: A8 I, A1 [7 E$ a
e = "GB/T" + Mid(k, 4)
, E) ?* X8 v; Q5 I* E# Z! F* h: r
Else
: F! C0 x% K& Z7 g: ^: e0 ?" u
e = k# P# G- h# F a! S" ]1 @) i9 p
End If/ U( ?& {5 ^7 e% X
b = Mid(c, a + 2)
0 S( }5 C" v" D) m! ~% ]& n/ Z
t = Right(c, 7)
/ f0 ~+ p' z/ z! O& v
If t = ".SLDPRT" Or t = ".SLDASM" Then
0 x3 y. q& x: z7 ]: Z4 _
j = Len(b) - 7
6 i1 I, `8 n7 T2 e0 ?1 |
Else
* M- w% j* Z: O& C
j = Len(b)
$ x- r% N. H0 v( Q: P3 C; H
End If( y6 P3 d: N2 F# ]
m = Left(b, j)/ t- c+ F+ H$ Y+ }0 V
End If* ^$ [) u+ u# u4 W( y( v( W
blnretval = Part.AddCustomInfo3("", "測瘍", swCustomInfoText, e)
2 u, q4 N7 T) K+ k% n. k
blnretval = Part.AddCustomInfo3("", "靡備", swCustomInfoText, m)* | n6 V6 T0 [
blnretval = Part.AddCustomInfo3("", "第蹋", swCustomInfoText, strmat)
+ Y P+ \, K( _5 g7 }. {
blnretval = Part.AddCustomInfo3("", "等笭", swCustomInfoText, " ")
. a I# z) _# A
blnretval = Part.AddCustomInfo3("", "掘蛁", swCustomInfoText, " ")1 [$ m+ R3 _1 E) @' Q
& F$ h4 ^+ z, C$ e w; A3 ~
End Sub" j. n: ~# `3 D* m

復制代碼

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

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

ryouss 發(fā)表于 2018-11-24 13:45
# k4 {- g6 q# c% f[Run main() 試試!]

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

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

arter_2006 發(fā)表于 2018-11-24 15:28, c% G8 V, F4 e' F
能否把您改后的swp文件上傳上來？
+ |1 C% R- c) W! u. u5 U非常感謝您的指點,，上面的內(nèi)容從網(wǎng)頁上復制,、黏貼到寫字板或宏文件里 ...

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

在原來的基礎上改會方便一些,。

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
, H8 i2 Y* `& m( |以下是我改過的宏,，不知道哪里出了問題？附件壓縮包是寫字板格式的,。0 I' r3 e: b# Y ^3 r1 C
' ******************************** ...

		自動登錄	找回密碼
密碼			注冊會員

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

本帖子中包含更多資源

本帖子中包含更多資源

本帖子中包含更多資源

本帖子中包含更多資源

本帖子中包含更多資源