標題: 關于SW宏程序 [打印本頁] 作者: shengyz 時間: 2024-3-19 16:10 標題: 關于SW宏程序 昨天略微涉略SW宏程序，今天想整個一鍵出CAD及PDF的宏，奈何，不會設置宏讀取圖紙名稱，再把紅圈那設置成對應圖紙名，以致出的CAD及PDF都是固定名稱，有沒有大佬知道咋先讀取圖紙名。感謝。 ! b8 p$ [% @# X! e1 M; i$ T作者: fiyu1314 時間: 2024-3-19 19:29
描述一下你的需求，作者: 冷月梧桐 時間: 2024-3-19 23:35
工程圖下導出PDF+DWF，部分宏9 c! k' \, w) h, _1 S" e) o
Dim swApp As SldWorks.SldWorks2 h/ U+ e0 K C2 d
Dim swModel As SldWorks.ModelDoc2! \7 h; F6 H! V7 ?/ ~
1 d7 w1 a; d1 Z/ y9 u3 xSub main() $ R! f% Z& p/ ?- d x. O+ g2 M# e9 L( t: x
Set swApp = Application.SldWorks4 f+ F" q. b- w* Q
Set swModel = swApp.ActiveDoc) ~4 T# H$ }1 _- A
# M: s9 S" Y2 `( Q0 t2 |" s7 Y
' Check to see if a drawing is loaded. # m' c& r4 Z4 t9 g0 C* c* f4 HIf (swModel Is Nothing) Or (swModel.GetType <> swDocDRAWING) Then) [9 ^6 G& X5 I G
4 S. u* n8 ]( L9 I3 L
swApp.SendMsgToUser ("To be used for drawings only, Open a drawing first and then TRY!") 2 B1 ?' Y. Z- A5 m, K6 D, s( c2 \7 p
' If no model currently loaded, then exit4 x+ a4 T5 T* y% s3 N
Exit Sub ( { {1 d1 Y. ~3 I + e. _' {7 T: x7 \% S/ J/ xEnd If # V# z! D& T# X. O 2 Z4 j! F Y2 F3 E ZSet swDraw = swModel- @: j. U" R* }: H0 r q
Filepath = Left(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\")), j9 z7 ~8 K. f. t f6 v% [2 ]
3 S1 p; P! a* \' Q ~If Dir(Filepath & "導出圖紙", vbDirectory) = "" Then ' Change Sub folder Name here , n$ o1 V4 L. |MkDir Filepath + "導出圖紙" ' Change Sub folder Name here ' _ f, d' s! ?End If 1 r) L% e- N3 [Filepath = Filepath + "導出圖紙\" ' Change Sub folder Name here 9 c" A: w. R$ f3 r' `6 w) |9 f: u9 A7 Z0 O( v8 O% @3 F
Set swCustPrpMgr = swModel.Extension.CustomPropertyManager("")1 J7 u9 ~/ B8 U- ?: Y4 U. E" z+ E& {
swCustPrpMgr.Get3 "", False, "", Value 'Change here the var revision "Rev" ( x& B/ ~6 @) i$ D( c. O % K1 Q6 F- x3 ]. R& @5 m9 H* B0 ]FileName = Mid(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\") + 1)5 W2 @. u# J1 {7 z
FileName = Left(FileName, Len(FileName) - 7) & "" & Value & ".pdf"1 z) V3 a) Z% b5 \/ S+ G/ Q2 f
swDraw.SaveAs3 Filepath & FileName & "", 0, 0, W! f- z" O3 `- _# f, R* M
) K8 b2 u8 h. {, E6 }4 P- q
'-------------------------------------------------- SAVE DXF . z0 ~2 x5 R4 G- g8 [% f 5 R. [ |& E5 [3 s, u: `- KSet swDraw = swModel . u3 W8 g; E* t; @Filepath = Left(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\")) 6 u! B) ^& g6 r" C: O3 r$ n N( pIf Dir(Filepath & "導出圖紙", vbDirectory) = "" Then ' Change Sub folder Name here $ I: ~2 |+ G/ s6 A9 s* wMkDir Filepath + "導出圖紙" ' Change Sub folder Name here$ u0 c3 a2 M/ H' b: P0 V8 A
End If " H. E+ K$ J7 o% aFilepath = Filepath + "導出圖紙\" ' Change Sub folder Name here; z" |6 q) c" n; G8 |
( u. n9 F# f5 e2 q U( {' z/ k
Set swCustPrpMgr = swModel.Extension.CustomPropertyManager("")4 r) `3 n. Y7 |7 `1 ~- L/ a
swCustPrpMgr.Get3 "", False, "", Value 'Change here the var revision "Rev"8 u- H+ F* B5 q5 H
0 ^4 ?8 h* G: k9 X0 z/ U4 u2 c
FileName = Mid(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\") + 1) ! L+ j E- l5 e; O6 D! kFileName = Left(FileName, Len(FileName) - 7) & "" & Value & ".DXF"$ f" ?2 K( {7 Z" p8 C5 n
# p# N) v6 X' i9 ]7 Z0 RswDraw.SaveAs3 Filepath & FileName & "", 0, 0 . U" F$ ?, x5 [. q- S7 l) N: r( k8 b$ I" k
swDraw.Save : r( [+ J. J: ]+ n- i6 }$ U& y$ K6 [; k$ l4 p
'swApp.ExitApp '關閉SW軟件2 X: @2 H8 ?0 J; c
End Sub + X2 T& g2 c x% }% {. H7 t& k+ n2 j, v2 s0 D4 N* Z
& L7 Z$ m @: T8 N' g& O1 ]: h 作者: 大兄弟aa 時間: 2024-3-21 15:42
宏怎么用都不知道作者: shengyz 時間: 2024-3-21 16:26
