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

Dustry

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

1. Dim swApp As Object
   " \! P& u2 ^( t* ]
2.   Dim Part As Object
   
3.   Dim Error As Long
   6 I8 Y& I+ I$ l- C
4. Dim Warning As Long
   1 Q1 }4 N1 L4 v3 @9 w
5. Dim mip As String
   ; W' m* P& B8 l, C& r1 J7 L* W
6. Dim Status As Boolean
   / K  Q0 _) J/ w9 g# n2 J; U8 \6 V  V* K' z5 n
7. Dim Newpath As String
   
8. Dim mipname As String
   
9. Dim vDepend() As String
   0 j9 W9 Z4 S1 u  T3 Q8 k$ _8 N
10.     Sub main()
    9 Z& B( v" G' L( l
11.     Set swApp = Application.SldWorks
    ' p6 U$ Y# C2 i$ I  d; x
12.     Set Part = swApp.ActiveDoc
    
13.     Set swSelMgr = Part.SelectionManager
    ; K9 G4 O& F+ p( y* \: g9 ^, ~: |
14.     Set swComp = swSelMgr.GetSelectedObjectsComponent4(1, 0)
    2 F& a9 B0 ?& u0 N# x
15.         swComp.SetSuppression2 (3)
    
16.     Set swSelModel = swComp.GetModelDoc2
    2 H9 i5 P' i4 A/ R
17.     Set swSelModelext = swSelModel.Extension
    
18. 
    3 |5 a8 R. R4 n+ b4 X$ }
19.     oldpathname = swComp.GetPathName
    # y3 a( t% @% z, ?
20. 
    
21.     Path = Left(oldpathname, InStrRev(oldpathname, "")) '路徑
    
22.     Debug.Print Path
    
23.     ntype = Mid(oldpathname, InStrRev(oldpathname, ".")) '后綴
    
24.     Debug.Print ntype
    
25.     oldfi = Mid(oldpathname, InStrRev(oldpathname, "") + 1) '舊文件名
    " |' l+ ?: P$ |  [9 P( ?
26.     Debug.Print oldfi
    
27.     oldname = Left(oldfi, InStrRev(oldfi, ".") - 1)
    2 p" m& `/ @- V( Q/ m+ v) D$ N& c5 ^
28.          mipname = InputBox("changename", "name", oldname) '新文件名
    8 D) R' y9 t& B6 h  o
29. 
    
30.          mip = Path & mipname & ntype '新文件名帶路徑
    / H* l/ c' G6 _. s8 X
31.          Debug.Print mip
    & c! D+ i7 s6 b/ L8 k
32. 
    7 n6 H% V/ {8 t5 O+ |! @
33.     If mip <> "" Then
    6 V7 f$ f2 d7 J  P, L9 ^9 L) T, g
34.          Status = swSelModelext.SaveAs3(mip, 0, 512, Nothing, Nothing, Error, Warning) '更改零件文件名（替換裝配體中的原文件）
    
35.       Debug.Print Status
    
36.       '========================
    ' G& r2 o% u% C1 v4 X
37.       '更改工程圖文件名
    * a* S; ]5 o$ Y# L
38.       Debug.Print Path
    / G' T7 a' p* q; B! L$ |7 w
39.       tmpfi = Dir(Path & "*.SLDDRW") '遍歷原文件夾中的工程圖文件
    2 Y) N* k0 O4 j5 c7 h1 s
40.       Debug.Print tmpfi
    
41.       Do Until tmpfi = Null
    4 w& r+ k, k4 j) Z
