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

Dustry

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

1. Dim swApp As Object
   
2.   Dim Part As Object
   
3.   Dim Error As Long
     q: h+ [9 r6 H4 `
4. Dim Warning As Long
   
5. Dim mip As String
   3 W" N! K$ B& U  L- a' ]
6. Dim Status As Boolean
   ! D: c" P: {/ G0 X
7. Dim Newpath As String
   ; |! |" ~& ^# H+ c
8. Dim mipname As String
   
9. Dim vDepend() As String
   ' i( [9 ?* A% S' i- z4 f
10.     Sub main()
    8 G) a' w6 M) V
11.     Set swApp = Application.SldWorks
    9 n' B; a) f1 q9 _2 Y
12.     Set Part = swApp.ActiveDoc
    
13.     Set swSelMgr = Part.SelectionManager
    
14.     Set swComp = swSelMgr.GetSelectedObjectsComponent4(1, 0)
    ' K* E! y3 o4 G$ M) v% I8 Y7 @0 k
15.         swComp.SetSuppression2 (3)
    
16.     Set swSelModel = swComp.GetModelDoc2
    ! ^4 x# o( j9 }, h9 h
17.     Set swSelModelext = swSelModel.Extension
    2 V9 r. a# H2 m! R! \1 U
18. 
    ; V# S  l+ J5 h( \" a5 W) K
19.     oldpathname = swComp.GetPathName
    , o/ {- j" ~) V" @
20. 
    
21.     Path = Left(oldpathname, InStrRev(oldpathname, "")) '路徑
    
22.     Debug.Print Path
    
23.     ntype = Mid(oldpathname, InStrRev(oldpathname, ".")) '后綴
    
24.     Debug.Print ntype
    0 q4 P- g4 c) \- Q
25.     oldfi = Mid(oldpathname, InStrRev(oldpathname, "") + 1) '舊文件名
    - @4 w1 y* @$ y4 f
26.     Debug.Print oldfi
    % P# c3 a" Z6 F8 ?7 d% ^' |( ^
27.     oldname = Left(oldfi, InStrRev(oldfi, ".") - 1)
    
28.          mipname = InputBox("changename", "name", oldname) '新文件名
    
29. 
    1 |) }0 Z, i& t& R# d& X
30.          mip = Path & mipname & ntype '新文件名帶路徑
    ! D# I  l- C+ P! n+ R: z4 L
31.          Debug.Print mip
    
32. 
    
33.     If mip <> "" Then
    : L1 g" ~/ j/ v% f; E3 c/ ~
34.          Status = swSelModelext.SaveAs3(mip, 0, 512, Nothing, Nothing, Error, Warning) '更改零件文件名（替換裝配體中的原文件）
    6 g$ h8 `0 W6 z8 u5 L+ }
35.       Debug.Print Status
    : Q: m8 e3 Z' {# a
36.       '========================
    , b* d# Z0 H# j/ E2 K7 L
37.       '更改工程圖文件名
    " Y! R" b9 ^& w/ o  v+ C
38.       Debug.Print Path
    + L/ P$ v+ i2 q8 h* d
39.       tmpfi = Dir(Path & "*.SLDDRW") '遍歷原文件夾中的工程圖文件
    
40.       Debug.Print tmpfi
    ) m% ?6 S! R5 R# o
41.       Do Until tmpfi = Null
    ' C, Z6 V& R& I9 o- z2 Q6 c" G5 m
42.         tmpfiname = Mid(tmpfi, InStrRev(tmpfi, "") + 1)
    
