关于SW宏程序

shengyz

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

fiyu1314

描述一下你的需求，

冷月梧桐

工程图下导出PDF+DWF，部分宏
  o0 D# g1 }0 L- ?' bDim swApp           As SldWorks.SldWorks
Dim swModel         As SldWorks.ModelDoc2

4 ?% G& e) J' ?! fSub main()

! M+ c7 X( {" l1 n5 N6 @7 p! h* ZSet swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc

) Z1 ^5 [1 j2 y. |' Check to see if a drawing is loaded.
9 f" v+ j7 x. p1 L5 M' u3 K9 oIf (swModel Is Nothing) Or (swModel.GetType <> swDocDRAWING) Then
5 \4 K5 y- X/ q
swApp.SendMsgToUser ("To be used for drawings only, Open a drawing first and then TRY!")
0 S. Q# A! a' s3 ]
' If no model currently loaded, then exit
Exit Sub
" _6 r! x/ d( Q' V
End If

; f; r' m1 L6 D" j: W9 J* GSet swDraw = swModel
7 x: b0 ?) Q6 f. {! AFilepath = Left(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\"))
( U; N7 _$ F$ C: g
If Dir(Filepath & "导出图纸", vbDirectory) = "" Then ' Change Sub folder Name here
MkDir Filepath + "导出图纸" ' Change Sub folder Name here
" n, P& r9 r) ~1 [) c  U& pEnd If
' W4 W! k/ r( ]+ ~. xFilepath = Filepath + "导出图纸\" ' Change Sub folder Name here

: _" V3 _  t0 BSet swCustPrpMgr = swModel.Extension.CustomPropertyManager("")
3 Q: n) f% N% O/ M3 y0 z   swCustPrpMgr.Get3 "", False, "", Value 'Change here the var revision "Rev"
  L9 B8 S0 Q2 H4 F8 R
* B& M7 m: n6 W3 HFileName = Mid(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\") + 1)
  }/ l1 r- I8 g: }- FFileName = Left(FileName, Len(FileName) - 7) & "" & Value & ".pdf"
swDraw.SaveAs3 Filepath & FileName & "", 0, 0
* S* J& N" _% W/ @
& }# u# u) t8 ?$ Z0 s; p* w'-------------------------------------------------- SAVE DXF

Set swDraw = swModel
! y: j8 @% U5 ]1 I5 p- IFilepath = Left(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\"))
If Dir(Filepath & "导出图纸", vbDirectory) = "" Then ' Change Sub folder Name here
MkDir Filepath + "导出图纸" ' Change Sub folder Name here
$ v* K8 K) a& [* s7 iEnd If
- `# \, w1 V7 a. ]Filepath = Filepath + "导出图纸\" ' Change Sub folder Name here
2 _) Q6 G, L8 [9 ?  t% _
Set swCustPrpMgr = swModel.Extension.CustomPropertyManager("")
   swCustPrpMgr.Get3 "", False, "", Value 'Change here the var revision "Rev"
( b1 v( W9 r. _+ O  {
FileName = Mid(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\") + 1)
. b3 v. P6 S. i9 m& N' H8 tFileName = Left(FileName, Len(FileName) - 7) & "" & Value & ".DXF"
- R5 b' b! w& L- ~& H
) F: _$ r/ F/ P* w* t. y! E. hswDraw.SaveAs3 Filepath & FileName & "", 0, 0
) Z+ e9 C- q6 v! T
swDraw.Save

6 b# w" O3 {4 R$ L'swApp.ExitApp '关闭SW软件
5 ]/ l# g4 H% p4 u7 V& p4 Q) f$ J. VEnd Sub
. g1 k( w) \: U) Q* ~- J" B; n  V
  ~( s! i+ H( Y" k9 A- O
9 V! u- v' K6 g# c

大兄弟aa

宏怎么用都不知道

shengyz

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

0 U) Y+ x0 C, x0 p很强大，可以了解了解
) N8 T$ D- s' y

steve_suich

! L. ]7 e+ D  B, t. o: D
Dim swApp As Object
4 H. e9 d1 r. g& U1 }1 a# ]
Sub main()
' z& H! c+ I! h6 N( ]6 N+ @/ l9 F6 E
Set swApp = Application.SldWorks
Set part = swApp.ActiveDoc

If part.GetType = 3 Then
) G# G2 t5 O; d$ m3 V7 p
part.SaveAs (Left(part.GetPathName, InStrRev(part.GetPathName, "\")) & Left(part.GetTitle, Len(part.GetTitle) - 6) & ".PDF")
  
swApp.CloseDoc (part.GetTitle)
+ y7 i* N  ?3 @' J' {* U, l. c* E! v
End If
  
End Sub