42.         tmpfiname = Mid(tmpfi, InStrRev(tmpfi, "") + 1)
    / v* v5 {* C7 o$ d1 t
43.         Debug.Print tmpfiname
    - D# }7 ^* d2 h6 Y; w3 u6 p# X
44.         tmpoldname = Mid(oldfi, 1, InStr(1, oldfi, ".") - 1) & ".SLDDRW"
    3 {& A' C) q  i- ?" q& N. x
45.         Debug.Print tmpoldname
    
46.         If tmpfiname = tmpoldname Then '查找同名工程圖
    8 ]$ a3 _4 e; E5 O
47.         newdrwname = Path & mipname & ".SLDDRW"
      M* r8 h3 C5 X" r
48.         Debug.Print newdrwname
    & L$ h: X4 Z" k- A* Q+ p
49.         olddrwname = Path & tmpfi
    
50.         FileCopy olddrwname, newdrwname '復制工程圖到新文件夾
    
51.         vDepend = swApp.GetDocumentDependencies2(Path & tmpfi, False, False, False) '查找工程圖依賴
    
52. 
    
53.         Debug.Print vDepend(1)
    9 g/ L$ \* a" w
54.         bl = swApp.ReplaceReferencedDocument(newdrwname, vDepend(1), mip) '替換工程圖依賴
    3 p0 B+ x, K; n" W2 x& W7 a5 Z
55. 
    6 O( n$ z4 r6 r7 A# e  K/ @
56.         Debug.Print bl
    + ?! Q- Q9 C5 h, [0 a* I
57.          Exit Do
    
58.        End If
    9 ^6 ?  i  @! E( ~4 R: N3 e* p+ T
59.     tmpfi = Dir
    
60.     Debug.Print tmpfi
    
61.     Loop
    
62.     End If
    6 J# A# C5 u  k* Z6 H
63.     End Sub
    

復制代碼

3 ^" r7 }$ g- j7 i% p- s: T# g# u2 {試了下這個宏（本人用的SW2018）報錯：
( J5 v( J/ J& m; w/ x" f5 i: u1 V對象不支持這個屬性或方法（錯誤 438）
/ x9 P* e* J" qStatus = swSelModelext.SaveAs3(mip, 0, 512, Nothing, Nothing, Error, Warning)  '更改零件文件名（替換裝配體中的原文件）
" u6 a# ]  {: ~. A# n+ q% l1 t有哪位大佬能幫解答一下嗎？是不是SaceAs3語句的問題？

( b5 A! y: M8 ?, n2 g1 Q( L

Lean_2017.feng

以下方法說明，請自行測試：
' A! ~9 _* E  Z; f0 S' l) V% o
) Y3 t4 z" S6 q5 k'Usage
1 v: t# q, j; Z6 n/ S1 F0 y) CIModelDocExtension.SaveAs3(Name, Version, Options, ExportData, AdvancedSaveAsOptions, Errors, Warnings)
, k8 U, v' N- d6 d' N
$ N. ]" Z7 F+ A0 y' V/ A
'Func Declaration
Function SaveAs3( _
   ByVal Name As System.String, _
1 j* i! e& i0 r: V   ByVal Version As System.Integer, _
   ByVal Options As System.Integer, _
   ByVal ExportData As System.Object, _
   ByVal AdvancedSaveAsOptions As System.Object, _
   ByRef Errors As System.Integer, _
   ByRef Warnings As System.Integer _
) As System.Boolean
2 G! c# p; x! G
# `( L5 c  D* l2 P4 [. `+ y/ d* {Parameters
    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)
5 _" ^4 T0 J$ Y    Version
" e% y0 z& O! u3 u- Y% E5 \        Format in which to save this document as defined in swSaveAsVersion_e (see Remarks)
    Options
        Option indicating how to save the document as defined in swSaveAsOptions_e (see Remarks)
    ExportData
) J' L/ u& s8 I: ]        IExportPdfData object for exporting drawing sheets to PDF (see Remarks)
    AdvancedSaveAsOptions
        IAdvancedSaveAsOptions (see Remarks)
& j5 E% r; d% K. u/ D# e    Errors
+ _9 |$ y; K5 ?$ C# h        Errors that caused the save to fail as defined in swFileSaveError_e (see Remarks)
    Warnings
        Warnings or extra information generated during the save operation as defined in swFileSaveWarning_e (see Remarks)
: g6 |3 w! _, _0 kReturn Value
    True if the save is successful, false if not

. b* ~6 S- c  x$ ~
內容摘自apihelp.chm（通常存于 xxx\SOLIDWORKS Corp\SOLIDWORKS\api\ ）

LIULISHAN

拿去
Status = swSelModelext.SaveAs2(mip, 0, 512, Nothing, "", False, Error, Warning) '更改零件文件名（替換裝配體中的原文件）

LIULISHAN

( X' j' i9 `% K+ q. Q. O8 ]拿去，不用謝
$ a, _7 ^) o& X4 Z- s6 pStatus = swSelModelext.SaveAs2(mip, 0, 512, Nothing, "", False, Error, Warning) '更改零件文件名（替換裝配體中的原文件）