关于SW宏程序

shengyz

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

fiyu1314

描述一下你的需求，

冷月梧桐

工程图下导出PDF+DWF，部分宏
, a1 M$ f# f, N9 H" RDim swApp           As SldWorks.SldWorks
Dim swModel         As SldWorks.ModelDoc2
' {3 w" y0 {% A4 P/ L- _/ c, q! s
, _6 C- w3 `; dSub main()
% B, o* B' f* Q% U3 O0 U! d
Set swApp = Application.SldWorks
+ w- O3 X3 H- A8 O/ `" sSet swModel = swApp.ActiveDoc

' Check to see if a drawing is loaded.
If (swModel Is Nothing) Or (swModel.GetType <> swDocDRAWING) Then

" N5 A3 a  v0 P* ^swApp.SendMsgToUser ("To be used for drawings only, Open a drawing first and then TRY!")

' If no model currently loaded, then exit
Exit Sub
; d; ?& I7 @; @5 F/ A& L5 _
) |2 I9 Y2 d' m) {5 wEnd If
/ H: K* U; t% h
5 L% p# H5 B! C2 B! h) gSet swDraw = swModel
6 I& r8 N# `! g# W& D2 M+ uFilepath = Left(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\"))
' j" B& X: m* w$ h. ?, S- J
* Z2 s8 \! G5 g  }: I" F, _* [If Dir(Filepath & "导出图纸", vbDirectory) = "" Then ' Change Sub folder Name here
MkDir Filepath + "导出图纸" ' Change Sub folder Name here
: n" I0 H/ [; P- }5 L$ gEnd If
Filepath = Filepath + "导出图纸\" ' Change Sub folder Name here

Set swCustPrpMgr = swModel.Extension.CustomPropertyManager("")
2 K/ w2 K6 V& m, X( X5 B0 e9 m& u9 ]4 e   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 & ".pdf"
& O1 n9 {3 C" Q; P+ ], XswDraw.SaveAs3 Filepath & FileName & "", 0, 0

$ v% f, _* X% d% B; b2 w7 f5 M4 r# }'-------------------------------------------------- SAVE DXF

9 T8 f- ~2 y* W0 F( ~  K* _Set swDraw = swModel
Filepath = Left(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\"))
If Dir(Filepath & "导出图纸", vbDirectory) = "" Then ' Change Sub folder Name here
2 s7 J* ~# U0 W! C) EMkDir Filepath + "导出图纸" ' Change Sub folder Name here
. l; {  c% \/ fEnd If
Filepath = Filepath + "导出图纸\" ' Change Sub folder Name here
' X- X! n5 A7 R) N) m3 }" Z
1 T+ J: @. N5 K# J! FSet swCustPrpMgr = swModel.Extension.CustomPropertyManager("")
/ E6 e. x8 }! ~& w4 f4 N4 V   swCustPrpMgr.Get3 "", False, "", Value 'Change here the var revision "Rev"
3 ^6 M8 A0 J# [2 Q+ q3 q
/ d2 D$ N/ K1 [) vFileName = Mid(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\") + 1)
' u6 ~2 \( H  [& d: P  t& w/ F* v  GFileName = Left(FileName, Len(FileName) - 7) & "" & Value & ".DXF"

swDraw.SaveAs3 Filepath & FileName & "", 0, 0
9 D9 S0 O+ r- K1 ~% K/ p
, o6 `+ F$ Q! [# SswDraw.Save
3 q6 M7 B4 k# N* k( |# W2 z6 d
+ u# i/ {3 k" `  J& P* Z+ F3 o3 z/ U'swApp.ExitApp '关闭SW软件
1 ]- n; r" [$ Z( O# P8 Z2 [+ H, w% pEnd Sub
  q9 m! w0 R0 H8 |- `8 p
3 M, L) |* ?, x! f. R2 W- D

大兄弟aa

宏怎么用都不知道

shengyz

大兄弟aa 发表于 2024-3-21 15:42
9 X6 e7 h0 _/ p' P宏怎么用都不知道

3 t: [5 e3 ^( z6 M$ s很强大，可以了解了解
! G+ q+ D2 ^0 G3 V/ ^5 u4 @( q1 L

steve_suich

. f6 f: B0 Y) h4 q1 wDim swApp As Object
7 Y) }- J* n; S
! e4 v( y$ q( \( LSub main()
% `) O% H  [: i) x* O# O
Set swApp = Application.SldWorks
Set part = swApp.ActiveDoc

1 m$ [/ t1 ?/ O9 x' s, a# P1 v$ ?If part.GetType = 3 Then

2 j4 P8 s/ ^% D  s( i0 m# Q: @( [part.SaveAs (Left(part.GetPathName, InStrRev(part.GetPathName, "\")) & Left(part.GetTitle, Len(part.GetTitle) - 6) & ".PDF")
  
swApp.CloseDoc (part.GetTitle)

. y. U. I4 ]. |0 s& d) p5 E. KEnd If
* C- s8 o# x/ P$ E" R! k/ v  
% _* E) w1 o* P! U1 nEnd Sub