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

Dustry

在論壇看到大佬 怕瓦落地2011 的帖子http://www.mg7058.com/thread-1061682-1-1.html
& ?2 p' E' H4 b$ B代碼：

1. Dim swApp As Object
     b4 G! Y: q. o" l3 O
2.   Dim Part As Object
   
3.   Dim Error As Long
   ! |) l7 @# c6 x2 w4 h+ L
4. Dim Warning As Long
   / V0 ~% J' Z1 \* J
5. Dim mip As String
   
6. Dim Status As Boolean
   / m* e0 g) n7 a4 e# U# n( T/ H
7. Dim Newpath As String
   
8. Dim mipname As String
   
9. Dim vDepend() As String
   
10.     Sub main()
    , ]  ^3 M0 M! o' c1 a
11.     Set swApp = Application.SldWorks
    " n) O+ [, L% ^1 [, W3 Z) x
12.     Set Part = swApp.ActiveDoc
    
13.     Set swSelMgr = Part.SelectionManager
    5 ?3 P9 ?$ S/ {" i. \4 ~
14.     Set swComp = swSelMgr.GetSelectedObjectsComponent4(1, 0)
    3 d: g% U% Y+ f$ b7 \6 N+ \
15.         swComp.SetSuppression2 (3)
    
16.     Set swSelModel = swComp.GetModelDoc2
    % v( Z, a9 o5 X" e' q
17.     Set swSelModelext = swSelModel.Extension
    2 M- s) m( L8 m. D( A) i, K
18. 
    
19.     oldpathname = swComp.GetPathName
    ; d: Z% {& Y- [: @' N  c. u+ s1 x
20. 
    9 ~  H5 J" _' T* [3 d- v4 p
21.     Path = Left(oldpathname, InStrRev(oldpathname, "")) '路徑
    ( V- F3 C  G. d: ^
22.     Debug.Print Path
    . q; O4 U0 X* G, I
23.     ntype = Mid(oldpathname, InStrRev(oldpathname, ".")) '后綴
    & B" o" I5 t- c2 L3 `1 C
24.     Debug.Print ntype
    
25.     oldfi = Mid(oldpathname, InStrRev(oldpathname, "") + 1) '舊文件名
    5 ?! ~; F4 F$ g
26.     Debug.Print oldfi
    ' O4 h5 p7 l6 I2 f
27.     oldname = Left(oldfi, InStrRev(oldfi, ".") - 1)
    
28.          mipname = InputBox("changename", "name", oldname) '新文件名
    
29. 
    * o/ C9 E5 {) R
30.          mip = Path & mipname & ntype '新文件名帶路徑
    % ~3 C& {$ f1 F6 E; ~
31.          Debug.Print mip
    0 y1 ~$ D# u0 e+ `; n; M! ~' W
32. 
    & F; L4 a; Y4 Y& y: h) ]/ B  O
33.     If mip <> "" Then
    + e% x* A3 k3 r! R% y
34.          Status = swSelModelext.SaveAs3(mip, 0, 512, Nothing, Nothing, Error, Warning) '更改零件文件名（替換裝配體中的原文件）
    
35.       Debug.Print Status
    
36.       '========================
    8 ]: q/ w, @. N- \. q
37.       '更改工程圖文件名
    & `! _2 p9 l% M( @9 a% H
38.       Debug.Print Path
    
39.       tmpfi = Dir(Path & "*.SLDDRW") '遍歷原文件夾中的工程圖文件
    
40.       Debug.Print tmpfi
    : X  M# F  s) u2 S; e6 |
41.       Do Until tmpfi = Null
    - [, i3 p$ E2 l3 y+ G
42.         tmpfiname = Mid(tmpfi, InStrRev(tmpfi, "") + 1)
    ( f4 ~/ C) v4 H5 N0 D
43.         Debug.Print tmpfiname
    
44.         tmpoldname = Mid(oldfi, 1, InStr(1, oldfi, ".") - 1) & ".SLDDRW"
    
45.         Debug.Print tmpoldname
    2 E7 a) W: C# }5 \4 O
46.         If tmpfiname = tmpoldname Then '查找同名工程圖
    
47.         newdrwname = Path & mipname & ".SLDDRW"
    ( v! l! ~0 \/ B; {; y" h) @
48.         Debug.Print newdrwname
    ; ]( i1 @* b4 V( v$ S$ f
49.         olddrwname = Path & tmpfi
    9 ?/ R% q1 K7 B( j
50.         FileCopy olddrwname, newdrwname '復制工程圖到新文件夾
    - e) U$ N6 s2 J# }0 i( [6 d+ w
51.         vDepend = swApp.GetDocumentDependencies2(Path & tmpfi, False, False, False) '查找工程圖依賴
    
52. 
    
53.         Debug.Print vDepend(1)
    
54.         bl = swApp.ReplaceReferencedDocument(newdrwname, vDepend(1), mip) '替換工程圖依賴
    * Z$ F9 i# z& Z% \7 {1 E
55. 
    ) l6 G- j8 Z  O8 K9 w
56.         Debug.Print bl
    5 S5 ~0 \( g8 P2 F: l: V7 e
57.          Exit Do
    3 {; C$ E6 A* H0 N5 K, c
58.        End If
    ( p* L9 K$ s: ~. I. d
59.     tmpfi = Dir
    ) t  [$ S  Y1 [# ~+ |3 N" K0 f
60.     Debug.Print tmpfi
    
61.     Loop
    
62.     End If
    % Y. ^) z5 v: m9 K6 L
63.     End Sub
    0 t) h$ ~( k4 v

復制代碼

# n' [4 t+ H0 U7 `9 P試了下這個宏（本人用的SW2018）報錯：
$ d  B" R9 Y/ }0 M0 U+ q對象不支持這個屬性或方法（錯誤 438）
5 b3 R1 ~+ U' s6 Z/ K5 A2 @Status = swSelModelext.SaveAs3(mip, 0, 512, Nothing, Nothing, Error, Warning)  '更改零件文件名（替換裝配體中的原文件）
有哪位大佬能幫解答一下嗎？是不是SaceAs3語句的問題？
. O; F; l" I3 t% R+ n. V9 T6 j

Lean_2017.feng

以下方法說明，請自行測試：
; j8 _# u" Z1 H
/ I+ O% f$ l6 A& O7 V( r  ^'Usage
& _; }/ E) V5 J7 mIModelDocExtension.SaveAs3(Name, Version, Options, ExportData, AdvancedSaveAsOptions, Errors, Warnings)
1 J$ T. o3 ?! K: S0 X8 e: e5 |- F
: m1 P- ?( w  [3 M+ M
'Func Declaration
Function SaveAs3( _
   ByVal Name As System.String, _
6 Q$ X' d  T& Y5 h7 q0 T   ByVal Version As System.Integer, _
   ByVal Options As System.Integer, _
# {6 }* ^* f" A! h   ByVal ExportData As System.Object, _
2 ?$ j9 a& u& w' n; ]6 q" T) N0 ^   ByVal AdvancedSaveAsOptions As System.Object, _
   ByRef Errors As System.Integer, _
/ W7 `  M1 v" _5 ^   ByRef Warnings As System.Integer _
5 c" H! B7 J, i0 n. O' m) As System.Boolean

Parameters
    Name
+ U: R& r- L$ B+ v8 ~        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
1 u6 i0 `. H9 B# r$ ^5 `        Format in which to save this document as defined in swSaveAsVersion_e (see Remarks)
    Options
" F/ E* U7 ^3 b; T# d4 ]; }  _# ^        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)
9 Y+ R9 }2 F; H4 w7 R    AdvancedSaveAsOptions
        IAdvancedSaveAsOptions (see Remarks)
    Errors
# R9 K7 t  _! ^& U& n% P% c5 s        Errors that caused the save to fail as defined in swFileSaveError_e (see Remarks)
    Warnings
# J3 T0 f! B6 [  z% P        Warnings or extra information generated during the save operation as defined in swFileSaveWarning_e (see Remarks)
/ E# i% d# j7 z, pReturn Value
# O, [3 d9 T( |    True if the save is successful, false if not
6 k! _" f' u5 ~, f: ]; C. J
  l  L4 O. E" C: H
- b; Q0 f+ A7 Q. j, \內(nèi)容摘自apihelp.chm（通常存于 xxx\SOLIDWORKS Corp\SOLIDWORKS\api\ ）
* K. l2 p# Z2 `


+ h( Z# D- t+ ]7 T! j; u