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

liuxinwei

哪位高手可以帮忙修改一下宏，我需要转换工程图保存时自动保存到桌面上，工程图名称也是自动复制零件的名称，我改了几天了，搞不定了。只有请教高手了，先谢谢了
Sub main()
Set swApp = Application.SldWorks
* d; t7 g' v" }7 O- aSet Part = swApp.ActiveDoc
Filename = Part.GetPathName()
No = Len(Filename)
Filename = Left(Filename, No - 7)
Part.SaveAs2 Filename & ".pdf", 0, True, False
4 q! k  K; _+ G5 jX = MsgBox(" 已保存为 pdf 文件 ", 0)
6 H* H0 m% b7 L- ]$ ?8 K: q/ L! pEnd Sub

飞天鸟

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

飞天鸟

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

yjyeming

Sub main()
# W" a& B: F: \, n8 b" ySet swApp = Application.SldWorks
4 L" w* C7 o# qSet Part = swApp.ActiveDoc
FileName = Part.GetPathName()
& Q- ~6 H% L2 H5 t% D$ F' A  vn = Len(FileName)
no = InStrRev(FileName, "\")
FileName = Mid(FileName, no + 1, n - no - 7)
2 B8 l& M" S: o8 k  b4 F5 }Part.SaveAs3 "C:\Documents and Settings\Administrator\桌面\" & FileName & ".PDF", 0, 0
X = MsgBox(" 已保存为 pdf 文件 ", 0)
End Sub

远征龙

yjyeming 发表于 2012-4-27 16:29 static/image/common/back.gif
4 x, ~- [5 b. O( M8 G& PSub main()
/ |4 y" k2 [5 v+ V% TSet swApp = Application.SldWorks
Set Part = swApp.ActiveDoc

9 @7 v, C0 y* F6 n感谢分享啊~~~~

txz1314

介绍以你这个是怎莫用的

votasee

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

1. ''' ******************************************************************************
   - G/ e, H( y' x, j( C
2. ''Edit by votasee @ 090909 update 091010
   $ R, y) ~2 A" B# f( i! V7 @
3. '' ******************************************************************************
   4 Z  ~+ z/ R- ^& j
4. Dim swApp As Object
   
5.     Dim Part As Object
   . @/ w1 g( V3 Q/ k; G
6.     Dim Filename$, dwgFileName$
   7 \! B- [) Z: j( `9 ^7 v0 a2 J6 |8 B
7.     Dim No%, Title$, sTime$, sUserDir$
   
8. Sub main()
   0 A' B+ D& ?7 O# R7 O/ t9 m
9. Set swApp = Application.SldWorks
   $ ^) l' z, Q/ j  J- N, D7 [& b
10. Set Part = swApp.ActiveDoc
    
11. On Error Resume Next
    
12.     Filename = Part.GetPathName()
    % z7 q9 g; b8 u9 q: H5 _& l  O7 x
13.     sUserDir = VBA.Environ("USERPROFILE") & Chr(92) & Chr(-10304) & Chr(-15386) & Chr(92)
    2 R: b8 ?3 S% E  ~9 I# U
14.     sTime = Format(Time, "YYMMDD_hhmmss")
    
15.    
    
16.     Randomize
    8 I+ W) E2 L  R% b9 P+ C7 n
17.     If Filename = "" Then Filename = sUserDir & "Part" & Int(Rnd * 1000) & ".SLDDRW"
    6 g7 C4 Z: @& E% `
18. '    Part.SaveAs2 Filename, 0, 0, 0 ''''if need SLDDRW FILE,THEN DELETE MARK!
    
19.     No = Len(Filename)
    $ _7 l! X: M9 ?1 ]1 r( e7 z
20.     outFileName = Left(Filename, No - 7) & "_" & sTime & ".PDF"
    + J9 i9 A9 X$ p& n$ f; ^) ?: \
21.     Part.SaveAs2 outFileName, 0, 1, 0
    # |' v7 P6 i& ]  _6 W+ W) Z
22.     Title = Part.GetTitle
    - Z  Q8 T$ {+ W
23.     Set Part = Nothing
    & _- w& N; x0 q8 X3 M# e' X
24. '        swApp.CloseDoc Title
    
25.         swApp.Frame.SetStatusBarText Filename & "is SAVED!"
    
26. End Sub
    
27. 
    5 X0 j: b+ J: {& k. G2 i! I

复制代码