关于SW宏程序

shengyz

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

fiyu1314

描述一下你的需求，

冷月梧桐

工程图下导出PDF+DWF，部分宏
9 f& X) n2 i# {5 bDim swApp           As SldWorks.SldWorks
: M0 \$ a/ y; Q- f6 @: B5 \Dim swModel         As SldWorks.ModelDoc2
7 ]3 O& L' G( f  v) _
Sub main()

Set swApp = Application.SldWorks
1 ?0 V* c* ?, l3 ^% u* N# [6 FSet swModel = swApp.ActiveDoc
$ s. h1 I0 ~2 \/ _
' Check to see if a drawing is loaded.
! G$ w4 T3 V. g+ o# BIf (swModel Is Nothing) Or (swModel.GetType <> swDocDRAWING) Then
7 Z5 ?7 _, e5 s4 K- i
1 J. P& n  S% A- \* M3 h3 B! d2 v9 wswApp.SendMsgToUser ("To be used for drawings only, Open a drawing first and then TRY!")

' If no model currently loaded, then exit
Exit Sub
" z8 I3 E7 C# \# q5 A2 `
End If

2 |. ^  ~' p1 S9 K  I0 HSet swDraw = swModel
Filepath = Left(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\"))

If Dir(Filepath & "导出图纸", vbDirectory) = "" Then ' Change Sub folder Name here
MkDir Filepath + "导出图纸" ' Change Sub folder Name here
1 l! x% ?8 C; |; A$ SEnd If
Filepath = Filepath + "导出图纸\" ' Change Sub folder Name here
+ g2 ?6 a* v1 k& ?8 g
/ ?' B5 ~1 D4 M9 y, m; h/ r# ]Set swCustPrpMgr = swModel.Extension.CustomPropertyManager("")
   swCustPrpMgr.Get3 "", False, "", Value 'Change here the var revision "Rev"
0 ]" T& F7 y2 n0 R" C# G: @
' O; k1 @' ?! Y; C2 tFileName = Mid(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\") + 1)
" _; j8 w; j) d9 u; wFileName = Left(FileName, Len(FileName) - 7) & "" & Value & ".pdf"
swDraw.SaveAs3 Filepath & FileName & "", 0, 0
. Z+ k# ^# s6 D2 ~
'-------------------------------------------------- SAVE DXF
) m# v. ^3 C, @" i
1 @2 p* a3 L" w0 w. g1 TSet swDraw = swModel
6 a6 c1 ~9 z+ {$ BFilepath = Left(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\"))
% r8 b3 F  S% Z, {5 FIf Dir(Filepath & "导出图纸", vbDirectory) = "" Then ' Change Sub folder Name here
$ _4 m, t+ i1 H. G2 Y. uMkDir Filepath + "导出图纸" ' Change Sub folder Name here
End If
Filepath = Filepath + "导出图纸\" ' Change Sub folder Name here
  k  W8 q6 H2 Z. u& m
Set swCustPrpMgr = swModel.Extension.CustomPropertyManager("")
5 N; x) t/ d' X6 h$ G   swCustPrpMgr.Get3 "", False, "", Value 'Change here the var revision "Rev"
# h: s. R# V# R! K$ y0 i; G: m: ^* Z, Y- c
3 I/ a2 p9 b) X; GFileName = Mid(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\") + 1)
FileName = Left(FileName, Len(FileName) - 7) & "" & Value & ".DXF"

swDraw.SaveAs3 Filepath & FileName & "", 0, 0

swDraw.Save

/ Q& f7 f, J& p9 W* e'swApp.ExitApp '关闭SW软件
! T: Q( k  A+ N' \8 V% YEnd Sub
& l+ M& F9 @/ N

; h0 N' j" P# M2 {' Q( u& a

大兄弟aa

宏怎么用都不知道

shengyz

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

3 M1 b9 o/ u* r很强大，可以了解了解
* }1 a( q' R. L: S" A7 u6 l2 Q& o

steve_suich

( P# V/ \% W! K# q2 c4 `) x
: ]$ t7 d) [( xDim swApp As Object
5 K. p, s' _. Y0 b; K: r3 q
Sub main()

- S5 T) I5 \. A& b( Y. R) D: [! `' z' ZSet swApp = Application.SldWorks
Set part = swApp.ActiveDoc
. ]+ y" M* _+ B3 I+ X9 \$ _2 l
( e% Z" ^# k8 l' l3 \# X: w( I  vIf part.GetType = 3 Then
/ u5 |9 `0 h9 x" i5 N+ ~6 U) Y
part.SaveAs (Left(part.GetPathName, InStrRev(part.GetPathName, "\")) & Left(part.GetTitle, Len(part.GetTitle) - 6) & ".PDF")
  
8 M) v, _7 q5 i+ s" t* @& NswApp.CloseDoc (part.GetTitle)
5 g6 W4 \0 Z2 q5 \7 \9 w4 w
( E5 w% t  P( a3 e2 ^2 ^) B' vEnd If
# Z  K0 a* D: }/ ^4 E4 q  
End Sub