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

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. m8 t/ p$ b2 n$ j% R% q# M
Sub main()& _7 X6 ^; q) w' O6 i C
Set swApp = Application.SldWorks
; B1 s- C4 N, Q" P, R; @, Q8 ]Set Part = swApp.ActiveDoc

感谢分享啊~~~~

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

介绍以你这个是怎莫用的

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

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

''' ******************************************************************************
6 s0 j- K# }9 }+ E$ V
''Edit by votasee @ 090909 update 0910100 A' R! V, E5 K: X! p c" z, k
'' ******************************************************************************/ h- x2 D& c1 B2 R1 b- N! s
Dim swApp As Object0 ]# k' {9 n$ n$ }% O
Dim Part As Object6 N0 C8 d% E {. ]$ ~
Dim Filename$, dwgFileName$
! M6 n6 }0 i4 i+ p
Dim No%, Title$, sTime$, sUserDir$
" X0 ~. ]9 G8 ~3 m4 N$ R0 ?5 H* l! H
Sub main()) f8 ]! t1 [9 X* b2 ~9 w0 Z
Set swApp = Application.SldWorks, [% o4 w3 S7 a3 W: h D
Set Part = swApp.ActiveDoc
" J% V) v. y6 A0 g! U) J4 }, d
On Error Resume Next
2 W0 E$ r! ^# a) B
Filename = Part.GetPathName()' u" z( s. ]7 W8 R4 M
sUserDir = VBA.Environ("USERPROFILE") & Chr(92) & Chr(-10304) & Chr(-15386) & Chr(92)
: b* a1 [8 F+ x w4 i4 i
sTime = Format(Time, "YYMMDD_hhmmss")
, k, _2 Q2 H9 Y
6 T% p! ~! a; Y' y. c4 C. Z
Randomize B$ s# s4 O& p1 ~4 v# {6 s
If Filename = "" Then Filename = sUserDir & "Part" & Int(Rnd * 1000) & ".SLDDRW"
$ w4 Z+ N& k6 g, i" ?% f" S
' Part.SaveAs2 Filename, 0, 0, 0 ''''if need SLDDRW FILE,THEN DELETE MARK!; _3 K$ {6 H3 W- Y* X' ^
No = Len(Filename)
4 ]' \# q* e3 t" y/ z
outFileName = Left(Filename, No - 7) & "_" & sTime & ".PDF"
( I% f# `# c0 U2 [, w1 \7 b% Z" h
Part.SaveAs2 outFileName, 0, 1, 0
0 U; v& ?6 G/ f: c% ]; R* ~
Title = Part.GetTitle3 `, b3 k7 ?0 `7 o
Set Part = Nothing
& z. J3 J, D c) W' E: M8 C& F
' swApp.CloseDoc Title. E& ^, ]: P8 S9 C* }! y8 k% I
swApp.Frame.SetStatusBarText Filename & "is SAVED!"
# W5 p! ?3 D0 Q* u' @$ l; w7 V: N
End Sub; @0 N: F5 h/ v8 B4 i$ p
2 s8 R2 F1 I9 g. m

复制代码

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

通知

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

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

浏览过的版块