關于SW宏程序

shengyz

昨天略微涉略SW宏程序，今天想整個一鍵出CAD及PDF的宏，奈何，不會設置宏讀取圖紙名稱，再把紅圈那設置成對應圖紙名，以致出的CAD及PDF都是固定名稱，有沒有大佬知道咋先讀取圖紙名。感謝。

fiyu1314

描述一下你的需求，

冷月梧桐

工程圖下導出PDF+DWF，部分宏
; ~( M2 }1 m  CDim swApp           As SldWorks.SldWorks
Dim swModel         As SldWorks.ModelDoc2

) Z$ ]3 W+ o$ l# a& D) J( L* ]# QSub main()

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
) Y) _* Q4 |8 s5 ?: q# l
/ k0 _) F+ D3 I( A4 }  o7 [0 [# y! ^swApp.SendMsgToUser ("To be used for drawings only, Open a drawing first and then TRY!")
. M$ s8 s2 T4 Y; q* J) f% M
' If no model currently loaded, then exit
Exit Sub
8 j2 X5 g( j! m. v& b1 t
7 c' `* W8 Y, ^  ^+ KEnd If
9 K) ^+ h$ t- {( m9 G! }2 x+ L* i0 `
Set swDraw = swModel
Filepath = Left(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\"))

If Dir(Filepath & "導出圖紙", vbDirectory) = "" Then ' Change Sub folder Name here
: E$ s# K9 H9 S; b! F7 I# \, wMkDir Filepath + "導出圖紙" ' Change Sub folder Name here
; _% ^, {* M- a9 Z/ L+ Z. M! UEnd If
Filepath = Filepath + "導出圖紙\" ' Change Sub folder Name here

Set swCustPrpMgr = swModel.Extension.CustomPropertyManager("")
( e) }6 u/ E2 L   swCustPrpMgr.Get3 "", False, "", Value 'Change here the var revision "Rev"

/ o, O4 F( A" p+ }# p% r6 hFileName = Mid(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\") + 1)
# o2 }  O: ^9 N2 a6 N& G# w3 ~) CFileName = Left(FileName, Len(FileName) - 7) & "" & Value & ".pdf"
8 d$ A/ D4 v8 [' B, fswDraw.SaveAs3 Filepath & FileName & "", 0, 0

; d# D! Q# @" `& O5 `; X0 r'-------------------------------------------------- SAVE DXF

Set swDraw = swModel
Filepath = Left(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\"))
! K8 m8 {4 u+ b# s0 h) B" uIf Dir(Filepath & "導出圖紙", vbDirectory) = "" Then ' Change Sub folder Name here
9 q- f5 V0 T  e( |MkDir Filepath + "導出圖紙" ' Change Sub folder Name here
End If
& u' T! s3 Y/ Q8 iFilepath = Filepath + "導出圖紙\" ' Change Sub folder Name here

" k, a$ O5 f- HSet swCustPrpMgr = swModel.Extension.CustomPropertyManager("")
4 }% f5 e7 S; r   swCustPrpMgr.Get3 "", False, "", Value 'Change here the var revision "Rev"

! e" [0 g7 ^4 i  K8 [) l- KFileName = Mid(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\") + 1)
( l3 s% q, j# h8 K' D" eFileName = Left(FileName, Len(FileName) - 7) & "" & Value & ".DXF"
# _* `; M% o3 j) X% c" X
" J9 Z$ `( m# \  dswDraw.SaveAs3 Filepath & FileName & "", 0, 0
4 u$ [" {8 @( i
swDraw.Save
+ t! n# }: M7 e
'swApp.ExitApp '關閉SW軟件
End Sub

大兄弟aa

宏怎么用都不知道

shengyz

大兄弟aa 發表于 2024-3-21 15:42
. U, l. n7 `% R) H) C宏怎么用都不知道

* w: v2 v; z, A5 ]6 J: r5 F很強大，可以了解了解

steve_suich

/ N$ a3 {7 {6 w# `8 f6 D
Dim swApp As Object

Sub main()

9 r' \1 y6 j2 _. xSet swApp = Application.SldWorks
7 n5 l3 [7 r1 {6 M" ]Set part = swApp.ActiveDoc

If part.GetType = 3 Then

part.SaveAs (Left(part.GetPathName, InStrRev(part.GetPathName, "\")) & Left(part.GetTitle, Len(part.GetTitle) - 6) & ".PDF")
  
0 }6 _+ ?. u3 m; B% VswApp.CloseDoc (part.GetTitle)
( P: X* D6 g! [
: S+ R* o0 k; C# w1 ~' i, sEnd If
! @) S  P6 S* v" q  
End Sub