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

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
, A; r K# ]# D+ x p* TSub main()
; T2 i( ?2 I4 J. j2 p3 b0 M1 Y$ VSet swApp = Application.SldWorks- L8 N4 Y% Y2 m7 j! S$ x! M% m
Set Part = swApp.ActiveDoc

感谢分享啊~~~~

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

介绍以你这个是怎莫用的

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

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

''' ******************************************************************************
& I K4 v9 ^9 ~6 F c" \
''Edit by votasee @ 090909 update 091010! y# h- h' G) e! \6 r7 J
'' ******************************************************************************5 n4 ^+ c; Q' U) j
Dim swApp As Object/ _1 J& d5 G- R4 e" U$ z
Dim Part As Object' a) ^% o! ^9 p6 T8 m5 Y* s4 W
Dim Filename$, dwgFileName$$ X- }& Z. c, T2 z: z
Dim No%, Title$, sTime$, sUserDir$* F+ d7 w8 c4 x2 P" k
Sub main()" e0 n( ]8 y* Y/ N" Q, Y
Set swApp = Application.SldWorks( x) O/ b+ j' _ o7 {7 @
Set Part = swApp.ActiveDoc5 I& U4 d5 ?. M' f; I) ?- s# z
On Error Resume Next( m6 A2 ~- ?; k7 ~8 z8 n' [5 F1 Y1 M6 I
Filename = Part.GetPathName()
' v E8 _8 O9 Z- q
sUserDir = VBA.Environ("USERPROFILE") & Chr(92) & Chr(-10304) & Chr(-15386) & Chr(92)
0 I: C" J8 ]6 O" H% B
sTime = Format(Time, "YYMMDD_hhmmss")0 \* P& _8 a$ b: J8 g
/ S J k5 Q, P, o
Randomize! S; Q+ ^0 o& y5 d1 o: V
If Filename = "" Then Filename = sUserDir & "Part" & Int(Rnd * 1000) & ".SLDDRW"$ [# _* J5 {: k9 O9 `" n
' Part.SaveAs2 Filename, 0, 0, 0 ''''if need SLDDRW FILE,THEN DELETE MARK!
* o. Y. u o$ U# a6 J+ n
No = Len(Filename), c' R( e$ D" ~# Y8 r8 i" m, r
outFileName = Left(Filename, No - 7) & "_" & sTime & ".PDF"* u [$ l' x6 _3 k1 b& Y ?; B1 R
Part.SaveAs2 outFileName, 0, 1, 09 Q! D1 M) m$ e
Title = Part.GetTitle
& I5 b* V/ h: z: `+ L; t% i! {' `5 K
Set Part = Nothing1 `" _' m O8 X4 ?0 |
' swApp.CloseDoc Title! t; |' p* w. q2 F: ]+ O% `. y
swApp.Frame.SetStatusBarText Filename & "is SAVED!"
) Y# ^2 z! A4 b' L/ S' k; { q
End Sub. z0 Z$ T6 n. C$ Z% K
( F5 Y# ~0 k H/ p7 L

复制代码

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

通知

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

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

浏览过的版块