关于SW宏程序

shengyz

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

fiyu1314

描述一下你的需求，

冷月梧桐

工程图下导出PDF+DWF，部分宏
9 J7 z: r/ D( Y6 DDim swApp           As SldWorks.SldWorks
( `$ V4 p4 O9 `! m: X, ], ^0 QDim swModel         As SldWorks.ModelDoc2

+ A/ \6 G3 L6 t$ |$ pSub main()

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc

' Check to see if a drawing is loaded.
If (swModel Is Nothing) Or (swModel.GetType <> swDocDRAWING) Then

swApp.SendMsgToUser ("To be used for drawings only, Open a drawing first and then TRY!")

' If no model currently loaded, then exit
Exit Sub

' U7 D5 ]9 @( _& L' H6 o( D0 Q" O  rEnd If

8 X+ |( U! H/ G% fSet swDraw = swModel
Filepath = Left(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\"))
2 c' @: s( b  W9 d' d( `/ z
& u; Z& z+ V' J0 i! cIf Dir(Filepath & "导出图纸", vbDirectory) = "" Then ' Change Sub folder Name here
MkDir Filepath + "导出图纸" ' Change Sub folder Name here
End If
1 i' B& E3 `# Q% r. i1 a( NFilepath = Filepath + "导出图纸\" ' Change Sub folder Name here

Set swCustPrpMgr = swModel.Extension.CustomPropertyManager("")
% j) J9 x0 }" L4 N2 N! i5 l   swCustPrpMgr.Get3 "", False, "", Value 'Change here the var revision "Rev"
% z  M3 U6 w9 c8 Y0 j5 O8 I
FileName = Mid(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\") + 1)
FileName = Left(FileName, Len(FileName) - 7) & "" & Value & ".pdf"
% ?7 T. N7 Z% f2 zswDraw.SaveAs3 Filepath & FileName & "", 0, 0

'-------------------------------------------------- SAVE DXF
) j: {& b1 y2 M0 i, {. i1 [3 v' W
- x  {6 ^4 c( W. dSet swDraw = swModel
Filepath = Left(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\"))
If Dir(Filepath & "导出图纸", vbDirectory) = "" Then ' Change Sub folder Name here
' M4 B% T) V1 _4 b, P1 W: e1 DMkDir Filepath + "导出图纸" ' Change Sub folder Name here
) `6 ?6 n; [  m4 a  AEnd If
Filepath = Filepath + "导出图纸\" ' Change Sub folder Name here

Set swCustPrpMgr = swModel.Extension.CustomPropertyManager("")
7 T9 u- }$ N% B3 ]5 L$ o* W; s4 x   swCustPrpMgr.Get3 "", False, "", Value 'Change here the var revision "Rev"
: K* w  v; z% s$ s" E# {8 k
) C" C$ P) x5 X9 P) AFileName = Mid(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\") + 1)
FileName = Left(FileName, Len(FileName) - 7) & "" & Value & ".DXF"

4 |) F$ h: u4 v' |7 y# h$ U$ DswDraw.SaveAs3 Filepath & FileName & "", 0, 0
4 b; \9 K! E& P8 u0 a8 e3 R5 z
swDraw.Save

3 ~5 i1 R( t" R5 P' w'swApp.ExitApp '关闭SW软件
9 h% D! R$ Z9 F( _7 N* C! KEnd Sub

# k4 g* k+ a+ a" i1 h: g3 O

大兄弟aa

宏怎么用都不知道

shengyz

大兄弟aa 发表于 2024-3-21 15:42
, u4 n6 V9 C6 B6 Q2 `& m宏怎么用都不知道

很强大，可以了解了解
; v( D  Y, o/ `: E7 }6 o

steve_suich

: Z+ @2 K7 o# N; U- Q
! k- \/ V8 f4 i, W( W8 N: [Dim swApp As Object

Sub main()

; L) r# h8 j2 h( d$ CSet swApp = Application.SldWorks
7 m6 B( w$ Q% q! |! n- U% K& L+ bSet part = swApp.ActiveDoc
: P4 f. U, S) F5 h. g8 X  N3 T
" u4 j+ O8 D- Z/ e( M8 DIf part.GetType = 3 Then
- V& A* u3 H' l1 g/ A* w
7 O9 L$ J8 s; v6 ppart.SaveAs (Left(part.GetPathName, InStrRev(part.GetPathName, "\")) & Left(part.GetTitle, Len(part.GetTitle) - 6) & ".PDF")
0 ]1 b- D/ c& A2 b  
swApp.CloseDoc (part.GetTitle)
+ W3 Z" k, ]5 v' C7 `
. V' C2 A" N+ u" P4 h) [' Y) z$ cEnd If
  q5 w' J; D' ?; t+ G  
! u" @% v3 l. s+ \3 M, QEnd Sub