哪位高手可以帮忙修改一下宏

liuxinwei · 发表于 2012-4-27 13:42:23

马上注册，结识高手，享用更多资源，轻松玩转三维网社区。

您需要登录才可以下载或查看，没有帐号？注册

x

哪位高手可以帮忙修改一下宏，我需要转换工程图保存时自动保存到桌面上，工程图名称也是自动复制零件的名称，我改了几天了，搞不定了。只有请教高手了，先谢谢了
Sub main()
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
Filename = Part.GetPathName()
No = Len(Filename)
Filename = Left(Filename, No - 7)
Part.SaveAs2 Filename & ".pdf", 0, True, False
X = MsgBox(" 已保存为 pdf 文件 ", 0)
End Sub

飞天鸟 · 发表于 2012-4-27 15:23:24

1、这个No名字不好，而且在宏中没有使用啊~~~
2、应当指定对象数据类型 dim Part as ModelDoc2
3、试一试另一个保存函数 Part.SaveAs3(BackupFullName, 0, 0)

飞天鸟 · 发表于 2012-4-27 15:25:35

另外，这个插件包含一个自动另存功能，只要在工程图保存时，就会同时另存一个dwg或pdf在指定的路径下。
http://www.3dportal.cn/discuz/thread-788198-1-1.html

yjyeming · 发表于 2012-4-27 16:29:37

Sub main()
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
FileName = Part.GetPathName()
n = Len(FileName)
no = InStrRev(FileName, "\")
FileName = Mid(FileName, no + 1, n - no - 7)
Part.SaveAs3 "C:\Documents and Settings\Administrator\桌面\" & FileName & ".PDF", 0, 0
X = MsgBox(" 已保存为 pdf 文件 ", 0)
End Sub

远征龙 · 发表于 2013-12-9 14:26:31

yjyeming 发表于 2012-4-27 16:29 static/image/common/back.gif
, q' V9 ]8 m! | @# {& K y4 e/ dSub main()% k4 u) @4 P/ S. ^ k
Set swApp = Application.SldWorks
) d$ B8 E0 A* J0 I/ BSet Part = swApp.ActiveDoc

感谢分享啊~~~~

txz1314 · 发表于 2013-12-11 19:56:08

介绍以你这个是怎莫用的

votasee · 发表于 2013-12-13 11:16:42

大家在使用代码的时候应该学习使用_工具栏上的代码按钮...
否则别人不好复制...应该像下面这样使用..这是个PDF输出的例子
如果工程图文件已经保存,则输出PDF在相应目录下,如果没有保存,则保存在桌面..

''' ******************************************************************************
8 `% d& \9 W( l7 u/ ?
''Edit by votasee @ 090909 update 091010& Y; V! [4 a& R% `! L
'' ******************************************************************************7 o0 ^) H; s% |8 G9 I
Dim swApp As Object
0 Q% @& I1 J% s! E5 F3 v% f* x
Dim Part As Object/ h3 ~. G1 x$ E. ]. g
Dim Filename$, dwgFileName$
# M! W0 [, L1 W" ?' j# ~6 N
Dim No%, Title$, sTime$, sUserDir$! _$ j* b7 R* u9 z3 }+ [% ^
Sub main()
+ ]( w" \4 E& n- f" h6 m
Set swApp = Application.SldWorks3 }% ]! _, m5 u1 M" H* _ N
Set Part = swApp.ActiveDoc
, G% F4 Y. D9 T- v- @
On Error Resume Next) I" t/ z0 G1 g, }
Filename = Part.GetPathName()
1 I6 j0 U; g/ e% k
sUserDir = VBA.Environ("USERPROFILE") & Chr(92) & Chr(-10304) & Chr(-15386) & Chr(92)) A( u( i3 Y$ n
sTime = Format(Time, "YYMMDD_hhmmss")
7 v/ n6 q3 I! @. }; m- o6 t0 H. f, _
. Q* m) h+ p% m
Randomize- t" I' N4 E4 V9 B3 X
If Filename = "" Then Filename = sUserDir & "Part" & Int(Rnd * 1000) & ".SLDDRW": _! n$ |6 Y7 p$ F+ `: S: Z2 _
' Part.SaveAs2 Filename, 0, 0, 0 ''''if need SLDDRW FILE,THEN DELETE MARK!
, t+ F% M4 _( Y X4 z( N U
No = Len(Filename)& g7 O4 P1 `+ j6 N" C# W
outFileName = Left(Filename, No - 7) & "_" & sTime & ".PDF"
, a. @& c w" _2 d
Part.SaveAs2 outFileName, 0, 1, 0
8 v" B0 j- l$ e4 Z9 l4 A
Title = Part.GetTitle, R( ~" I$ a# k8 Y
Set Part = Nothing) I/ r# F$ h7 Q S5 v
' swApp.CloseDoc Title
2 K2 H& W) A7 j+ {; K* z5 `- R
swApp.Frame.SetStatusBarText Filename & "is SAVED!"
7 W. h. S3 n) C: {# ~. A; n
End Sub
: L2 R1 g9 _( {9 V0 H
. s9 F' a# E& X" D8 T4 u

复制代码

		自动登录	找回密码
密码			注册

通知

[求助] 哪位高手可以帮忙修改一下宏

马上注册，结识高手，享用更多资源，轻松玩转三维网社区。

浏览过的版块