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

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
$ K: }, s% F5 F. g/ XSub main()
" L' C9 d1 i% bSet swApp = Application.SldWorks; e5 G6 s! T6 J' D: {* c$ Z
Set Part = swApp.ActiveDoc

感谢分享啊~~~~

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

介绍以你这个是怎莫用的

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

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

''' ******************************************************************************
! l& Y7 N) h2 [4 p7 @' l
''Edit by votasee @ 090909 update 091010
w3 Y! q( G. A
'' ******************************************************************************3 c) f( |4 n" Q. w
Dim swApp As Object/ G7 M" H/ D! O) {
Dim Part As Object6 j) L: b/ U: I' e
Dim Filename$, dwgFileName$6 q- `) V! L8 j/ _$ n
Dim No%, Title$, sTime$, sUserDir$
, G' @$ _% v- P* s7 c* ^
Sub main()) `, J0 E& b; u
Set swApp = Application.SldWorks
& x' }0 N6 f/ G* L: L" V
Set Part = swApp.ActiveDoc
; G6 e9 A* b* \3 V; r2 L1 x& `
On Error Resume Next/ C5 w9 S* a7 o+ z
Filename = Part.GetPathName()
& ?! Z7 J+ G' {0 u
sUserDir = VBA.Environ("USERPROFILE") & Chr(92) & Chr(-10304) & Chr(-15386) & Chr(92)
9 F* d& Y. O: u8 ? R1 A' A
sTime = Format(Time, "YYMMDD_hhmmss")
# `. R# b8 p# p, h* Z) v$ y
$ ~5 D0 ^& g5 f" w# Z
Randomize) A6 u5 s: f4 B
If Filename = "" Then Filename = sUserDir & "Part" & Int(Rnd * 1000) & ".SLDDRW"; g/ A& T/ v+ q: [2 O( m0 R) Y( G
' Part.SaveAs2 Filename, 0, 0, 0 ''''if need SLDDRW FILE,THEN DELETE MARK!
; v5 D; l; K# y* |8 ~! |
No = Len(Filename)
1 q& G9 L; J# [3 J( \3 U+ K6 j
outFileName = Left(Filename, No - 7) & "_" & sTime & ".PDF"* v$ Y- B6 p7 w1 E( ~8 O6 I
Part.SaveAs2 outFileName, 0, 1, 01 O9 X2 g1 M5 Z# ` { P
Title = Part.GetTitle
; l* N* c' K! @( k3 {6 O. a2 W! V
Set Part = Nothing
/ e6 R$ ^4 O3 L+ p4 T
' swApp.CloseDoc Title
! _1 J' B7 _; C
swApp.Frame.SetStatusBarText Filename & "is SAVED!"
t, s" E3 E# J- `3 k3 S/ @
End Sub
8 D2 ~( s: L3 h& g+ ]8 P
! c9 P3 y: E% e4 {

复制代码

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

通知

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

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

浏览过的版块