关于SW宏程序

shengyz

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

fiyu1314

描述一下你的需求，

冷月梧桐

工程图下导出PDF+DWF，部分宏
Dim swApp           As SldWorks.SldWorks
Dim swModel         As SldWorks.ModelDoc2
, L* J+ k( L! }6 F8 X6 E4 ?
Sub main()

3 J7 ]- u; I* B. s: k4 TSet swApp = Application.SldWorks
& s3 @9 T0 P3 iSet swModel = swApp.ActiveDoc

, z0 f8 ?8 o. J/ X/ Z0 y' Check to see if a drawing is loaded.
3 A& n! Q3 D, m5 T! o2 Q2 \8 vIf (swModel Is Nothing) Or (swModel.GetType <> swDocDRAWING) Then
7 D% V+ i' I  Z/ W- r! o
* e8 L+ ^' U& r' Y) jswApp.SendMsgToUser ("To be used for drawings only, Open a drawing first and then TRY!")
. j& _# B, r! m( U; t& |  B
! v$ U* K  ]' y9 {' If no model currently loaded, then exit
Exit Sub
" b" n: X' g, K
End If

Set swDraw = swModel
3 h' F) M2 X; b8 G. j, K- q: V- t7 ]Filepath = Left(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\"))

If Dir(Filepath & "导出图纸", vbDirectory) = "" Then ' Change Sub folder Name here
3 j! j& G9 p/ ~3 i: a; T6 W6 j% IMkDir Filepath + "导出图纸" ' Change Sub folder Name here
6 e' O. B. \- Y# Y7 A/ _0 IEnd If
* e9 a# d; z. eFilepath = Filepath + "导出图纸\" ' Change Sub folder Name here

Set swCustPrpMgr = swModel.Extension.CustomPropertyManager("")
, w2 a2 y- y# f) I6 v/ P   swCustPrpMgr.Get3 "", False, "", Value 'Change here the var revision "Rev"
' Q3 Y- F6 k6 j* b: C
) k/ J6 V1 E5 WFileName = Mid(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\") + 1)
FileName = Left(FileName, Len(FileName) - 7) & "" & Value & ".pdf"
) y% R9 q7 c" @2 T3 w6 OswDraw.SaveAs3 Filepath & FileName & "", 0, 0
5 R+ ]6 l3 K/ |* G
- |* R: v. m/ r* o& ^1 B# ^'-------------------------------------------------- SAVE DXF
9 Z. e8 Z3 a! G9 u4 e( ~
Set swDraw = swModel
* D2 M* I- X9 k. ?6 o! G3 S" lFilepath = Left(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\"))
If Dir(Filepath & "导出图纸", vbDirectory) = "" Then ' Change Sub folder Name here
6 w3 A* m9 a3 x; @MkDir Filepath + "导出图纸" ' Change Sub folder Name here
, }: X6 m7 w1 I* \End If
Filepath = Filepath + "导出图纸\" ' Change Sub folder Name here

7 q+ n; q1 y" \4 n5 F/ YSet swCustPrpMgr = swModel.Extension.CustomPropertyManager("")
   swCustPrpMgr.Get3 "", False, "", Value 'Change here the var revision "Rev"

FileName = Mid(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\") + 1)
FileName = Left(FileName, Len(FileName) - 7) & "" & Value & ".DXF"

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

, i6 i4 D$ n- F) f3 {; K4 EswDraw.Save

) Y/ T& k% B) K+ A) ~# c- ['swApp.ExitApp '关闭SW软件
End Sub

3 Q: c+ @. T5 B  p1 u$ I# H
" I; v& ?; n7 X0 R

大兄弟aa

宏怎么用都不知道

shengyz

大兄弟aa 发表于 2024-3-21 15:42
7 e- ^0 s$ s! g2 ~( b9 `6 G7 F' q宏怎么用都不知道

( F4 q: @" G6 _很强大，可以了解了解

steve_suich

1 S9 _5 ^# v8 u2 {
Dim swApp As Object

Sub main()

" B" A! C" T: g! [; u+ x' YSet swApp = Application.SldWorks
Set part = swApp.ActiveDoc

If part.GetType = 3 Then
3 f6 J  W* U  v: t5 F5 S7 {
part.SaveAs (Left(part.GetPathName, InStrRev(part.GetPathName, "\")) & Left(part.GetTitle, Len(part.GetTitle) - 6) & ".PDF")
% A0 G9 P7 s7 Q. {5 }+ J  
swApp.CloseDoc (part.GetTitle)
6 }9 V$ D: t3 T4 ]9 g# A: z
* v$ Y; E/ F: w% w9 a1 M9 U5 REnd If
  
9 E) s+ ~7 k: [4 Z" `End Sub