關(guān)于SW宏程序

shengyz

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

fiyu1314

描述一下你的需求，

冷月梧桐

工程圖下導(dǎo)出PDF+DWF，部分宏
Dim swApp           As SldWorks.SldWorks
Dim swModel         As SldWorks.ModelDoc2

Sub main()
' O0 S* t9 j1 d; i) t7 Y
* f) `9 _) |3 B, \* n, CSet swApp = Application.SldWorks
2 Q- g- I* @# H! q' K1 eSet swModel = swApp.ActiveDoc
9 s$ A- K) Q& a+ u1 G: Q* B
' Check to see if a drawing is loaded.
If (swModel Is Nothing) Or (swModel.GetType <> swDocDRAWING) Then

7 }# e8 b" \0 V% W1 p& j3 pswApp.SendMsgToUser ("To be used for drawings only, Open a drawing first and then TRY!")
  |4 U5 H1 q2 |. Q2 I) {
( o  q$ U8 h& s# Y$ M7 J) ^+ L' If no model currently loaded, then exit
Exit Sub

End If

3 o* K9 _; l" H' F+ j/ LSet swDraw = swModel
; j, [& [/ a) I" J) j" ]Filepath = Left(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\"))

, {2 O9 o! y2 W/ r8 f) I! b! ^# |If Dir(Filepath & "導(dǎo)出圖紙", vbDirectory) = "" Then ' Change Sub folder Name here
MkDir Filepath + "導(dǎo)出圖紙" ' Change Sub folder Name here
End If
6 C) m, Z4 q, ^; mFilepath = Filepath + "導(dǎo)出圖紙\" ' Change Sub folder Name here
. e$ N6 h$ Q# G( m4 P5 q- f% `6 }
Set swCustPrpMgr = swModel.Extension.CustomPropertyManager("")
   swCustPrpMgr.Get3 "", False, "", Value 'Change here the var revision "Rev"

, J* ^+ A+ }! J: {FileName = Mid(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\") + 1)
FileName = Left(FileName, Len(FileName) - 7) & "" & Value & ".pdf"
" m1 G$ W! w9 b% \6 a+ eswDraw.SaveAs3 Filepath & FileName & "", 0, 0
$ T# P% C! f3 v& [( S% L4 B0 d
1 y* M1 _" B8 Y. `( \'-------------------------------------------------- SAVE DXF
: N' t- E' G6 ?0 M2 \: @- O/ j) d% [
- ~$ M8 a5 B8 L, p$ k. W! cSet swDraw = swModel
Filepath = Left(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\"))
5 D; `7 L* |9 yIf 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
6 P$ a1 M' S; m) a% t
Set swCustPrpMgr = swModel.Extension.CustomPropertyManager("")
, Q8 Y, G9 g+ S9 M+ J- i" W7 m   swCustPrpMgr.Get3 "", False, "", Value 'Change here the var revision "Rev"

FileName = Mid(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\") + 1)
FileName = Left(FileName, Len(FileName) - 7) & "" & Value & ".DXF"
  p- I% W% L) D3 \/ V3 f- L
swDraw.SaveAs3 Filepath & FileName & "", 0, 0
4 u* \8 M7 i8 Z
- `0 K( ^7 B4 p1 B+ o. u5 [1 g9 wswDraw.Save

2 a. W; q, r# `+ M$ l* ?'swApp.ExitApp '關(guān)閉SW軟件
2 M+ e2 ^) E  n0 [# nEnd Sub

大兄弟aa

宏怎么用都不知道

shengyz

大兄弟aa 發(fā)表于 2024-3-21 15:42
# \6 n. N7 v1 R9 U8 |: @宏怎么用都不知道

很強(qiáng)大，可以了解了解
  \1 S; W1 G; j* v5 N9 l

steve_suich

# i% O) Q6 q( B: }
! v: _, _( B1 r9 x5 k, RDim swApp As Object

Sub main()

Set swApp = Application.SldWorks
Set part = swApp.ActiveDoc
+ x7 v/ L7 e! r& R+ ~
" V9 N  V, D$ H) \( ~3 a# S/ EIf part.GetType = 3 Then
! ?# C) X* `8 ~8 x7 Z# a/ m8 C  s
9 ?6 I6 W% d1 P" ipart.SaveAs (Left(part.GetPathName, InStrRev(part.GetPathName, "\")) & Left(part.GetTitle, Len(part.GetTitle) - 6) & ".PDF")
  
$ i. B: k( w, A3 J9 |5 HswApp.CloseDoc (part.GetTitle)
  m. |0 m& P9 q- H: c
End If
  
End Sub