重命名零件和工程图（图纸升版本）

Dustry

在论坛看到大佬 怕瓦落地2011 的帖子http://www.cmiw.cn/thread-1061682-1-1.html
代码：

1. Dim swApp As Object
   , D& D3 Y8 ^) L/ j- k! P
2.   Dim Part As Object
   7 l5 H' j( R" E
3.   Dim Error As Long
   
4. Dim Warning As Long
   
5. Dim mip As String
   6 _0 i. k% z# t
6. Dim Status As Boolean
   
7. Dim Newpath As String
   2 J' P" k* U! ~2 ], Y+ |; M2 L
8. Dim mipname As String
   
9. Dim vDepend() As String
   
10.     Sub main()
    * M$ E5 ]$ M0 y5 }$ s8 P( |! v2 ~
11.     Set swApp = Application.SldWorks
    
12.     Set Part = swApp.ActiveDoc
    
13.     Set swSelMgr = Part.SelectionManager
    $ y8 Y! G; q1 |# L1 j, t/ |& @; o
14.     Set swComp = swSelMgr.GetSelectedObjectsComponent4(1, 0)
    8 O: c& ~9 x: i2 P& Q( M2 I
15.         swComp.SetSuppression2 (3)
    
16.     Set swSelModel = swComp.GetModelDoc2
    8 i" W. L: n/ h' ?7 u2 A
17.     Set swSelModelext = swSelModel.Extension
    
18. 
    5 ^  j" v% \# ?  ]
19.     oldpathname = swComp.GetPathName
    
20. 
    5 U. S$ F* D. H" A
21.     Path = Left(oldpathname, InStrRev(oldpathname, "")) '路径
    
22.     Debug.Print Path
    - f. D$ }! @. Y) x, |# ~/ F
23.     ntype = Mid(oldpathname, InStrRev(oldpathname, ".")) '后缀
    
24.     Debug.Print ntype
    # ]* d/ N2 c2 n. B+ q5 \, Y
25.     oldfi = Mid(oldpathname, InStrRev(oldpathname, "") + 1) '旧文件名
    
26.     Debug.Print oldfi
    
27.     oldname = Left(oldfi, InStrRev(oldfi, ".") - 1)
    8 r: g' w/ B7 l! A
28.          mipname = InputBox("changename", "name", oldname) '新文件名
    
29. 
    
30.          mip = Path & mipname & ntype '新文件名带路径
    " V" U: O& X: j4 [! g
31.          Debug.Print mip
      Q) ~) a" W; S
32. 
    ! Y$ X2 L- S# g( ]: z/ h  e4 s
33.     If mip <> "" Then
    
34.          Status = swSelModelext.SaveAs3(mip, 0, 512, Nothing, Nothing, Error, Warning) '更改零件文件名（替换装配体中的原文件）
    4 {3 Y% r' B) s. V
35.       Debug.Print Status
    2 Z: l  N, w! I  Q
36.       '========================
    0 V/ u; I# z% L. U7 d& d
37.       '更改工程图文件名
    ! h2 c2 ~8 |2 t. L' g  A8 d: s+ Y7 W
38.       Debug.Print Path
    7 r8 }$ Y0 Y7 d. t5 R
39.       tmpfi = Dir(Path & "*.SLDDRW") '遍历原文件夹中的工程图文件
    
40.       Debug.Print tmpfi
    
41.       Do Until tmpfi = Null
    
42.         tmpfiname = Mid(tmpfi, InStrRev(tmpfi, "") + 1)
    # E% D6 {9 `, Y1 V; X, k" P1 N2 E
