关于SW宏程序

shengyz

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

fiyu1314

描述一下你的需求，

冷月梧桐

工程图下导出PDF+DWF，部分宏
" M# c# ]% u2 _# A1 T9 Z) lDim swApp           As SldWorks.SldWorks
Dim swModel         As SldWorks.ModelDoc2

/ \3 K' U% W: C" I- B' A# oSub main()

Set swApp = Application.SldWorks
8 E# h/ L6 ?7 y' y7 ~( O9 Q3 iSet swModel = swApp.ActiveDoc

' Check to see if a drawing is loaded.
8 L) T" j  B$ @0 ^If (swModel Is Nothing) Or (swModel.GetType <> swDocDRAWING) Then
2 p) ^1 v/ ~, Z& H+ Y% X
5 a. F7 _9 ?4 f: B" SswApp.SendMsgToUser ("To be used for drawings only, Open a drawing first and then TRY!")

4 S( m" K; i9 l' K' If no model currently loaded, then exit
/ L& c" e7 V4 N  B" s6 ~& T% iExit Sub
  C/ d5 F9 S; `6 F' @; e  }/ K
" U+ x6 f, z! ]0 xEnd If

+ g+ m/ y4 M: z" ~* [$ ]( \Set 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
$ Q: C- E! D/ y, z5 q+ |6 nEnd If
5 r) b8 h! W" O8 PFilepath = Filepath + "导出图纸\" ' Change Sub folder Name here
( R/ O. I4 |4 ?3 }) A
- P- d6 J' Z$ V2 @- M+ W- ]$ }+ lSet swCustPrpMgr = swModel.Extension.CustomPropertyManager("")
   swCustPrpMgr.Get3 "", False, "", Value 'Change here the var revision "Rev"

  G2 R( h! C8 G. XFileName = Mid(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\") + 1)
0 b' y7 `/ x# q. q. `% C  BFileName = Left(FileName, Len(FileName) - 7) & "" & Value & ".pdf"
swDraw.SaveAs3 Filepath & FileName & "", 0, 0
- z2 i( o' U. }7 T6 B6 `; C
'-------------------------------------------------- SAVE DXF

Set 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
End If
Filepath = Filepath + "导出图纸\" ' Change Sub folder Name here
9 w3 a; _/ _% y% l+ \
7 ^8 q6 R" I8 U0 J, v  _3 LSet swCustPrpMgr = swModel.Extension.CustomPropertyManager("")
   swCustPrpMgr.Get3 "", False, "", Value 'Change here the var revision "Rev"
; y. [  ?+ q( x; C( F# F
FileName = Mid(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\") + 1)
* Q' U3 A' h9 M3 ^( c- d3 ?/ AFileName = Left(FileName, Len(FileName) - 7) & "" & Value & ".DXF"

) T" `; o/ u. ?/ k! r2 t+ QswDraw.SaveAs3 Filepath & FileName & "", 0, 0
8 p( x/ z& G" G/ c% n- }, c
swDraw.Save
' o8 o0 I% A1 @0 y- w& p# h% U% P
'swApp.ExitApp '关闭SW软件
End Sub
, }/ \7 j6 f0 y8 w
* P  s4 l- L6 z8 H

大兄弟aa

宏怎么用都不知道

shengyz

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

) K) M% n) C7 @% f4 _2 Y) ]5 X很强大，可以了解了解
4 f, O/ p$ a  E# T, J. S- m, _

steve_suich

7 U5 j& N. w+ m: C) kDim swApp As Object

Sub main()

Set swApp = Application.SldWorks
Set part = swApp.ActiveDoc
7 {" ]  \' ?2 p) C& v/ @
3 H8 b4 f  r, C* t) y6 {If part.GetType = 3 Then

4 M: d& O& ~+ m. G9 I+ j4 Tpart.SaveAs (Left(part.GetPathName, InStrRev(part.GetPathName, "\")) & Left(part.GetTitle, Len(part.GetTitle) - 6) & ".PDF")
  
( N0 [$ F. A( H4 s; z7 xswApp.CloseDoc (part.GetTitle)
$ K' k$ y# H% A. r3 j& u" w
" @! W6 a1 Z3 H$ m# rEnd If
6 y! \% `1 [, X* u  
End Sub