43.         Debug.Print tmpfiname
    ; U* [* V* L" n$ z
44.         tmpoldname = Mid(oldfi, 1, InStr(1, oldfi, ".") - 1) & ".SLDDRW"
    
45.         Debug.Print tmpoldname
    # T4 K- }) G$ d* B
46.         If tmpfiname = tmpoldname Then '查找同名工程圖
    
47.         newdrwname = Path & mipname & ".SLDDRW"
    7 f* P0 J& w7 R$ S/ s3 @
48.         Debug.Print newdrwname
    2 _4 o3 L/ w* u5 y
49.         olddrwname = Path & tmpfi
    * k% c# ~8 Y- a. ^' N: a
50.         FileCopy olddrwname, newdrwname '復(fù)制工程圖到新文件夾
    
51.         vDepend = swApp.GetDocumentDependencies2(Path & tmpfi, False, False, False) '查找工程圖依賴
    2 _2 G' N% F8 G8 Q7 S
52. 
    & ~& t$ r0 O1 [# I
53.         Debug.Print vDepend(1)
    ! w/ P# }: l, q  }) G
54.         bl = swApp.ReplaceReferencedDocument(newdrwname, vDepend(1), mip) '替換工程圖依賴
    
55. 
    4 ?" R3 Q$ s' @9 r  a5 A! k! i
56.         Debug.Print bl
    
57.          Exit Do
    % }" \) r# y- a( T
58.        End If
    1 i# G& b# A1 Z* ]% d
59.     tmpfi = Dir
    2 }4 v% o, D0 j1 w9 R4 ^
60.     Debug.Print tmpfi
      z- b6 y! V, P: M
61.     Loop
    
62.     End If
    2 X; l& P8 a: [! g8 v
63.     End Sub
    

復(fù)制代碼

試了下這個(gè)宏（本人用的SW2018）報(bào)錯(cuò)：
對(duì)象不支持這個(gè)屬性或方法（錯(cuò)誤 438）
1 o% r6 m& Z. R3 z, B* t9 XStatus = swSelModelext.SaveAs3(mip, 0, 512, Nothing, Nothing, Error, Warning)  '更改零件文件名（替換裝配體中的原文件）
: D$ t+ ]4 s; S6 d# U有哪位大佬能幫解答一下嗎？是不是SaceAs3語(yǔ)句的問(wèn)題？
- ~( X2 o1 e5 a% E3 F

Lean_2017.feng

以下方法說(shuō)明，請(qǐng)自行測(cè)試：

'Usage
IModelDocExtension.SaveAs3(Name, Version, Options, ExportData, AdvancedSaveAsOptions, Errors, Warnings)
$ q9 X& d- P2 o( A- {0 U4 O7 U

'Func Declaration
Function SaveAs3( _
   ByVal Name As System.String, _
* ^& T2 _% `) F* x& G/ x   ByVal Version As System.Integer, _
/ k6 w* S" k: P' N   ByVal Options As System.Integer, _
   ByVal ExportData As System.Object, _
4 X( \' O3 q# d. c9 H2 S9 l% ]8 z8 B   ByVal AdvancedSaveAsOptions As System.Object, _
   ByRef Errors As System.Integer, _
' g1 x% C2 Z7 Z7 m% q   ByRef Warnings As System.Integer _
$ {2 ]" U; M, \1 ?+ m9 C) As System.Boolean

8 h! e5 e; ?# o. C% M& I" Q. ^Parameters
    Name
% O1 I, T4 ]' r, c        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
7 k) E9 x: O/ g. g4 `: J% D        Format in which to save this document as defined in swSaveAsVersion_e (see Remarks)
    Options
' f  t5 x& D+ g6 o. b- H# _! Q        Option indicating how to save the document as defined in swSaveAsOptions_e (see Remarks)
; x/ I6 l# \% Y; w, Z  A  ?    ExportData
/ B. K1 I) s1 r6 T1 H# K9 d6 ^, y        IExportPdfData object for exporting drawing sheets to PDF (see Remarks)
7 p$ c% P3 ~6 s- U( O" Y3 H! E    AdvancedSaveAsOptions
# b; [( w! Y6 M9 ~7 z        IAdvancedSaveAsOptions (see Remarks)
    Errors
8 Q' N) v# i+ |3 o. L        Errors that caused the save to fail as defined in swFileSaveError_e (see Remarks)
: d/ s; v- J& @    Warnings
        Warnings or extra information generated during the save operation as defined in swFileSaveWarning_e (see Remarks)
Return Value
5 E, [# ?. a5 o9 r8 I( B: \    True if the save is successful, false if not

+ M  [8 _4 l0 ?1 l
內(nèi)容摘自apihelp.chm（通常存于 xxx\SOLIDWORKS Corp\SOLIDWORKS\api\ ）
( q1 Z" I0 ^$ d

5 J( j$ _( w8 d9 k( c5 w