关于SW宏程序

shengyz

昨天略微涉略SW宏程序，今天想整个一键出CAD及PDF的宏，奈何，不会设置宏读取图纸名称，再把红圈那设置成对应图纸名，以致出的CAD及PDF都是固定名称，有没有大佬知道咋先读取图纸名。感谢。
% ~7 F, ]3 j8 `4 p1 }! `: A; z& N

fiyu1314

描述一下你的需求，

冷月梧桐

工程图下导出PDF+DWF，部分宏
/ h# ^  S/ M: o9 U# nDim swApp           As SldWorks.SldWorks
: [* T) G) R( H6 `. o# I, [Dim swModel         As SldWorks.ModelDoc2
/ Y( a8 O) O' H
# s* d3 q5 V: e  cSub main()
+ h! d3 y+ o7 u8 D$ @* S, q+ _
Set swApp = Application.SldWorks
% Z3 k8 F1 y+ x' X6 rSet swModel = swApp.ActiveDoc
& J- ^* {6 @0 v  S: I1 F
% |" k' D. X" W- X' M' Check to see if a drawing is loaded.
+ x) @* c+ ]* ~' @) {If (swModel Is Nothing) Or (swModel.GetType <> swDocDRAWING) Then
# E% F5 s- v" x* \2 H. r
7 N' \1 U) @* J) x; O. m" o2 JswApp.SendMsgToUser ("To be used for drawings only, Open a drawing first and then TRY!")

0 C4 `( L+ ]* H& J* f' B( q' If no model currently loaded, then exit
Exit Sub

# t7 S. ]" K' H- q* u! @# z0 rEnd If

8 Z2 n* Q: B! B& z+ ^( bSet swDraw = swModel
1 O- T0 k( M6 ?$ Q9 n6 zFilepath = Left(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\"))
* n% U0 F8 C" V, }0 }/ L
If Dir(Filepath & "导出图纸", vbDirectory) = "" Then ' Change Sub folder Name here
MkDir Filepath + "导出图纸" ' Change Sub folder Name here
End If
5 W! p8 L6 V/ P" |Filepath = Filepath + "导出图纸\" ' Change Sub folder Name here
  V& V- m: B- h) Z, c" z7 h
Set swCustPrpMgr = swModel.Extension.CustomPropertyManager("")
9 v3 B* v% ?- J$ f' g; o# D   swCustPrpMgr.Get3 "", False, "", Value 'Change here the var revision "Rev"

FileName = Mid(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\") + 1)
9 y' E9 m: x3 |$ lFileName = Left(FileName, Len(FileName) - 7) & "" & Value & ".pdf"
6 w2 h, w3 h' H; o- ?8 uswDraw.SaveAs3 Filepath & FileName & "", 0, 0

0 R' v! g4 e0 R. m& ~' c% ~'-------------------------------------------------- SAVE DXF

Set swDraw = swModel
Filepath = Left(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\"))
* h# C4 w. `& \* JIf Dir(Filepath & "导出图纸", vbDirectory) = "" Then ' Change Sub folder Name here
+ `2 k, w' e, f" A4 h/ i2 rMkDir Filepath + "导出图纸" ' Change Sub folder Name here
End If
, U. u6 U( k4 [Filepath = Filepath + "导出图纸\" ' Change Sub folder Name here

Set swCustPrpMgr = swModel.Extension.CustomPropertyManager("")
   swCustPrpMgr.Get3 "", False, "", Value 'Change here the var revision "Rev"
% [# r$ o6 W& O& `# y% O
FileName = Mid(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\") + 1)
FileName = Left(FileName, Len(FileName) - 7) & "" & Value & ".DXF"

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

. m$ e3 T+ ?1 J1 fswDraw.Save
2 f$ O9 ]3 i" C: ]
% P) L, a7 W# H8 C' M* e6 ^, W; U'swApp.ExitApp '关闭SW软件
) q( G& C0 T% _, Q6 W% {  q/ QEnd Sub
5 f- R" P: `+ `6 t! z
: H- ]" ]  X, O! w

大兄弟aa

宏怎么用都不知道

shengyz

大兄弟aa 发表于 2024-3-21 15:42
: Q3 I: `/ Q, I宏怎么用都不知道

+ O* T& N2 K2 f8 m" l3 D" [7 }很强大，可以了解了解
3 w0 t4 }+ ?9 Z2 k5 a

steve_suich

0 J) k1 C$ [' Q# R( v, f! ]
Dim swApp As Object
2 x( j" ~- a, e. O
  t  |' M3 j' B  j. HSub main()

Set swApp = Application.SldWorks
5 x: M2 f' m/ G7 J/ gSet part = swApp.ActiveDoc
; i; ^: V1 p" p" o: ?' `) }% }
' b1 A# M: A! k" aIf part.GetType = 3 Then
! ?0 B  F/ ?7 O0 i  U$ W. ]
part.SaveAs (Left(part.GetPathName, InStrRev(part.GetPathName, "\")) & Left(part.GetTitle, Len(part.GetTitle) - 6) & ".PDF")
# Y1 c; h& ^3 X" e; O8 t  
: e' Y( p9 |, \swApp.CloseDoc (part.GetTitle)
# L4 G, h2 r# w: L3 z7 u! u; Y) n
End If
  
5 K0 J% G3 r4 zEnd Sub