43.         Debug.Print tmpfiname
    ) y+ C( y+ |3 N9 d" S4 F( r7 `4 i6 R7 j
44.         tmpoldname = Mid(oldfi, 1, InStr(1, oldfi, ".") - 1) & ".SLDDRW"
    
45.         Debug.Print tmpoldname
    
46.         If tmpfiname = tmpoldname Then '查找同名工程图
    9 _. {7 C# M7 f8 P, Q8 i
47.         newdrwname = Path & mipname & ".SLDDRW"
    
48.         Debug.Print newdrwname
    " [# R/ A+ m5 F0 y
49.         olddrwname = Path & tmpfi
    3 [- A, M' _0 P& ]
50.         FileCopy olddrwname, newdrwname '复制工程图到新文件夹
    
51.         vDepend = swApp.GetDocumentDependencies2(Path & tmpfi, False, False, False) '查找工程图依赖
    1 K- p5 n) Z! f: f$ }
52. 
    
53.         Debug.Print vDepend(1)
    5 n/ F- T; v8 ?# S) O1 S4 [& V0 w
54.         bl = swApp.ReplaceReferencedDocument(newdrwname, vDepend(1), mip) '替换工程图依赖
    
55. 
    
56.         Debug.Print bl
    % x8 J  l  }5 k( t8 P$ e! h
57.          Exit Do
    
58.        End If
    5 t: ^6 H/ B( x- B# X2 e7 b
59.     tmpfi = Dir
    
60.     Debug.Print tmpfi
    
61.     Loop
    
62.     End If
    
63.     End Sub
    

复制代码

9 {- m; R- H: S6 r试了下这个宏（本人用的SW2018）报错：
$ Z$ S. U4 e4 r$ f: n- T) a对象不支持这个属性或方法（错误 438）
Status = swSelModelext.SaveAs3(mip, 0, 512, Nothing, Nothing, Error, Warning)  '更改零件文件名（替换装配体中的原文件）
有哪位大佬能帮解答一下吗？是不是SaceAs3语句的问题？
: r4 U6 N( N2 J* h
8 z, N0 d2 _! r, m1 F+ D) ?$ x

Lean_2017.feng

以下方法说明，请自行测试：

3 m. Z! k  C. J2 \'Usage
- e& G* k- l, o8 }& z+ WIModelDocExtension.SaveAs3(Name, Version, Options, ExportData, AdvancedSaveAsOptions, Errors, Warnings)
) J2 }2 Y- e  w) _8 Q  B4 N
5 C; m6 \* _3 c  z* ?# f1 X
0 m+ @& I5 U0 ?9 _- d& M'Func Declaration
Function SaveAs3( _
   ByVal Name As System.String, _
' {; T. M! }! E( T# o( C/ ?   ByVal Version As System.Integer, _
2 v) a$ z) T( W, L/ K! B9 M0 R   ByVal Options As System.Integer, _
9 l9 ?6 V+ ^- B% f   ByVal ExportData As System.Object, _
& u; G7 u9 R3 ^' Z/ F" O   ByVal AdvancedSaveAsOptions As System.Object, _
7 I' v: y9 Z* q9 X   ByRef Errors As System.Integer, _
   ByRef Warnings As System.Integer _
) As System.Boolean
% q  Y% D5 |, V. N9 s
1 N# k' C% c* `$ BParameters
    Name
        Full pathname of the document to save; the file extension indicates any conversion that should be performed (for example, Part1.igs to save in IGES format) (see Remarks)
    Version
4 _9 P2 s0 j5 _1 ^# m4 \8 Q8 @+ X+ I        Format in which to save this document as defined in swSaveAsVersion_e (see Remarks)
% M! Q& }! r$ R' p" X    Options
        Option indicating how to save the document as defined in swSaveAsOptions_e (see Remarks)
    ExportData
        IExportPdfData object for exporting drawing sheets to PDF (see Remarks)
    AdvancedSaveAsOptions
        IAdvancedSaveAsOptions (see Remarks)
    Errors
        Errors that caused the save to fail as defined in swFileSaveError_e (see Remarks)
+ }1 G5 {( G  w  \0 m    Warnings
7 ]! T0 N4 J+ Q! o) ]        Warnings or extra information generated during the save operation as defined in swFileSaveWarning_e (see Remarks)
Return Value
    True if the save is successful, false if not
- _/ ?  y. `0 D4 Q) A( R7 G
( o8 I2 R6 q2 |; P7 q! s
内容摘自apihelp.chm（通常存于 xxx\SOLIDWORKS Corp\SOLIDWORKS\api\ ）
1 }/ k# j- G& k% @( ^

4 X* j( G8 u: X5 b
! c/ y5 ]+ @3 a8 D0 E1 ]- C
& P" P" u  D" t$ a7 S8 ^! t- e

LIULISHAN

拿去
8 r4 q" a) ~  k- ]. p0 h; V) P- `Status = swSelModelext.SaveAs2(mip, 0, 512, Nothing, "", False, Error, Warning) '更改零件文件名（替换装配体中的原文件）

LIULISHAN

) ^$ m" u& k9 L( F拿去，不用谢
Status = swSelModelext.SaveAs2(mip, 0, 512, Nothing, "", False, Error, Warning) '更改零件文件名（替换装配体中的原文件）
4 |! @0 t& A" c0 f5 D1 x2 v