关于SW宏程序

shengyz

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

fiyu1314

描述一下你的需求，

冷月梧桐

工程图下导出PDF+DWF，部分宏
% S0 i$ m, J: x* r8 b- ?+ J( M2 }Dim swApp           As SldWorks.SldWorks
Dim swModel         As SldWorks.ModelDoc2
, e" n* X6 a9 V9 k
! o! [* I# C" T" D0 cSub main()
6 v0 ~5 ^& _& U9 P+ X; F
) R' Z" b  _7 {! H! jSet swApp = Application.SldWorks
% n$ r4 k, s7 p0 t3 uSet swModel = swApp.ActiveDoc
  P2 c+ {9 J1 N
; x; b: G: q7 `/ z/ \' Check to see if a drawing is loaded.
If (swModel Is Nothing) Or (swModel.GetType <> swDocDRAWING) Then

) ?* R5 r& y  A% g6 [swApp.SendMsgToUser ("To be used for drawings only, Open a drawing first and then TRY!")

' If no model currently loaded, then exit
Exit Sub
2 e4 m& ?! g6 X. D
End If

Set swDraw = swModel
- @$ S! H* M) G) c) d9 a# r: u1 VFilepath = Left(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\"))
9 I3 M' x5 \; y5 F" I
If Dir(Filepath & "导出图纸", vbDirectory) = "" Then ' Change Sub folder Name here
5 \) G0 y9 ]2 `6 K/ c8 yMkDir Filepath + "导出图纸" ' Change Sub folder Name here
" y* r  Z6 R$ R: \; ?- B' ~: IEnd If
6 n$ ]2 m. X1 {Filepath = Filepath + "导出图纸\" ' Change Sub folder Name here
3 R$ F' r9 f. C9 n
+ T  H+ n# q4 s3 r1 SSet swCustPrpMgr = swModel.Extension.CustomPropertyManager("")
   swCustPrpMgr.Get3 "", False, "", Value 'Change here the var revision "Rev"

* J5 R# R; U) `, |1 zFileName = Mid(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\") + 1)
, N- \( K9 d0 B" H4 |6 }FileName = Left(FileName, Len(FileName) - 7) & "" & Value & ".pdf"
swDraw.SaveAs3 Filepath & FileName & "", 0, 0
& e9 L/ {/ D! m1 D. A1 }! k. s
1 c; A* m: \* e  l# F0 |& P'-------------------------------------------------- SAVE DXF
4 U& g3 |$ ^9 J$ X& a* r& j
& T( l8 y1 h& E3 t7 a/ ?4 I0 USet swDraw = swModel
Filepath = Left(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\"))
If Dir(Filepath & "导出图纸", vbDirectory) = "" Then ' Change Sub folder Name here
+ v" n  ~9 U8 I6 @3 UMkDir Filepath + "导出图纸" ' Change Sub folder Name here
5 j) ?+ D$ }) pEnd If
Filepath = Filepath + "导出图纸\" ' Change Sub folder Name here
+ N" Y$ l2 Y  V2 {; m- z
, j  d; d4 I+ |. z% }Set swCustPrpMgr = swModel.Extension.CustomPropertyManager("")
, @( u5 q3 a* z( u9 k5 j3 W   swCustPrpMgr.Get3 "", False, "", Value 'Change here the var revision "Rev"

* J$ U/ F0 Q5 N$ N$ U; wFileName = Mid(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\") + 1)
, K9 ~( k3 J* v5 b: B/ W# t. ?- ^FileName = Left(FileName, Len(FileName) - 7) & "" & Value & ".DXF"

! U, F- K8 \2 B7 S5 KswDraw.SaveAs3 Filepath & FileName & "", 0, 0
' R% v+ B. c/ z2 T  b
7 b& I" C' X: x6 ~swDraw.Save
7 b, Q$ j3 o3 F, v# W
5 p/ r, b4 @9 \! @'swApp.ExitApp '关闭SW软件
End Sub
7 \2 P0 _& p; ^+ ]4 W( S. a
5 Q7 D( M7 P# i1 H" ~, v1 g, h1 T

大兄弟aa

宏怎么用都不知道

shengyz

大兄弟aa 发表于 2024-3-21 15:42
3 S2 g6 _2 D; _. Y宏怎么用都不知道

! `3 ^5 t5 n# S/ ~很强大，可以了解了解

steve_suich

* F" j. i2 J& f3 K; W
" w" n0 J3 P$ |Dim swApp As Object

Sub main()

Set swApp = Application.SldWorks
Set part = swApp.ActiveDoc
( @1 W# H; O& S2 F) P# c: H% _
3 e" Y1 V  |" _4 n* ?1 r- ?( K% VIf part.GetType = 3 Then

* r, e+ U( L2 A; v" c" z/ u  ~3 ]3 fpart.SaveAs (Left(part.GetPathName, InStrRev(part.GetPathName, "\")) & Left(part.GetTitle, Len(part.GetTitle) - 6) & ".PDF")
, `3 z3 S* y( N( d& J$ H  
  M3 E, Q' {  B! M5 [swApp.CloseDoc (part.GetTitle)
6 y) J8 W! |+ y  y) O, Z  s) s2 O' T
End If
! h! @9 b- P. C9 F  
End Sub