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

Dustry

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

1. Dim swApp As Object
   ' X  |' \+ B! t! [$ O
2.   Dim Part As Object
   6 ]/ [; W! |( g( @1 w8 p3 g# [! C
3.   Dim Error As Long
   5 u% c% e5 v& g1 u/ g5 M  u
4. Dim Warning As Long
   
5. Dim mip As String
   7 L1 D& V2 j+ w! e$ A
6. Dim Status As Boolean
   
7. Dim Newpath As String
   0 _8 c* U+ M* d# s" a
8. Dim mipname As String
   
9. Dim vDepend() As String
   
10.     Sub main()
    
11.     Set swApp = Application.SldWorks
    
12.     Set Part = swApp.ActiveDoc
    
13.     Set swSelMgr = Part.SelectionManager
    
14.     Set swComp = swSelMgr.GetSelectedObjectsComponent4(1, 0)
    9 i+ N* k' e$ W- \
15.         swComp.SetSuppression2 (3)
    ) ?8 I6 x+ {/ T: g
16.     Set swSelModel = swComp.GetModelDoc2
    ; d6 v) W3 @+ T
17.     Set swSelModelext = swSelModel.Extension
    % t( V' x% b4 |3 A% T- p
18. 
    ' \4 D! g, c1 i- _0 ]- }
19.     oldpathname = swComp.GetPathName
    : e# l% x* j, p" e+ k1 ]" P5 o
20. 
    1 k& Z9 k& `6 J2 L/ o* o
21.     Path = Left(oldpathname, InStrRev(oldpathname, "")) '路徑
    4 ~# h* S; G5 R/ }9 Z) D# T9 h
22.     Debug.Print Path
    4 a$ B( @: Y$ V, A% H
23.     ntype = Mid(oldpathname, InStrRev(oldpathname, ".")) '后綴
    1 r8 h5 s6 F) M! C
24.     Debug.Print ntype
    / ^0 ~; |% J4 F1 ^6 ^* U
25.     oldfi = Mid(oldpathname, InStrRev(oldpathname, "") + 1) '舊文件名
    6 N/ }+ p  y* I7 I6 [
26.     Debug.Print oldfi
    , L2 v6 s5 c+ \0 e0 z, I, z
27.     oldname = Left(oldfi, InStrRev(oldfi, ".") - 1)
    ! i' [" x* `" z" Q! n, k$ J
28.          mipname = InputBox("changename", "name", oldname) '新文件名
    " I/ Y9 l  L* N. [( [! w
29. 
    % Q, V4 H; }: y9 X4 u" X6 T
30.          mip = Path & mipname & ntype '新文件名帶路徑
    
31.          Debug.Print mip
    
32. 
    2 k* \% N4 j& r* j) L3 \
33.     If mip <> "" Then
    
34.          Status = swSelModelext.SaveAs3(mip, 0, 512, Nothing, Nothing, Error, Warning) '更改零件文件名（替換裝配體中的原文件）
    
35.       Debug.Print Status
    8 {. I  u! N. Y4 v, q3 g" T& r
36.       '========================
    
37.       '更改工程圖文件名
    
38.       Debug.Print Path
    % ~- \  \8 [) F9 g! L4 E6 _
39.       tmpfi = Dir(Path & "*.SLDDRW") '遍歷原文件夾中的工程圖文件
    ! l6 q3 P: V% Y: V
40.       Debug.Print tmpfi
    
41.       Do Until tmpfi = Null
    ; E3 j6 H1 L+ n" N" z" w
42.         tmpfiname = Mid(tmpfi, InStrRev(tmpfi, "") + 1)
    
43.         Debug.Print tmpfiname
    
44.         tmpoldname = Mid(oldfi, 1, InStr(1, oldfi, ".") - 1) & ".SLDDRW"
    ! i  a! _9 X/ U+ E* S& B
45.         Debug.Print tmpoldname
    
46.         If tmpfiname = tmpoldname Then '查找同名工程圖
    
47.         newdrwname = Path & mipname & ".SLDDRW"
    
48.         Debug.Print newdrwname
    
49.         olddrwname = Path & tmpfi
    
50.         FileCopy olddrwname, newdrwname '復制工程圖到新文件夾
    
51.         vDepend = swApp.GetDocumentDependencies2(Path & tmpfi, False, False, False) '查找工程圖依賴
    
52. 
    3 r5 Y* _, K  U5 R8 x7 V
53.         Debug.Print vDepend(1)
    * f& D/ N+ A& S0 G8 J' e
54.         bl = swApp.ReplaceReferencedDocument(newdrwname, vDepend(1), mip) '替換工程圖依賴
    
55. 
    
56.         Debug.Print bl
    
57.          Exit Do
    
58.        End If
    7 z$ s( U6 @9 L
59.     tmpfi = Dir
    # ?: A' o8 l  z: D& U  y
60.     Debug.Print tmpfi
    - `2 ?/ c; r1 m' i" r, }  j
61.     Loop
    
62.     End If
    - j, Y# t4 d( M1 C7 R% z2 N
63.     End Sub
    2 b  V: B9 _! n) J* A8 K

復制代碼

/ |0 y3 O( F$ i( l, m試了下這個宏（本人用的SW2018）報錯：
對象不支持這個屬性或方法（錯誤 438）
Status = swSelModelext.SaveAs3(mip, 0, 512, Nothing, Nothing, Error, Warning)  '更改零件文件名（替換裝配體中的原文件）
有哪位大佬能幫解答一下嗎？是不是SaceAs3語句的問題？
  Z6 e: n3 @6 p/ A4 b

Lean_2017.feng

以下方法說明，請自行測試：

  z# G& u( [! }* |+ D- c+ Z'Usage
. Y* X; D8 F  B& |' e$ p# J/ wIModelDocExtension.SaveAs3(Name, Version, Options, ExportData, AdvancedSaveAsOptions, Errors, Warnings)
6 a5 G3 v$ w2 u& F& _% Q

6 t. c$ l- o; Z( Z+ e# F'Func Declaration
( ?! ]. a; y0 O7 c& }/ r- J6 DFunction SaveAs3( _
( ?$ e0 q7 x5 D# ]   ByVal Name As System.String, _
+ ?% L* b; ~6 G3 C1 {   ByVal Version As System.Integer, _
& d8 i( }$ g# m6 ~' X6 |& {   ByVal Options As System.Integer, _
9 v5 ?+ L  z4 Q- V+ H$ T   ByVal ExportData As System.Object, _
   ByVal AdvancedSaveAsOptions As System.Object, _
& S$ d  O# X/ f9 X7 I   ByRef Errors As System.Integer, _
   ByRef Warnings As System.Integer _
) As System.Boolean

Parameters
+ ?6 o) E! P: g. m+ q    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)
7 T$ l* w; {5 }' f: D    Version
        Format in which to save this document as defined in swSaveAsVersion_e (see Remarks)
9 d  u; q5 T" D    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)
  U' V$ z  [6 @+ A% P* ~    AdvancedSaveAsOptions
+ z7 O+ I+ T: S% n6 [        IAdvancedSaveAsOptions (see Remarks)
    Errors
        Errors that caused the save to fail as defined in swFileSaveError_e (see Remarks)
! `4 e4 H: }. k, ?, m    Warnings
        Warnings or extra information generated during the save operation as defined in swFileSaveWarning_e (see Remarks)
Return Value
9 ^+ Y/ W3 y: x' C( |    True if the save is successful, false if not


! [5 a3 ^/ E( v/ F9 X0 Z5 }內容摘自apihelp.chm（通常存于 xxx\SOLIDWORKS Corp\SOLIDWORKS\api\ ）
: b5 h4 s" e$ e" S
, ?: X% [% F0 v
  t9 x/ S  M1 n/ f' `2 H- }

LIULISHAN

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

LIULISHAN

4 A. m& \1 }7 J* ^% a* d& A" g拿去，不用謝
  M, n, M" S* l2 {Status = swSelModelext.SaveAs2(mip, 0, 512, Nothing, "", False, Error, Warning) '更改零件文件名（替換裝配體中的原文件）