關(guān)于SW宏程序

shengyz

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

fiyu1314

描述一下你的需求,，

冷月梧桐

工程圖下導(dǎo)出PDF+DWF,，部分宏
Dim swApp           As SldWorks.SldWorks
; }7 V) B2 l3 r% h, U% sDim swModel         As SldWorks.ModelDoc2
# ^7 a- e1 I! D9 F! N
Sub main()

( t* K, U5 I& m6 M% ]Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
; V9 v  O% y* c- L
' Check to see if a drawing is loaded.
If (swModel Is Nothing) Or (swModel.GetType <> swDocDRAWING) Then
& [# m6 L; b; P+ T: p* I
swApp.SendMsgToUser ("To be used for drawings only, Open a drawing first and then TRY!")
% u7 @. H/ a5 ^1 s
% Z; q/ o3 e$ b! J( e; c' If no model currently loaded, then exit
4 c" E% B9 |" b+ A; e" hExit Sub

# b6 u1 O1 ]6 n0 u# J+ |, l4 `End If
0 u  P' @) S9 r# P* l  ?* a1 V
+ i4 y7 @+ }% S- oSet swDraw = swModel
Filepath = Left(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\"))

. `- b, Y6 @7 [0 Q+ w; }If Dir(Filepath & "導(dǎo)出圖紙", vbDirectory) = "" Then ' Change Sub folder Name here
MkDir Filepath + "導(dǎo)出圖紙" ' Change Sub folder Name here
End If
Filepath = Filepath + "導(dǎo)出圖紙\" ' Change Sub folder Name here

Set swCustPrpMgr = swModel.Extension.CustomPropertyManager("")
5 n5 N* |8 r) {1 o, V   swCustPrpMgr.Get3 "", False, "", Value 'Change here the var revision "Rev"

% M; P6 {) J3 y! s' fFileName = Mid(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\") + 1)
+ m# `! O# ]' d! v) pFileName = Left(FileName, Len(FileName) - 7) & "" & Value & ".pdf"
swDraw.SaveAs3 Filepath & FileName & "", 0, 0

'-------------------------------------------------- SAVE DXF
, ^$ K0 f9 r2 ^3 @
* L3 o; [3 R+ P. b7 USet swDraw = swModel
Filepath = Left(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\"))
/ p( H+ v+ e. y1 P+ EIf Dir(Filepath & "導(dǎo)出圖紙", vbDirectory) = "" Then ' Change Sub folder Name here
8 s5 u2 U8 J! }: a5 |( T& }MkDir Filepath + "導(dǎo)出圖紙" ' Change Sub folder Name here
! |4 Q) N: O3 y! c$ `! PEnd If
& c/ m# c5 m* R, rFilepath = Filepath + "導(dǎo)出圖紙\" ' Change Sub folder Name here
5 Z6 F3 p0 h& Q' x3 y7 q
Set swCustPrpMgr = swModel.Extension.CustomPropertyManager("")
3 T! K/ C, z9 p3 M; c! J. u   swCustPrpMgr.Get3 "", False, "", Value 'Change here the var revision "Rev"

FileName = Mid(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\") + 1)
% d" q& s4 q3 z9 I% m5 _2 cFileName = Left(FileName, Len(FileName) - 7) & "" & Value & ".DXF"
' F9 P) ^$ @1 |7 G8 h
5 [! o4 K% ]" [5 \3 B* MswDraw.SaveAs3 Filepath & FileName & "", 0, 0
8 z1 p" z; Z  ?9 l1 ^& J2 A
. Y$ z/ s! i" z5 O5 A1 L6 Q& ]( I8 oswDraw.Save
* a+ Q! w! q3 M3 x0 r# [# L3 K* I* |
'swApp.ExitApp '關(guān)閉SW軟件
End Sub
' ?1 f% S2 S* u  z7 E1 N
" x- i# J' m1 m
: _7 F0 K* s8 T( @5 g

大兄弟aa

宏怎么用都不知道

shengyz

大兄弟aa 發(fā)表于 2024-3-21 15:42
# Z6 K- H) m4 S- v$ p宏怎么用都不知道

7 [$ E# i. z/ j  k( }% a6 `' `4 p$ Y很強(qiáng)大,，可以了解了解
0 ?% S: e7 \1 F! E

steve_suich

Dim swApp As Object

' ?9 T8 K% q7 _, B( L% a4 @" NSub main()

Set swApp = Application.SldWorks
+ z5 |9 Q. Y$ ?6 m7 a  h# {! t. _Set part = swApp.ActiveDoc
$ d1 F$ b4 L5 ^* d  h
If part.GetType = 3 Then
1 b) ]7 ]9 }. J6 G
part.SaveAs (Left(part.GetPathName, InStrRev(part.GetPathName, "\")) & Left(part.GetTitle, Len(part.GetTitle) - 6) & ".PDF")
  
swApp.CloseDoc (part.GetTitle)

' i8 Q6 \" R9 ^6 }End If
  
, u. k1 F# z/ v7 H: M2 bEnd Sub