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

liuxinwei

哪位高手可以帮忙修改一下宏，我需要转换工程图保存时自动保存到桌面上，工程图名称也是自动复制零件的名称，我改了几天了，搞不定了。只有请教高手了，先谢谢了
Sub main()
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
Filename = Part.GetPathName()
No = Len(Filename)
8 r7 q) ^0 X. e. k  ^Filename = Left(Filename, No - 7)
Part.SaveAs2 Filename & ".pdf", 0, True, False
X = MsgBox(" 已保存为 pdf 文件 ", 0)
& Y9 p# p0 U3 D" sEnd Sub

飞天鸟

1、这个No名字不好，而且在宏中没有使用啊~~~
  S9 ~  ]( D0 q/ x2、应当指定对象数据类型 dim Part as ModelDoc2
4 l. \+ h9 p; B, ~+ h. H- J3、试一试另一个保存函数 Part.SaveAs3(BackupFullName, 0, 0)

飞天鸟

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

yjyeming

Sub main()
: H+ T' L& q% x$ {3 t3 v) x+ USet swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
FileName = Part.GetPathName()
n = Len(FileName)
7 @4 e2 U" f, M0 hno = InStrRev(FileName, "\")
FileName = Mid(FileName, no + 1, n - no - 7)
Part.SaveAs3 "C:\Documents and Settings\Administrator\桌面\" & FileName & ".PDF", 0, 0
9 g% j8 s- Q3 I, \0 F. i1 KX = MsgBox(" 已保存为 pdf 文件 ", 0)
End Sub

远征龙

yjyeming 发表于 2012-4-27 16:29 static/image/common/back.gif
/ V1 s3 N4 X" @Sub main()
Set swApp = Application.SldWorks
+ x  G# b  u/ rSet Part = swApp.ActiveDoc

感谢分享啊~~~~

txz1314

介绍以你这个是怎莫用的

votasee

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

1. ''' ******************************************************************************
   & P1 _9 O' L4 }- x
2. ''Edit by votasee @ 090909 update 091010
   - S5 C& f7 o& f- e' k
3. '' ******************************************************************************
   , M, u; q( i8 {6 I
4. Dim swApp As Object
   / v5 t6 g1 w7 J
5.     Dim Part As Object
   - i8 W% A% m5 y
6.     Dim Filename$, dwgFileName$
   ) s6 t/ D) o+ x3 j9 s) J
7.     Dim No%, Title$, sTime$, sUserDir$
   
8. Sub main()
   
9. Set swApp = Application.SldWorks
   * {& r$ g7 K5 ~) Y8 |* R
10. Set Part = swApp.ActiveDoc
    * T* ^9 `! e1 v- ~# r
11. On Error Resume Next
    
12.     Filename = Part.GetPathName()
    
13.     sUserDir = VBA.Environ("USERPROFILE") & Chr(92) & Chr(-10304) & Chr(-15386) & Chr(92)
    0 x) q" N( j, L, X1 a
14.     sTime = Format(Time, "YYMMDD_hhmmss")
    $ i' o9 f  A1 ~) G! a
15.    
      \$ q7 M/ K7 o! l, c5 G1 Z" Y
16.     Randomize
    
17.     If Filename = "" Then Filename = sUserDir & "Part" & Int(Rnd * 1000) & ".SLDDRW"
    
18. '    Part.SaveAs2 Filename, 0, 0, 0 ''''if need SLDDRW FILE,THEN DELETE MARK!
    , A8 C) i0 ]* h5 C/ `* \, c
19.     No = Len(Filename)
    1 O. S& \7 r' h( @; M& z
20.     outFileName = Left(Filename, No - 7) & "_" & sTime & ".PDF"
    + H. n+ R) P0 q. B* ^6 {
21.     Part.SaveAs2 outFileName, 0, 1, 0
    
22.     Title = Part.GetTitle
    1 ]- _: Q; \$ M9 Q2 n- n9 `
23.     Set Part = Nothing
    
24. '        swApp.CloseDoc Title
    $ t3 g) O8 b& Y* A( R- u
25.         swApp.Frame.SetStatusBarText Filename & "is SAVED!"
    # K2 s- ~  M( m1 E( X% K  Z( [
26. End Sub
    
27. 
    

复制代码