关于SW宏程序

shengyz

昨天略微涉略SW宏程序，今天想整个一键出CAD及PDF的宏，奈何，不会设置宏读取图纸名称，再把红圈那设置成对应图纸名，以致出的CAD及PDF都是固定名称，有没有大佬知道咋先读取图纸名。感谢。
6 f1 t8 Z: f# {3 \4 R5 l

fiyu1314

描述一下你的需求，

冷月梧桐

工程图下导出PDF+DWF，部分宏
/ ~! E& R7 a5 M! ?: T4 Y* Q5 A0 kDim swApp           As SldWorks.SldWorks
Dim swModel         As SldWorks.ModelDoc2

Sub main()

Set swApp = Application.SldWorks
) E) i0 J8 N9 Q. b  |  ~Set swModel = swApp.ActiveDoc

' Check to see if a drawing is loaded.
$ U0 _. E- D) `  |If (swModel Is Nothing) Or (swModel.GetType <> swDocDRAWING) Then
9 d1 I: ?# S, z5 {4 n8 ^3 I
) Q3 M! \4 F" i3 b: T, ^6 LswApp.SendMsgToUser ("To be used for drawings only, Open a drawing first and then TRY!")

% r4 X5 I! x/ {: D: M' If no model currently loaded, then exit
Exit Sub

End If
9 }1 `- L- n; W3 H' U
Set swDraw = swModel
0 }' n6 W$ _0 i7 z- U( ?Filepath = Left(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\"))
1 T8 x5 v, u7 k0 i6 R& h
1 \) H4 V* @, j6 b8 f- b5 hIf Dir(Filepath & "导出图纸", vbDirectory) = "" Then ' Change Sub folder Name here
MkDir Filepath + "导出图纸" ' Change Sub folder Name here
! Y0 K0 u- q" X7 O+ H9 HEnd If
* z0 ~9 Q+ X2 N: P! q1 B2 ?Filepath = Filepath + "导出图纸\" ' Change Sub folder Name here
1 ^; @' q7 J9 }# v8 z" ]/ S$ ^( ^
Set swCustPrpMgr = swModel.Extension.CustomPropertyManager("")
5 I0 `/ t5 ?$ P: S" C6 a( B   swCustPrpMgr.Get3 "", False, "", Value 'Change here the var revision "Rev"

FileName = Mid(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\") + 1)
) v& B) V" u- d# c/ v; j. J$ MFileName = Left(FileName, Len(FileName) - 7) & "" & Value & ".pdf"
swDraw.SaveAs3 Filepath & FileName & "", 0, 0
5 D8 N8 v; z; W: O# f: y7 q, `
# C! t. @7 m; u! N1 I3 E* }' t'-------------------------------------------------- SAVE DXF
9 P( I5 a  q2 Y4 b: s0 w6 `
Set swDraw = swModel
8 M5 J% {% I/ {  ~0 tFilepath = Left(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\"))
If Dir(Filepath & "导出图纸", vbDirectory) = "" Then ' Change Sub folder Name here
6 o6 z, r6 w) O/ k; bMkDir Filepath + "导出图纸" ' Change Sub folder Name here
End If
Filepath = Filepath + "导出图纸\" ' Change Sub folder Name here

Set swCustPrpMgr = swModel.Extension.CustomPropertyManager("")
8 a% R3 T0 e) l2 D   swCustPrpMgr.Get3 "", False, "", Value 'Change here the var revision "Rev"
2 ]& |' ]2 S0 w2 N
3 q: r  ?1 S6 P' ]FileName = Mid(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\") + 1)
+ v: ]; o! P# ~$ o% nFileName = Left(FileName, Len(FileName) - 7) & "" & Value & ".DXF"
% @+ e' L. V  O$ r
/ r' o% e: V" [" Q8 KswDraw.SaveAs3 Filepath & FileName & "", 0, 0
4 h  Z+ e" e0 C
swDraw.Save

3 K9 u% S" ]. y- R: J2 P4 H& f: F5 T'swApp.ExitApp '关闭SW软件
End Sub


1 t8 ^' I4 O8 b( j

大兄弟aa

宏怎么用都不知道

shengyz

大兄弟aa 发表于 2024-3-21 15:42
: l. U3 z$ I5 A9 G宏怎么用都不知道

0 @& C/ u' Y. i8 Y很强大，可以了解了解
8 U/ k! @; ]9 _: R

steve_suich

Dim swApp As Object

+ s, X$ {9 h5 c; J  bSub main()
- C% K& v7 T/ a- v# v( A
Set swApp = Application.SldWorks
1 o/ v' p- r* O, L9 `# uSet part = swApp.ActiveDoc

! B3 J' I1 X4 J; a, xIf part.GetType = 3 Then
7 {  H) s: |; a' Z8 }% r" N
5 C# d" I0 F" N) Cpart.SaveAs (Left(part.GetPathName, InStrRev(part.GetPathName, "\")) & Left(part.GetTitle, Len(part.GetTitle) - 6) & ".PDF")
4 b) Q  v4 e, d  
swApp.CloseDoc (part.GetTitle)
: e" W: K3 `5 B+ _0 m
% j/ s) @. T" {" ?8 {# gEnd If
! v0 t; M& C. m& Y: T  
End Sub