关于SW宏程序

shengyz

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

fiyu1314

描述一下你的需求，

冷月梧桐

工程图下导出PDF+DWF，部分宏
3 V, d# f. j" mDim swApp           As SldWorks.SldWorks
Dim swModel         As SldWorks.ModelDoc2
6 X$ G5 U, B. n, n6 r7 U! {* a
; }* t5 ^3 V; w1 xSub main()

7 P9 }: c7 J$ s' z. A& ^" ?Set swApp = Application.SldWorks
5 g3 m- c( k3 y# ]- U* ESet swModel = swApp.ActiveDoc

' Check to see if a drawing is loaded.
4 h/ T% b& y# VIf (swModel Is Nothing) Or (swModel.GetType <> swDocDRAWING) Then

% i& I, f) O) Q! WswApp.SendMsgToUser ("To be used for drawings only, Open a drawing first and then TRY!")
3 r8 M- \3 h4 P/ B/ ]
2 ~) g9 `" c$ C% C& t. k% y' If no model currently loaded, then exit
Exit Sub

; x, z9 j4 f7 M* N9 |! [" j/ v3 Y. hEnd If
1 R7 w8 v% i- c1 F* |3 [+ D! L/ Q
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
$ w  r6 K$ W/ s) t/ b
! X/ `+ m7 y0 E; \Set swCustPrpMgr = swModel.Extension.CustomPropertyManager("")
- y" v% Q) t! x! Y" W$ b   swCustPrpMgr.Get3 "", False, "", Value 'Change here the var revision "Rev"
) c- ^6 u) [' _# r) x' f9 d( }
FileName = Mid(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\") + 1)
  r' f$ u! B& eFileName = Left(FileName, Len(FileName) - 7) & "" & Value & ".pdf"
7 b" n' F& _+ t5 x9 j6 \2 h6 jswDraw.SaveAs3 Filepath & FileName & "", 0, 0
! S4 s. B" S( U
9 ^, W; j2 [2 I. V'-------------------------------------------------- SAVE DXF
1 u! x& \" p0 E1 y
Set swDraw = swModel
3 o& Z* z# |. MFilepath = Left(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\"))
! d) f& {0 ~8 BIf Dir(Filepath & "导出图纸", vbDirectory) = "" Then ' Change Sub folder Name here
# o, ]- b1 _' p$ N1 l- c& }MkDir Filepath + "导出图纸" ' Change Sub folder Name here
End If
Filepath = Filepath + "导出图纸\" ' Change Sub folder Name here
  Y* e: B  G3 o0 I5 R  v! R
Set swCustPrpMgr = swModel.Extension.CustomPropertyManager("")
% W' }8 j; s, U$ U   swCustPrpMgr.Get3 "", False, "", Value 'Change here the var revision "Rev"
, `' U  R, f% e' `5 G: q% j2 x
, l1 f5 ]2 y2 ]FileName = Mid(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\") + 1)
FileName = Left(FileName, Len(FileName) - 7) & "" & Value & ".DXF"

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

swDraw.Save
  e0 Y) l' [' k; w, N
0 V* B- |# K% Q/ F3 x) f7 _6 j'swApp.ExitApp '关闭SW软件
* c4 P' i9 T# t7 W# C# w; s: f* nEnd Sub

" t2 }% K7 v* v! @0 C3 n

大兄弟aa

宏怎么用都不知道

shengyz

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

很强大，可以了解了解

steve_suich

* @  ^$ S- A' `) i
Dim swApp As Object

Sub main()
1 S' b( a# E- q& J$ e
4 U3 K& }) a- F! b3 v8 j$ Y& o. TSet swApp = Application.SldWorks
; m& L5 N2 q- s0 U) S/ CSet part = swApp.ActiveDoc
$ z: C* o+ U* f( P
1 |9 P' ?. S' }/ RIf part.GetType = 3 Then

% p  r  r/ F" qpart.SaveAs (Left(part.GetPathName, InStrRev(part.GetPathName, "\")) & Left(part.GetTitle, Len(part.GetTitle) - 6) & ".PDF")
  
swApp.CloseDoc (part.GetTitle)

' S; a6 U: d2 I. A9 aEnd If
  
; n' v+ x" x& U7 X9 [! a5 \3 uEnd Sub