關(guān)于SW宏程序

shengyz

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

fiyu1314

描述一下你的需求，

冷月梧桐

工程圖下導(dǎo)出PDF+DWF,，部分宏
% [' f  @8 M- W  rDim swApp           As SldWorks.SldWorks
' j% o3 S* S1 P) w6 q( n5 LDim swModel         As SldWorks.ModelDoc2

Sub main()

Set swApp = Application.SldWorks
- D7 K  a5 `# h. ]Set swModel = swApp.ActiveDoc

' Check to see if a drawing is loaded.
If (swModel Is Nothing) Or (swModel.GetType <> swDocDRAWING) Then
4 S6 ]  s/ M3 q0 `, O7 s  d, I
9 w: S9 a8 L; f9 d4 IswApp.SendMsgToUser ("To be used for drawings only, Open a drawing first and then TRY!")
0 e, M$ K( o3 o  B, d' P
) H3 _4 B* E* b' If no model currently loaded, then exit
Exit Sub

" {8 |+ b2 X+ ^1 ]" B7 gEnd If
& ~4 M. ]6 z- a7 `% \; M8 u0 E0 ^
Set swDraw = swModel
Filepath = Left(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\"))
8 C1 y. S' Q9 k( y  W, v: `
If Dir(Filepath & "導(dǎo)出圖紙", vbDirectory) = "" Then ' Change Sub folder Name here
MkDir Filepath + "導(dǎo)出圖紙" ' Change Sub folder Name here
; f' n( `$ X6 O9 ?6 L8 Y6 vEnd If
( }1 G4 U. D* `. H5 {) H4 cFilepath = Filepath + "導(dǎo)出圖紙\" ' Change Sub folder Name here
1 M  x6 k" y* K: S
Set swCustPrpMgr = swModel.Extension.CustomPropertyManager("")
   swCustPrpMgr.Get3 "", False, "", Value 'Change here the var revision "Rev"
/ W( D- c8 a6 O) t. l
FileName = Mid(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\") + 1)
, U( V$ `/ t3 z$ v" Q' E7 R+ MFileName = Left(FileName, Len(FileName) - 7) & "" & Value & ".pdf"
, c1 O: y* R9 C7 O8 EswDraw.SaveAs3 Filepath & FileName & "", 0, 0

, S5 M& s% C1 k9 i/ |/ s'-------------------------------------------------- SAVE DXF
( t5 P( ^6 t: h( l3 p1 L
Set swDraw = swModel
Filepath = Left(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\"))
If Dir(Filepath & "導(dǎo)出圖紙", vbDirectory) = "" Then ' Change Sub folder Name here
% w5 p5 i, U( T7 mMkDir Filepath + "導(dǎo)出圖紙" ' Change Sub folder Name here
End If
1 J& P8 E2 b5 ^5 \% n& \0 dFilepath = Filepath + "導(dǎo)出圖紙\" ' Change Sub folder Name here

Set swCustPrpMgr = swModel.Extension.CustomPropertyManager("")
   swCustPrpMgr.Get3 "", False, "", Value 'Change here the var revision "Rev"
1 ?/ l% l& q" l
* U# q: \0 S& f+ F! H& q3 |4 lFileName = Mid(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\") + 1)
0 z, T& |( T. V. V8 U) }, vFileName = Left(FileName, Len(FileName) - 7) & "" & Value & ".DXF"
0 r$ v* ?8 T7 \6 f' ?
swDraw.SaveAs3 Filepath & FileName & "", 0, 0

swDraw.Save
, _( n$ W9 k$ |! \+ ?$ s" |
'swApp.ExitApp '關(guān)閉SW軟件
0 N$ }* T; }! s. Y# k! hEnd Sub
' s0 t! C/ r: e/ _( p0 _7 i

7 }* s* a) T3 t4 z6 Q+ P& o+ z# b7 b

大兄弟aa

宏怎么用都不知道

shengyz

大兄弟aa 發(fā)表于 2024-3-21 15:42
2 P2 x( Z7 A8 O+ g宏怎么用都不知道

很強(qiáng)大，可以了解了解
" }. J* y- q( n2 G- `" G! V

steve_suich

Dim swApp As Object

5 F( E5 M$ j- s1 h$ PSub main()
/ K; `5 w9 {% w$ [
Set swApp = Application.SldWorks
Set part = swApp.ActiveDoc
' b% C  K0 c7 P) B/ K
If part.GetType = 3 Then
  N. Z# a$ J, e( U' {
part.SaveAs (Left(part.GetPathName, InStrRev(part.GetPathName, "\")) & Left(part.GetTitle, Len(part.GetTitle) - 6) & ".PDF")
  
/ M5 t& J8 l& f3 rswApp.CloseDoc (part.GetTitle)
3 k+ x$ D# U! H
8 U0 i) Z/ i2 ~) L4 tEnd If
" L& u2 D  T. e' O; m! b4 r8 E/ s  
. q6 ^0 G) L8 ~" eEnd Sub