重命名零件和工程圖（圖紙升版本）

Dustry

在論壇看到大佬 怕瓦落地2011 的帖子http://www.odgf.cn/thread-1061682-1-1.html
代碼：

1. Dim swApp As Object
   4 h& d: K7 D- J! g5 q! h
2.   Dim Part As Object
   
3.   Dim Error As Long
   
4. Dim Warning As Long
   
5. Dim mip As String
   ( b) s' e3 W9 d* g+ |* M5 ]- Z
6. Dim Status As Boolean
     }6 E+ T; v* h7 m8 J  S$ E' B
7. Dim Newpath As String
   
8. Dim mipname As String
   ) ^6 n/ Z1 V( m$ |2 v) }
9. Dim vDepend() As String
   
10.     Sub main()
    / O* h+ X# D) v6 [( ~" M  {
11.     Set swApp = Application.SldWorks
    
12.     Set Part = swApp.ActiveDoc
    3 b' _$ V+ u# ]/ D' N9 j* E( W
13.     Set swSelMgr = Part.SelectionManager
    0 U+ V& E+ N6 ~0 q' h3 i
14.     Set swComp = swSelMgr.GetSelectedObjectsComponent4(1, 0)
    
15.         swComp.SetSuppression2 (3)
    
16.     Set swSelModel = swComp.GetModelDoc2
    
17.     Set swSelModelext = swSelModel.Extension
      x7 l. h2 @4 E; P6 [2 J; ^0 W
18. 
    5 M4 h+ L; _* d
19.     oldpathname = swComp.GetPathName
    0 R, z4 i/ G5 p% F6 F- J
20. 
    7 [" k* m, h! ~! b6 s
21.     Path = Left(oldpathname, InStrRev(oldpathname, "")) '路徑
    
22.     Debug.Print Path
    
23.     ntype = Mid(oldpathname, InStrRev(oldpathname, ".")) '后綴
    + I' \' I% \7 f  A# o8 O
24.     Debug.Print ntype
    
25.     oldfi = Mid(oldpathname, InStrRev(oldpathname, "") + 1) '舊文件名
    * c5 h7 G& w' Q! N' [" n
26.     Debug.Print oldfi
    5 {/ M5 o7 J' {5 ~( N
27.     oldname = Left(oldfi, InStrRev(oldfi, ".") - 1)
    
28.          mipname = InputBox("changename", "name", oldname) '新文件名
    3 n8 R' L3 }: Y2 K  z  ^' {# u
29. 
    " W" s/ j% q3 p6 R* H0 o
30.          mip = Path & mipname & ntype '新文件名帶路徑
    ! r! j6 m. d* _: l/ b0 K. `
31.          Debug.Print mip
      w" L4 k: I6 ~( [
32. 
    6 H7 O/ I, D0 q, W4 d- o$ ]& u
33.     If mip <> "" Then
    
34.          Status = swSelModelext.SaveAs3(mip, 0, 512, Nothing, Nothing, Error, Warning) '更改零件文件名（替換裝配體中的原文件）
    , K' V/ ]& i9 ]; Y
35.       Debug.Print Status
    
36.       '========================
    6 y, l2 F# {% G& J/ B# ?  F
37.       '更改工程圖文件名
      E- f9 h: s0 Y; V% h" X+ A4 y5 X
38.       Debug.Print Path
    # w2 H  w) |6 H# N
39.       tmpfi = Dir(Path & "*.SLDDRW") '遍歷原文件夾中的工程圖文件
    % _1 M  g: l6 y$ t" C2 o
40.       Debug.Print tmpfi
    
41.       Do Until tmpfi = Null
    ( |/ C. j4 [# c; B! J
42.         tmpfiname = Mid(tmpfi, InStrRev(tmpfi, "") + 1)
    & h# d, @8 a# l6 g. `* t) y
43.         Debug.Print tmpfiname
    + E6 S3 ?7 j  r& E: N, L5 k2 m3 r: o3 f
44.         tmpoldname = Mid(oldfi, 1, InStr(1, oldfi, ".") - 1) & ".SLDDRW"
    7 X* w5 ]: i8 u
45.         Debug.Print tmpoldname
    
46.         If tmpfiname = tmpoldname Then '查找同名工程圖
    
47.         newdrwname = Path & mipname & ".SLDDRW"
    
48.         Debug.Print newdrwname
    1 F3 g7 H# N+ P  T* M
49.         olddrwname = Path & tmpfi
    
50.         FileCopy olddrwname, newdrwname '復制工程圖到新文件夾
    ' d. n5 c" m% @( r
51.         vDepend = swApp.GetDocumentDependencies2(Path & tmpfi, False, False, False) '查找工程圖依賴
    ) q9 B' i. u2 k9 q3 _3 k
52. 
    2 j5 W2 g# R* `) v4 j
53.         Debug.Print vDepend(1)
    6 u6 T& ^- g. a: T0 i  O7 |
54.         bl = swApp.ReplaceReferencedDocument(newdrwname, vDepend(1), mip) '替換工程圖依賴
    7 L; x9 u' E5 B( J# `3 C/ D
55. 
    
56.         Debug.Print bl
    
57.          Exit Do
    * z' a* ?6 J) h1 @+ v1 U7 C* m; j
58.        End If
    
59.     tmpfi = Dir
    
60.     Debug.Print tmpfi
    ( G' q. k8 C, i- Q5 R
61.     Loop
    
62.     End If
    2 @7 g6 t+ m0 D$ b9 P
63.     End Sub
    

復制代碼

/ W0 y' C, X1 h% l6 A) K試了下這個宏（本人用的SW2018）報錯：
對象不支持這個屬性或方法（錯誤 438）
Status = swSelModelext.SaveAs3(mip, 0, 512, Nothing, Nothing, Error, Warning)  '更改零件文件名（替換裝配體中的原文件）
, m. r$ \: k% m; o% n: ?, r有哪位大佬能幫解答一下嗎？是不是SaceAs3語句的問題？

* k$ Y: k" j" e6 J+ S5 m

Lean_2017.feng

以下方法說明，請自行測試：
/ C5 J. ]! c& |' I
, ^& v1 m# E' S/ ['Usage
$ Q' v1 m/ s* V! o7 H& l% `) zIModelDocExtension.SaveAs3(Name, Version, Options, ExportData, AdvancedSaveAsOptions, Errors, Warnings)
( Y8 `" |: T- w0 _- I0 I
! V! `2 G% J: \
'Func Declaration
$ d! `+ w4 M+ ^+ k9 kFunction SaveAs3( _
: U* l- C$ U' R& N) Y. j   ByVal Name As System.String, _
   ByVal Version As System.Integer, _
; P0 X+ w1 Y! f' K' A$ x9 ~* D   ByVal Options As System.Integer, _
   ByVal ExportData As System.Object, _
7 F& G/ q. ~% M& z   ByVal AdvancedSaveAsOptions As System.Object, _
   ByRef Errors As System.Integer, _
5 v. E0 Y7 u% [5 L0 B   ByRef Warnings As System.Integer _
) As System.Boolean
8 |! ]. ]4 n5 H& z3 L
2 ~; p0 e/ k' @. FParameters
    Name
+ m+ ]( l2 A+ ], w& G& p        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)
  ?  J1 W& R3 U" w    Version
% O) B7 q0 s; a6 `2 h4 S7 W& B1 h3 @        Format in which to save this document as defined in swSaveAsVersion_e (see Remarks)
' {) [! {9 r# N$ \& g    Options
        Option indicating how to save the document as defined in swSaveAsOptions_e (see Remarks)
. M; u0 t  H/ \) ~% ]6 K    ExportData
        IExportPdfData object for exporting drawing sheets to PDF (see Remarks)
    AdvancedSaveAsOptions
  Y5 K9 }; O& }/ Z        IAdvancedSaveAsOptions (see Remarks)
8 T0 Q! \3 P+ K; t( r2 b# t    Errors
% c& w. ]3 t( _  R; @0 F        Errors that caused the save to fail as defined in swFileSaveError_e (see Remarks)
. |8 N$ E, N; F. b% P# a/ P    Warnings
: a- X& K; s2 ?: j        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


5 w* W: h" A6 D/ G+ a" A5 y內容摘自apihelp.chm（通常存于 xxx\SOLIDWORKS Corp\SOLIDWORKS\api\ ）

9 H( r% E$ Q+ `8 r6 ]' O


/ @; ]8 D+ n5 G- g/ `) F