關于SW宏程序

shengyz

昨天略微涉略SW宏程序，今天想整個一鍵出CAD及PDF的宏，奈何，不會設置宏讀取圖紙名稱，再把紅圈那設置成對應圖紙名，以致出的CAD及PDF都是固定名稱，有沒有大佬知道咋先讀取圖紙名。感謝。
" y' G, t# P+ g+ U0 o

fiyu1314

描述一下你的需求，

冷月梧桐

工程圖下導出PDF+DWF，部分宏
Dim swApp           As SldWorks.SldWorks
Dim swModel         As SldWorks.ModelDoc2

Sub main()
5 `3 r* Q  G% H8 C- P$ f1 C/ M
  z* c8 x# ~1 BSet swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
0 T# |8 M9 a; z
! s, o% H& L; w' Check to see if a drawing is loaded.
If (swModel Is Nothing) Or (swModel.GetType <> swDocDRAWING) Then
' L$ P1 v' o9 N; V, M) ?
swApp.SendMsgToUser ("To be used for drawings only, Open a drawing first and then TRY!")
0 o) @, r4 m6 V: s' L, b- [( L3 k
9 s4 [! ?+ l- s' U" B6 m& k- g9 I' If no model currently loaded, then exit
' o* ^" t0 t6 N5 q' }5 Z/ d3 U7 @+ AExit Sub
8 S8 [7 q3 y3 G9 h# O
0 g) D' T1 O' \; L5 E. tEnd If
/ ^( p9 S! o: Q
! b& N9 [. }; ZSet swDraw = swModel
0 I9 T7 i( |1 P' S7 i6 K' @& x' ZFilepath = Left(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\"))
5 E) D8 O- w) b( t+ R( r1 |5 r* r% _
7 P# ^/ k' Y( Y$ k- oIf Dir(Filepath & "導出圖紙", vbDirectory) = "" Then ' Change Sub folder Name here
9 H! g  g( w) c0 w9 M8 Z6 eMkDir Filepath + "導出圖紙" ' Change Sub folder Name here
1 ]. k! `& l% q  tEnd If
4 f" [8 h( W2 o3 t6 RFilepath = Filepath + "導出圖紙\" ' Change Sub folder Name here
! F: R9 F! R/ E0 |: i* Z
Set swCustPrpMgr = swModel.Extension.CustomPropertyManager("")
/ q* e) p' _) }# a5 M. c3 w   swCustPrpMgr.Get3 "", False, "", Value 'Change here the var revision "Rev"

- ]4 X) B- i1 N* d- i( P' I2 BFileName = Mid(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\") + 1)
FileName = Left(FileName, Len(FileName) - 7) & "" & Value & ".pdf"
/ J& m) R* k! x$ o8 [swDraw.SaveAs3 Filepath & FileName & "", 0, 0

'-------------------------------------------------- SAVE DXF
) v8 j1 Y& n1 O' t& c' c
" g& w  \" S$ z/ A2 B1 xSet swDraw = swModel
1 C1 G  H+ t8 AFilepath = Left(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\"))
If Dir(Filepath & "導出圖紙", vbDirectory) = "" Then ' Change Sub folder Name here
MkDir Filepath + "導出圖紙" ' Change Sub folder Name here
/ {- ^6 ?+ o6 j9 N: {! G  M8 TEnd If
4 E) p7 ]5 L( {" oFilepath = Filepath + "導出圖紙\" ' Change Sub folder Name here
1 L2 ?. O3 |7 e6 N" K7 g
Set swCustPrpMgr = swModel.Extension.CustomPropertyManager("")
* Y0 q9 _+ {: K+ p( M+ W! }% _( ?   swCustPrpMgr.Get3 "", False, "", Value 'Change here the var revision "Rev"
+ x2 o: t! T5 l- p0 c
& i! J+ R+ ?) H, C: f$ H" RFileName = Mid(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\") + 1)
FileName = Left(FileName, Len(FileName) - 7) & "" & Value & ".DXF"

& Z; ~$ Z  y# U7 s: DswDraw.SaveAs3 Filepath & FileName & "", 0, 0

swDraw.Save

* p: \- F4 l$ s" w'swApp.ExitApp '關閉SW軟件
End Sub


) i; D5 Y2 ?( g( h* H4 ?$ J

大兄弟aa

宏怎么用都不知道

shengyz

大兄弟aa 發表于 2024-3-21 15:42
: c9 l' R9 X: G  w5 _宏怎么用都不知道

很強大，可以了解了解
8 v% ?, r# w; }1 w3 [! H

steve_suich

4 [5 U7 y0 O5 ~9 U! l% f' wDim swApp As Object
) G  E0 {: {3 [5 u- v" U
Sub main()

Set swApp = Application.SldWorks
Set part = swApp.ActiveDoc
/ T+ o1 J0 K1 i7 S0 \7 T( f% K
If part.GetType = 3 Then

part.SaveAs (Left(part.GetPathName, InStrRev(part.GetPathName, "\")) & Left(part.GetTitle, Len(part.GetTitle) - 6) & ".PDF")
  
swApp.CloseDoc (part.GetTitle)

4 t, t" \! g7 R8 iEnd If
3 {& m2 F6 L) A4 b  
End Sub