关于SW宏程序

shengyz

昨天略微涉略SW宏程序，今天想整个一键出CAD及PDF的宏，奈何，不会设置宏读取图纸名称，再把红圈那设置成对应图纸名，以致出的CAD及PDF都是固定名称，有没有大佬知道咋先读取图纸名。感谢。

fiyu1314

描述一下你的需求，

冷月梧桐

工程图下导出PDF+DWF，部分宏
/ f% a1 |7 a' V& s) y* GDim swApp           As SldWorks.SldWorks
; v9 [. R+ a& Y3 ]Dim swModel         As SldWorks.ModelDoc2

Sub main()
# {$ w! l) v2 S" ^1 s& V) r& b' f
5 E2 C- v8 r3 c/ G. iSet swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
6 i; ?2 T# M& K5 i& C  \2 Q
' Check to see if a drawing is loaded.
9 x8 U/ m* W1 kIf (swModel Is Nothing) Or (swModel.GetType <> swDocDRAWING) Then
8 f5 e/ \* z- f. l& E
swApp.SendMsgToUser ("To be used for drawings only, Open a drawing first and then TRY!")
$ U+ I$ J" ^. l- p8 L0 G4 b
' Q/ L% Y) Y8 Y% G- w' If no model currently loaded, then exit
Exit Sub
' @3 n5 w( W1 t  E
5 B/ i  h1 A' s! K, nEnd If
7 c! `0 L# t4 T) \8 A- b6 C
6 d8 B- A2 {- U' r+ u% _0 ~! RSet swDraw = swModel
4 {9 v/ V6 \% v4 a( ^Filepath = Left(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\"))

, l8 R3 i* j5 vIf Dir(Filepath & "导出图纸", vbDirectory) = "" Then ' Change Sub folder Name here
( [  f  @9 C5 zMkDir Filepath + "导出图纸" ' Change Sub folder Name here
End If
Filepath = Filepath + "导出图纸\" ' Change Sub folder Name here

- G" U. ^  G; wSet swCustPrpMgr = swModel.Extension.CustomPropertyManager("")
   swCustPrpMgr.Get3 "", False, "", Value 'Change here the var revision "Rev"

FileName = Mid(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\") + 1)
- s3 o; b9 [$ l, uFileName = Left(FileName, Len(FileName) - 7) & "" & Value & ".pdf"
2 I* ]4 ]( ~  l! W  E; D1 T+ lswDraw.SaveAs3 Filepath & FileName & "", 0, 0
& D7 e& z; ?9 a8 E1 d
'-------------------------------------------------- SAVE DXF
' f& |& _6 Z+ i6 a
* y: O: b7 M" U' q9 x$ j4 ~* [Set swDraw = swModel
Filepath = Left(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\"))
' A8 E' `/ X& QIf Dir(Filepath & "导出图纸", vbDirectory) = "" Then ' Change Sub folder Name here
MkDir Filepath + "导出图纸" ' Change Sub folder Name here
End If
Filepath = Filepath + "导出图纸\" ' Change Sub folder Name here

& h* V# n% A- S5 DSet swCustPrpMgr = swModel.Extension.CustomPropertyManager("")
   swCustPrpMgr.Get3 "", False, "", Value 'Change here the var revision "Rev"
0 Z% X( g4 C& w
$ k1 H2 ~" A5 k! m# s* o/ OFileName = Mid(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\") + 1)
1 x  W/ i5 ~) o* k$ ~FileName = Left(FileName, Len(FileName) - 7) & "" & Value & ".DXF"
+ @0 [; W  i& V( _8 z2 L6 ]
swDraw.SaveAs3 Filepath & FileName & "", 0, 0

/ ]/ Y5 ~7 P2 S* ^- D! j+ Y' F8 e9 qswDraw.Save
- v5 r. _( U2 |8 R. b& p& n
'swApp.ExitApp '关闭SW软件
* {$ v- o! z- }% IEnd Sub
& D) ^, n2 X! X
+ c$ s: l4 ^) h
6 B( ^' \. A, j

大兄弟aa

宏怎么用都不知道

shengyz

大兄弟aa 发表于 2024-3-21 15:42
宏怎么用都不知道

很强大，可以了解了解

steve_suich

Dim swApp As Object
$ Y4 y1 i9 Q! ^( Z
Sub main()
2 y- C" A% ?! [7 O. i& I
8 z% ?/ `9 V% |% `Set swApp = Application.SldWorks
Set part = swApp.ActiveDoc
+ w0 t9 C6 \3 M% T6 L
- [! ^* W5 s3 N- o% |- m% }6 jIf part.GetType = 3 Then

part.SaveAs (Left(part.GetPathName, InStrRev(part.GetPathName, "\")) & Left(part.GetTitle, Len(part.GetTitle) - 6) & ".PDF")
0 t9 c( ~. {' [5 S2 W3 U/ ~  
, u& {% }7 F& G$ A2 lswApp.CloseDoc (part.GetTitle)
3 W* h0 Y. [) g4 q3 h7 P& n2 Z
( y- s2 g+ c6 s6 m% A: {' R& mEnd If
: G4 X0 @7 S( g6 X+ v/ l  
End Sub