關(guān)于SW宏程序

shengyz

昨天略微涉略SW宏程序，今天想整個(gè)一鍵出CAD及PDF的宏，奈何，不會(huì)設(shè)置宏讀取圖紙名稱，再把紅圈那設(shè)置成對(duì)應(yīng)圖紙名，以致出的CAD及PDF都是固定名稱，有沒(méi)有大佬知道咋先讀取圖紙名。感謝。
3 }/ z) j; K, B+ Q1 W' D

fiyu1314

描述一下你的需求，

冷月梧桐

工程圖下導(dǎo)出PDF+DWF，部分宏
  R& U8 F" Y+ x* D( uDim swApp           As SldWorks.SldWorks
Dim swModel         As SldWorks.ModelDoc2
4 X0 |4 S% i1 L1 Y/ J
Sub main()
, e$ }# h# t9 r% C# p" a* T
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
, q6 Q$ N8 N6 v" z* `* e2 S
' Check to see if a drawing is loaded.
4 W0 b) S! ~5 v9 {8 [If (swModel Is Nothing) Or (swModel.GetType <> swDocDRAWING) Then

4 w; i" @' L4 f0 K5 iswApp.SendMsgToUser ("To be used for drawings only, Open a drawing first and then TRY!")
. {4 c: v, x, D! v- i
' If no model currently loaded, then exit
Exit Sub
$ R1 f' z6 w, N& ]. Q# e- B
  c7 |7 d! Q0 q) B. I+ ?4 mEnd If

3 n! B; w- K. o/ uSet swDraw = swModel
Filepath = Left(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\"))
  x# X5 H: X, [+ ]) f6 n% I
If Dir(Filepath & "導(dǎo)出圖紙", vbDirectory) = "" Then ' Change Sub folder Name here
6 {& Y" e4 c* V. @- \MkDir Filepath + "導(dǎo)出圖紙" ' Change Sub folder Name here
End If
' k$ ]1 T) ~# x, E1 q) [7 F! f4 yFilepath = Filepath + "導(dǎo)出圖紙\" ' Change Sub folder Name here

' `, Z0 S6 x, p1 N, a8 Z  BSet swCustPrpMgr = swModel.Extension.CustomPropertyManager("")
) V0 a. ^. B& t8 W* I& `! Y   swCustPrpMgr.Get3 "", False, "", Value 'Change here the var revision "Rev"

FileName = Mid(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\") + 1)
( I3 d6 \( P% M) i$ aFileName = Left(FileName, Len(FileName) - 7) & "" & Value & ".pdf"
swDraw.SaveAs3 Filepath & FileName & "", 0, 0
2 S) j  l# N$ O8 C
'-------------------------------------------------- SAVE DXF
9 j8 \( Q. O# \( \; Y+ w
Set swDraw = swModel
8 D+ r% w) _: `% f' g, d  h+ K  _Filepath = Left(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\"))
5 V' M' V/ A9 _: D" ?If Dir(Filepath & "導(dǎo)出圖紙", vbDirectory) = "" Then ' Change Sub folder Name here
MkDir Filepath + "導(dǎo)出圖紙" ' Change Sub folder Name here
End If
Filepath = Filepath + "導(dǎo)出圖紙\" ' Change Sub folder Name here
$ M4 M6 D6 v! h" a+ l7 T9 J! ^
3 Y; m/ P8 P" j8 e+ e9 F, @) K" |6 hSet swCustPrpMgr = swModel.Extension.CustomPropertyManager("")
, v/ w! T# W; K: k. g; ?   swCustPrpMgr.Get3 "", False, "", Value 'Change here the var revision "Rev"
/ b. L% L5 H  d
6 s. F2 |% |7 Q! P7 DFileName = Mid(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\") + 1)
FileName = Left(FileName, Len(FileName) - 7) & "" & Value & ".DXF"

swDraw.SaveAs3 Filepath & FileName & "", 0, 0
7 _- w% g! U" h5 q, X( y8 b1 i' m
swDraw.Save

'swApp.ExitApp '關(guān)閉SW軟件
/ G) q3 c  r+ B9 OEnd Sub
  ^# r2 [/ y! B- D7 a

* I4 N2 [# u- U) s

大兄弟aa

宏怎么用都不知道

shengyz

大兄弟aa 發(fā)表于 2024-3-21 15:42
宏怎么用都不知道

* |- L1 y0 y. T6 k很強(qiáng)大，可以了解了解

steve_suich

5 T$ D- h4 W( ~
Dim swApp As Object
1 g( i; c# w# o) F
Sub main()

# D2 t, o+ Q( r, g, ISet swApp = Application.SldWorks
  y+ r. [% L# {2 X( `8 B0 ISet part = swApp.ActiveDoc

: |" Z, S+ {7 |! Y0 gIf part.GetType = 3 Then
/ u1 |$ [7 l, b" G7 g! K
! I% U8 @- w3 z- y2 e# N: R8 {& bpart.SaveAs (Left(part.GetPathName, InStrRev(part.GetPathName, "\")) & Left(part.GetTitle, Len(part.GetTitle) - 6) & ".PDF")
  
swApp.CloseDoc (part.GetTitle)

End If
  
, k5 u2 E  u$ Y1 AEnd Sub