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

liuxinwei

哪位高手可以帮忙修改一下宏，我需要转换工程图保存时自动保存到桌面上，工程图名称也是自动复制零件的名称，我改了几天了，搞不定了。只有请教高手了，先谢谢了
Sub main()
Set swApp = Application.SldWorks
9 R# w" U& a2 F2 DSet Part = swApp.ActiveDoc
Filename = Part.GetPathName()
: c# F( ]5 K) v5 H) D7 Y- G' u* L1 JNo = Len(Filename)
Filename = Left(Filename, No - 7)
8 N% R8 X8 m5 e( B" BPart.SaveAs2 Filename & ".pdf", 0, True, False
X = MsgBox(" 已保存为 pdf 文件 ", 0)
+ e5 t" d7 o' k4 M2 SEnd Sub

飞天鸟

1、这个No名字不好，而且在宏中没有使用啊~~~
2、应当指定对象数据类型 dim Part as ModelDoc2
+ I' o7 R# U% |. W8 x, v" G3、试一试另一个保存函数 Part.SaveAs3(BackupFullName, 0, 0)

飞天鸟

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

yjyeming

Sub main()
5 m' z" ^! G' aSet swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
- k) Z& N, n' q% v, t  V' EFileName = Part.GetPathName()
n = Len(FileName)
no = InStrRev(FileName, "\")
FileName = Mid(FileName, no + 1, n - no - 7)
: q4 k$ e9 b6 _Part.SaveAs3 "C:\Documents and Settings\Administrator\桌面\" & FileName & ".PDF", 0, 0
X = MsgBox(" 已保存为 pdf 文件 ", 0)
- G' M# I0 \) o8 R: |0 IEnd Sub

远征龙

yjyeming 发表于 2012-4-27 16:29 static/image/common/back.gif
8 t9 S' j8 w" l6 nSub main()
Set swApp = Application.SldWorks
7 x. w5 o% Z/ l0 T; m9 kSet Part = swApp.ActiveDoc

' t4 h" Q# Y* h4 J1 b, }8 ^感谢分享啊~~~~

txz1314

介绍以你这个是怎莫用的

votasee

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

1. ''' ******************************************************************************
   
2. ''Edit by votasee @ 090909 update 091010
   " o3 {6 i/ F$ l7 I% y
3. '' ******************************************************************************
   3 a+ T' V9 @9 k3 ?  e% n2 ^* ?* W
4. Dim swApp As Object
   ; r% m* t3 y# V" k9 ~
5.     Dim Part As Object
   
6.     Dim Filename$, dwgFileName$
   + g  S& m+ n6 _2 h1 {' f& Q
7.     Dim No%, Title$, sTime$, sUserDir$
   
8. Sub main()
   
9. Set swApp = Application.SldWorks
   9 A7 \8 j! X% s) s* h
10. Set Part = swApp.ActiveDoc
    - X2 @" X4 O# w- O) j) F" p
11. On Error Resume Next
    
12.     Filename = Part.GetPathName()
    
13.     sUserDir = VBA.Environ("USERPROFILE") & Chr(92) & Chr(-10304) & Chr(-15386) & Chr(92)
    
14.     sTime = Format(Time, "YYMMDD_hhmmss")
    " d& F# T+ K/ l( p) _+ w6 U
15.    
    
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!
    
19.     No = Len(Filename)
    
20.     outFileName = Left(Filename, No - 7) & "_" & sTime & ".PDF"
    - q8 Q/ D* C. n& B
21.     Part.SaveAs2 outFileName, 0, 1, 0
    % o$ S( O* Q( X* G1 F
22.     Title = Part.GetTitle
    
23.     Set Part = Nothing
    5 M9 Q" A6 _; V, g! M! K+ ?
24. '        swApp.CloseDoc Title
    
25.         swApp.Frame.SetStatusBarText Filename & "is SAVED!"
    
26. End Sub
    " R* j, P1 R( V0 G" A3 v3 J
27. 
    4 [2 q# e  H7 `. Z  O

复制代码