关于SW宏程序

shengyz

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

fiyu1314

描述一下你的需求，

冷月梧桐

工程图下导出PDF+DWF，部分宏
Dim swApp           As SldWorks.SldWorks
Dim swModel         As SldWorks.ModelDoc2

Sub main()
( x, [1 d: A) L3 X* h2 K" u
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
! r7 _, h1 ~" t* ~, y6 Q3 k
6 L8 q6 B* `! Y# iswApp.SendMsgToUser ("To be used for drawings only, Open a drawing first and then TRY!")
; v  C: G: p  V% R0 p2 x
3 {( N3 s7 Q% Y, I5 T( m' If no model currently loaded, then exit
Exit Sub
3 v& C7 p  e; r& s0 s2 j$ M
End If
& f+ R& W( f5 f8 g% K3 f
Set swDraw = swModel
Filepath = Left(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\"))

If Dir(Filepath & "导出图纸", vbDirectory) = "" Then ' Change Sub folder Name here
9 J0 `- w8 [7 R5 AMkDir Filepath + "导出图纸" ' Change Sub folder Name here
End If
0 Y7 A8 W$ g4 V$ d+ G# EFilepath = Filepath + "导出图纸\" ' Change Sub folder Name here

Set swCustPrpMgr = swModel.Extension.CustomPropertyManager("")
   swCustPrpMgr.Get3 "", False, "", Value 'Change here the var revision "Rev"
5 W! [3 U! I% X) O" b% u4 C6 O" @
FileName = Mid(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\") + 1)
) u2 z1 L" P" I7 [FileName = Left(FileName, Len(FileName) - 7) & "" & Value & ".pdf"
swDraw.SaveAs3 Filepath & FileName & "", 0, 0

0 n; V5 T9 p. w7 N'-------------------------------------------------- SAVE DXF
; u/ x# p  E7 O2 [
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
/ z) u7 e$ K( TEnd If
Filepath = Filepath + "导出图纸\" ' Change Sub folder Name here

% x* ]" g* _, n+ a3 o# jSet swCustPrpMgr = swModel.Extension.CustomPropertyManager("")
   swCustPrpMgr.Get3 "", False, "", Value 'Change here the var revision "Rev"

0 k$ ?: W2 E7 N" hFileName = Mid(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\") + 1)
FileName = Left(FileName, Len(FileName) - 7) & "" & Value & ".DXF"

9 z! m- y( `8 x6 Q" u, LswDraw.SaveAs3 Filepath & FileName & "", 0, 0

swDraw.Save

'swApp.ExitApp '关闭SW软件
End Sub
3 @$ R2 v; c" W  N8 A/ m
; O. P5 g0 r% [
9 s( V( i5 `5 ?! o8 S" l8 [. @

大兄弟aa

宏怎么用都不知道

shengyz

大兄弟aa 发表于 2024-3-21 15:42
+ h" I& T# c; |宏怎么用都不知道

很强大，可以了解了解
- e8 D& y' F5 x' [6 |

steve_suich

- }9 u* q) Q- J# y7 [7 O5 E* q1 Y3 w! C
+ Y" \0 `( t3 q) ]Dim swApp As Object
( P! W0 q9 j5 @
# G" F; D) V$ E- d0 T$ x. w2 Q2 xSub main()

Set swApp = Application.SldWorks
& E6 u# d% k. w" O' C/ ESet part = swApp.ActiveDoc
9 l1 F, c% I) h
If part.GetType = 3 Then
: ]. y* d3 Q  m5 |8 w+ B
" k; W7 c  z4 i. t' P/ opart.SaveAs (Left(part.GetPathName, InStrRev(part.GetPathName, "\")) & Left(part.GetTitle, Len(part.GetTitle) - 6) & ".PDF")
  
: i3 P& \' @7 \, vswApp.CloseDoc (part.GetTitle)

: X3 ?" A2 E0 @$ a' WEnd If
  
End Sub