SOLIDWORKS 宏合并執行的問題

arter_2006 · 發表于 2018-11-23 12:41:43

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

ryouss · 發表于 2018-11-23 14:34:19

參考

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

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

arter_2006 · 發表于 2018-11-24 12:51:08

ryouss 發表于 2018-11-23 14:34
O+ I) M4 m+ I |參考

非常感謝您的指點，根據我的淺薄理解，我的宏如下，但不起作用：
' ******************************************************************************
' 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:47

不知道3個宏有沒有問題，這三個宏單獨執行的是沒問題的。上面提到的，就是想把附件壓縮包里的三個宏聯合執行。

ryouss · 發表于 2018-11-24 13:45:49

arter_2006 發表于 2018-11-24 12:53" [" e) s% k- a! u8 D$ j8 l" g R
不知道3個宏有沒有問題，這三個宏單獨執行的是沒問題的。上面提到的，就是想把附件壓縮包里的三個宏聯合執 ...

[Run main() 試試!]

' ******************************************************************************
& L# a# d2 F; m
' C:\Users\admin\AppData\Local\Temp\swx8144\Macro1.swb - macro recorded on 11/22/18 by mqlu
( D& N# E; j4 \ p8 h7 g. X i4 M
' ******************************************************************************- Y& d4 Q e5 R' b+ q2 `6 v4 E7 S! f
Dim swApp As Object
$ d9 V( A8 K* I" K% M
Dim Part As Object8 F* |) r, I& t/ y. H1 b
Dim boolstatus As Boolean: h4 `7 Q5 p7 n7 W% B+ x" `
Dim longstatus As Long, longwarnings As Long
! J% V5 u# `6 [) R" z, o
" @4 t O4 {/ d$ c
Dim SelMgr As Object2 l4 v4 i* n: S m G1 p
Dim Feature As Object
. w( t6 f5 h! q2 W4 G/ } S) |
Dim a As Integer
( n( Y( J g. K: e
Dim b As String- [( o4 M4 e5 R i% ?
Dim m As String% e, o0 b5 Q, q7 Z% A
Dim e As String
6 |; x6 O6 y! l/ I$ [
Dim k As String# l% {$ N/ @, s! d1 ]) I2 D
Dim t As String
+ }' p1 [( J. p0 t: c
Dim c As String
+ r# \8 X4 O1 c7 W
Dim j As Integer7 }3 Z% T+ o& K; D `3 `8 n
Dim strmat As String4 \! o$ w0 C7 I C2 a6 I
Dim tempvalue As String
w) Z7 x: |& u" J
+ c: y) }5 B5 l( u4 i2 U
Sub main() '刉壺垀衄饜離扽俶(刪除所有配置屬性)& F+ v* x9 X5 m ]$ @. }
Set swApp = Application.SldWorks+ [5 s; ?3 }* @1 j; j
Set Part = swApp.ActiveDoc5 i4 _7 X0 g, M6 i: U
CurCFGname = Part.GetConfigurationNames
. D4 m4 y& ]3 D
CurCFGnameCount = Part.GetConfigurationCount
7 o) B$ Z( `7 f- B. z/ I
For i = 0 To CurCFGnameCount - 1; o4 w# v i T8 M; m* q; w. J
Set CusPropMgr = Part.Extension.CustomPropertyManager(CurCFGname(i))
) y& [8 X% A0 `9 H
Vnamearr = CusPropMgr.GetNames
0 T$ D: F a7 Z9 g5 F" [
If Not IsEmpty(Vnamearr) Then' {4 P1 ?) {: g3 T& q% v2 O2 _
For Each Vnamearr2 In Vnamearr) v' X9 K. Z7 m1 b; s8 t, C
bRet = Part.DeleteCustomInfo2(CurCFGname(i), Vnamearr2)
" Z% n# t# J& ]# u X
Next
2 k$ _0 L5 S$ J: z0 g; a% F' K9 s! p
End If; j* P% |! j+ D+ F l. f3 `; _6 }7 \
Next5 u7 r, x5 R8 C
Call 刉壺赻隅砱扽俶 '(刪除自定義屬性)7 R% A- P$ n' H: @/ e
Call partitionTM5 [' g# N4 M0 P/ [( ?1 ]& b
5 r0 }8 D/ Q& c5 _# k
End Sub
# g" O1 j3 z% m6 L5 P; I+ ]
; i. |5 |+ V* H f
'~~~ 刉壺赻隅砱扽俶 ~~~4 i1 }! y) b( R1 g/ l7 ~' w
Sub 刉壺赻隅砱扽俶() '(刪除自定義屬性)8 V; h2 `4 `) i. t8 J" T, F
'Dim swApp As Object
: {# o4 ?1 E/ ?$ e% f
Dim swModel2 As SldWorks.ModelDoc2
l y2 i$ e3 o7 [+ c( K) S; M) K
Dim vCustInfoNameArr2 As Variant
+ b: O8 W; J( j
9 F5 X4 q3 X4 a
Set swApp = Application.SldWorks
/ \# R% `( c8 \7 | m1 V; Y$ Q
Set swModel2 = swApp.ActiveDoc
% _2 T: j% s; g" Y n
vCustInfoNameArr2 = swModel2.GetCustomInfoNames
( W/ |/ ?. F+ a1 T" s$ X
If Not IsEmpty(vCustInfoNameArr2) Then. S3 a; `# ]. G) W! M9 H
For Each vCustInfoName2 In vCustInfoNameArr2
. ^% B$ j1 N# T* b: a6 Z* H- D; k3 r
bRet = swModel2.DeleteCustomInfo(vCustInfoName2); V, p& x1 f, @- I* H0 u' T8 v2 W
Next5 q) ]) |. V4 L* p; c2 I* j3 n
End If6 w7 p4 x" I5 ` j6 q$ K. R% ]6 ^
End Sub
- [2 e' V7 H3 _3 b
" }4 x `' w7 U) T6 D7 _
'~~~ partitionTM ~~~. v, U" ?5 `& p) y. r$ @
Sub partitionTM() 'partitionTM
( A0 Z2 N$ _0 Y$ _* a# s
! S! f+ c8 Q# V! @( W5 r7 m
'link solidworks. Q4 a b, {0 P+ V# }
Set swApp = Application.SldWorks
' g& b. |. j4 [# A+ j0 d
Set Part = swApp.ActiveDoc
: K V h' c! ~6 V& ?
Set SelMgr = Part.SelectionManager
- S1 n/ M; p2 Q6 O
swApp.ActiveDoc.ActiveView.FrameState = 1
3 H q) N) n' P& n, E8 O
'扢隅曹講9 `8 L, O# o, B* R0 H' X2 E6 M
c = swApp.ActiveDoc.GetTitle() '錨璃靡
& X7 s/ A1 I' x# G
strmat = Chr(34) + Trim("SW-Material" + "@") + c + Chr(34)
# Z+ b$ {: k5 i, H6 Z9 F$ |. h/ |; D
'tempvalue = Part.CustomInfo2("", "第蹋")* O! k; r P- A- I* U8 I% o N
blnretval = Part.DeleteCustomInfo2("", "測瘍")- r0 V( }) }6 {! G. k. o2 `( z
blnretval = Part.DeleteCustomInfo2("", "靡備")
" U& c; E$ X8 |2 ~6 a
blnretval = Part.DeleteCustomInfo2("", "第蹋")
) c3 A& M, l. W
a = InStr(c, " ") - 1" [6 n0 I' }& @/ ?, \5 Y* R0 Q
If a > 0 Then# L! N5 a) F( b1 X( p* |9 U1 z
k = Left(c, a)
h4 }4 c8 T! r
t = Left(LTrim(e), 3)
, v E, T. B( f7 D& c
If t = "GBT" Then6 V- M; W9 V. m0 U, K% ?
e = "GB/T" + Mid(k, 4)
" C/ V& O3 A3 R7 A0 b# B1 Q" o
Else9 g; d6 [9 o U. s! | w' F3 u
e = k
! s$ m: i: Q9 g- \
End If, T8 t: O% L2 A0 I4 U
b = Mid(c, a + 2), P; P9 P) D, Y0 R# D) Z/ Y
t = Right(c, 7)2 a h" W9 }3 c* ?" Z
If t = ".SLDPRT" Or t = ".SLDASM" Then
0 j' S6 F" Q" C
j = Len(b) - 7+ C2 f r8 `; i G
Else5 P) ~7 S( u" E+ @& d! O
j = Len(b)( k4 t$ {$ l: n7 z, r2 L! K& r) [; c: W
End If
$ f1 u7 r7 V# c) M% h: g
m = Left(b, j)% X0 Y# ^5 W. I
End If
, c' F* z* k) I9 }8 b
blnretval = Part.AddCustomInfo3("", "測瘍", swCustomInfoText, e)! |. J0 d2 ~2 U6 ?
blnretval = Part.AddCustomInfo3("", "靡備", swCustomInfoText, m)
1 I, I1 ~2 \) X8 }2 g
blnretval = Part.AddCustomInfo3("", "第蹋", swCustomInfoText, strmat)
1 n& r& d4 q3 E+ X
blnretval = Part.AddCustomInfo3("", "等笭", swCustomInfoText, " ")9 P! t0 X* N3 f: N( y
blnretval = Part.AddCustomInfo3("", "掘蛁", swCustomInfoText, " ")9 w* e4 h. X t& I8 s8 [' [
& s9 U/ \' N1 V( \8 U" n2 X
End Sub8 |4 F" b* l' J' t7 H2 V! I* k

復制代碼

arter_2006 · 發表于 2018-11-24 15:28:59

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

ryouss 發表于 2018-11-24 13:45
$ ~( |" v6 n/ T Z/ v* j, t[Run main() 試試!]

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

ryouss · 發表于 2018-11-24 16:13:31

arter_2006 發表于 2018-11-24 15:28
8 H, L; n8 i+ M- w+ L5 ~能否把您改后的swp文件上傳上來？
( k, n7 W) E" j `* S" N非常感謝您的指點，上面的內容從網頁上復制、黏貼到寫字板或宏文件里 ...

遠祥 · 發表于 2018-11-24 17:41:46

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

arter_2006 · 發表于 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 · 發表于 2018-11-25 10:28:57

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

arter_2006 發表于 2018-11-25 09:12 C7 s: w6 X; v) z L
以下是我改過的宏，不知道哪里出了問題？附件壓縮包是寫字板格式的。8 G9 d% x2 b; `5 t# t% f- H# M
' ******************************** ...

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

国产日韩欧美久久久精品图片|国产综合有码无码中文字幕|国产一区二区综合视频|国产亚洲精品电影网站在线观看|国产精品一区在线

SOLIDWORKS 宏合并執行的問題

本帖子中包含更多資源

本帖子中包含更多資源

本帖子中包含更多資源

本帖子中包含更多資源

本帖子中包含更多資源