关于SW宏程序

shengyz

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

fiyu1314

描述一下你的需求，

冷月梧桐

工程图下导出PDF+DWF，部分宏
Dim swApp           As SldWorks.SldWorks
5 ?/ O) _5 V6 \Dim swModel         As SldWorks.ModelDoc2

0 t' ~3 k, q, F0 N4 n! _Sub main()
) [9 ]+ y6 O6 ]) R+ Q/ Z: ^
Set swApp = Application.SldWorks
4 d$ y6 e. l3 ~$ c3 b0 U7 uSet swModel = swApp.ActiveDoc
+ Y- |; n# F$ i% n
2 c( j+ Y) `. C) c3 f7 |% A0 b7 |6 ?# {: O' Check to see if a drawing is loaded.
If (swModel Is Nothing) Or (swModel.GetType <> swDocDRAWING) Then
! e' f0 M! I0 |8 c! R4 c
" v' u5 ]+ _( ?0 vswApp.SendMsgToUser ("To be used for drawings only, Open a drawing first and then TRY!")
; u3 w$ K: d7 p6 t) t/ n
8 [; {, b' @2 M% X- B; z' If no model currently loaded, then exit
  E/ J9 ~; s$ wExit Sub
9 |; K6 }4 \- V0 e) n  x- _7 H
3 f# A3 _; E4 P6 kEnd If

Set swDraw = swModel
Filepath = Left(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\"))
! \. \9 e! k$ k
$ v. {& M& q4 y* X0 ?+ EIf Dir(Filepath & "导出图纸", vbDirectory) = "" Then ' Change Sub folder Name here
: T+ R" y0 J& K# u$ K8 s' h! ]MkDir Filepath + "导出图纸" ' Change Sub folder Name here
End If
) q) p# q3 c# `  a) E2 }9 ]Filepath = Filepath + "导出图纸\" ' Change Sub folder Name here
& y. W9 B; U" M2 A( ~( c
3 `- K2 C9 Q4 H; _Set swCustPrpMgr = swModel.Extension.CustomPropertyManager("")
   swCustPrpMgr.Get3 "", False, "", Value 'Change here the var revision "Rev"
( M! @, h3 O  ~( F8 o- C$ w
( K' x2 G. Q6 }( y6 PFileName = Mid(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\") + 1)
FileName = Left(FileName, Len(FileName) - 7) & "" & Value & ".pdf"
swDraw.SaveAs3 Filepath & FileName & "", 0, 0

'-------------------------------------------------- SAVE DXF
) O/ c& Q5 s2 V. ?* U
Set swDraw = swModel
: p" Y7 b- g- y# }! zFilepath = Left(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\"))
. D: I( S2 T2 y  O' G  o+ ^1 iIf Dir(Filepath & "导出图纸", vbDirectory) = "" Then ' Change Sub folder Name here
* y  c  N7 @. F/ ?MkDir Filepath + "导出图纸" ' Change Sub folder Name here
2 v1 }( t! I" k! ]7 s  J* L* V4 ]End If
Filepath = Filepath + "导出图纸\" ' Change Sub folder Name here

4 x9 K) l5 V/ W* L* H! ~: e7 |Set swCustPrpMgr = swModel.Extension.CustomPropertyManager("")
. m! w7 e6 o% P5 ?   swCustPrpMgr.Get3 "", False, "", Value 'Change here the var revision "Rev"
( j1 M' Y; V& L3 @, s
FileName = Mid(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\") + 1)
FileName = Left(FileName, Len(FileName) - 7) & "" & Value & ".DXF"

swDraw.SaveAs3 Filepath & FileName & "", 0, 0
, N+ D7 g$ l% E1 k6 {
* i8 O, P7 [6 `swDraw.Save
. C; d$ p/ ?! Q" m
'swApp.ExitApp '关闭SW软件
" V8 s: ^) r/ N: U9 c3 o  bEnd Sub

  D& ?' l# z5 T4 t

大兄弟aa

宏怎么用都不知道

shengyz

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

; O% @( g8 t/ N; g0 z很强大，可以了解了解

steve_suich

, W' D  D: u! P7 e3 [Dim swApp As Object

$ Y" F( M% k+ ~, h) {4 q8 ]1 X* RSub main()

Set swApp = Application.SldWorks
Set part = swApp.ActiveDoc
7 S* A) X" R9 ?; L# ^
# J$ b- Z# S$ H+ j% ]/ j  R, WIf part.GetType = 3 Then

/ U+ c; o) C3 v% g! e2 Mpart.SaveAs (Left(part.GetPathName, InStrRev(part.GetPathName, "\")) & Left(part.GetTitle, Len(part.GetTitle) - 6) & ".PDF")
  l6 N5 Z+ }4 k4 C  
  w% ^: z% X# x; ^9 }swApp.CloseDoc (part.GetTitle)

$ J2 V) r. X7 C6 REnd If
% t3 F$ P8 {# L1 o) K  
' _- r- e! _6 `# Z: @* N& i. u+ vEnd Sub