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

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
$ {1 G- Z0 w' `4 d- h# v- KSub main()" [5 ^: u& k% J6 i; _3 A
Set swApp = Application.SldWorks3 ^5 }! y" ~# i, _6 }% }, `
Set Part = swApp.ActiveDoc

感谢分享啊~~~~

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

介绍以你这个是怎莫用的

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

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

''' ******************************************************************************
; O/ D% v5 B( Y8 e4 w; I! o
''Edit by votasee @ 090909 update 091010
" [5 A" z$ O r$ k. g
'' ******************************************************************************
5 ^9 q: W; L- ?
Dim swApp As Object
F# x, A# \1 f, [
Dim Part As Object
' b1 r: L: t3 i$ l
Dim Filename$, dwgFileName$
! z, F" Y1 W+ m% E5 A. n
Dim No%, Title$, sTime$, sUserDir$0 ~$ [0 p1 d' g* ?
Sub main()
+ Z" c( T9 I# A! z! p1 j4 n. ]1 y
Set swApp = Application.SldWorks R$ O$ w4 t2 H- H$ V; s
Set Part = swApp.ActiveDoc
6 V2 q- w9 H3 B3 g- E0 S Z
On Error Resume Next
, R3 U) \& y% J/ e. y3 G q$ Q
Filename = Part.GetPathName()
$ \0 D2 W4 Y" E9 { q7 n
sUserDir = VBA.Environ("USERPROFILE") & Chr(92) & Chr(-10304) & Chr(-15386) & Chr(92)5 P) M7 U4 B9 U9 E7 E4 \, i
sTime = Format(Time, "YYMMDD_hhmmss")4 ?; r4 w+ R4 P! Z* n! |# f2 L0 E
/ {$ M& O( o( W0 v3 F) z9 c g
Randomize
! J! o( y' S8 T* ]+ @9 ~7 i
If Filename = "" Then Filename = sUserDir & "Part" & Int(Rnd * 1000) & ".SLDDRW"
2 |) F- t1 P9 W6 Q0 G4 G/ L1 U
' Part.SaveAs2 Filename, 0, 0, 0 ''''if need SLDDRW FILE,THEN DELETE MARK!
5 i4 _3 P! o0 s5 M0 Z
No = Len(Filename)
8 X% ?" R( F1 {( y% R
outFileName = Left(Filename, No - 7) & "_" & sTime & ".PDF"- B' F% @- `( W: N. F- @
Part.SaveAs2 outFileName, 0, 1, 0- m+ @ f" B" n' @9 h& [
Title = Part.GetTitle
/ C/ }' q) i+ t* J$ n4 ?
Set Part = Nothing3 O% ~+ [9 T2 [7 }; c4 J5 V' ^4 d
' swApp.CloseDoc Title
6 E, S" A2 q! Q) C# T
swApp.Frame.SetStatusBarText Filename & "is SAVED!"
7 }) L X2 Q) k: A8 x# T
End Sub
9 E6 _; e4 J/ R4 D5 t/ F6 C" x
, r! T7 \2 i; X: D% H

复制代码

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

通知

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

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