重命名零件和工程图（图纸升版本）

Dustry

在论坛看到大佬 怕瓦落地2011 的帖子http://www.cmiw.cn/thread-1061682-1-1.html
5 E  L, P. `5 c. R  x, D代码：

1. Dim swApp As Object
   / v. l) L% w1 f! P4 ^
2.   Dim Part As Object
   ( g. Y* r1 B5 {' |5 g0 M
3.   Dim Error As Long
   % f; W1 O) z9 X9 w* r$ u
4. Dim Warning As Long
   * `; m4 F7 q% o- |" a* ^2 F2 y
5. Dim mip As String
   
6. Dim Status As Boolean
   
7. Dim Newpath As String
   
8. Dim mipname As String
   . l, H; x( s/ ?) M+ y
9. Dim vDepend() As String
   8 ?# b. Z) y/ Y  g, p
10.     Sub main()
    
11.     Set swApp = Application.SldWorks
    2 z- _* F  T% E: K, F, G6 ?- Y8 m. [
12.     Set Part = swApp.ActiveDoc
    6 x/ ?) {; U8 b3 r+ ^
13.     Set swSelMgr = Part.SelectionManager
    
14.     Set swComp = swSelMgr.GetSelectedObjectsComponent4(1, 0)
    
15.         swComp.SetSuppression2 (3)
    
16.     Set swSelModel = swComp.GetModelDoc2
    8 U9 v  b. z* D
17.     Set swSelModelext = swSelModel.Extension
    
18. 
    $ R# F' g- l$ ]3 \9 K
19.     oldpathname = swComp.GetPathName
    
20. 
    
21.     Path = Left(oldpathname, InStrRev(oldpathname, "")) '路径
    * q' b' X8 K+ h* R+ c9 s$ n
22.     Debug.Print Path
    
23.     ntype = Mid(oldpathname, InStrRev(oldpathname, ".")) '后缀
    
24.     Debug.Print ntype
    
25.     oldfi = Mid(oldpathname, InStrRev(oldpathname, "") + 1) '旧文件名
    9 n+ f4 _; P  {& [- p4 z
26.     Debug.Print oldfi
    ! Q2 h6 j5 h4 c7 W' {
27.     oldname = Left(oldfi, InStrRev(oldfi, ".") - 1)
    
28.          mipname = InputBox("changename", "name", oldname) '新文件名
    
29. 
    
30.          mip = Path & mipname & ntype '新文件名带路径
    
31.          Debug.Print mip
    7 F" O1 h- Y- ?. d3 T
32. 
    
33.     If mip <> "" Then
      @) `# N6 b/ L/ t/ z3 G( ?
34.          Status = swSelModelext.SaveAs3(mip, 0, 512, Nothing, Nothing, Error, Warning) '更改零件文件名（替换装配体中的原文件）
    
35.       Debug.Print Status
    2 c, s' k. a& V% P* O% o3 p) Q
36.       '========================
    
37.       '更改工程图文件名
    ' q, }8 |/ y1 V2 g2 w: X! m( g
38.       Debug.Print Path
    
39.       tmpfi = Dir(Path & "*.SLDDRW") '遍历原文件夹中的工程图文件
    2 k6 S% j2 B6 X7 u5 n
40.       Debug.Print tmpfi
    2 W, z) K, E' L; C0 I) ~
41.       Do Until tmpfi = Null
      R8 x$ ]8 e( w. @' m1 i
42.         tmpfiname = Mid(tmpfi, InStrRev(tmpfi, "") + 1)
    + t8 L' C# n) k1 [
43.         Debug.Print tmpfiname
    ; Z3 N5 p; ?, C. J( q. m
44.         tmpoldname = Mid(oldfi, 1, InStr(1, oldfi, ".") - 1) & ".SLDDRW"
    % c4 h4 f& \8 C
45.         Debug.Print tmpoldname
    3 q- @% G2 V, Z* t1 W3 Z# M
46.         If tmpfiname = tmpoldname Then '查找同名工程图
    
47.         newdrwname = Path & mipname & ".SLDDRW"
    0 t6 A  t* a8 D
48.         Debug.Print newdrwname
    
49.         olddrwname = Path & tmpfi
    
50.         FileCopy olddrwname, newdrwname '复制工程图到新文件夹
    - X6 c- p1 w( \
51.         vDepend = swApp.GetDocumentDependencies2(Path & tmpfi, False, False, False) '查找工程图依赖
    " n" R: X3 C% H, S3 h
52. 
    
53.         Debug.Print vDepend(1)
    . g3 J" d; [- Q$ M1 s/ R  j1 Z
54.         bl = swApp.ReplaceReferencedDocument(newdrwname, vDepend(1), mip) '替换工程图依赖
    
55. 
    
56.         Debug.Print bl
    ' N$ q' \$ p) j) L$ h: P
57.          Exit Do
    & N7 D; h( C( _: Z
58.        End If
    0 J1 _$ g/ F% O' @
59.     tmpfi = Dir
    
60.     Debug.Print tmpfi
    
61.     Loop
    
62.     End If
    
63.     End Sub
    

复制代码

$ F" s9 y; C4 ?9 _* _2 K/ v8 \试了下这个宏（本人用的SW2018）报错：
对象不支持这个属性或方法（错误 438）
Status = swSelModelext.SaveAs3(mip, 0, 512, Nothing, Nothing, Error, Warning)  '更改零件文件名（替换装配体中的原文件）
0 w! n- b- \& ]  t, i3 _% Z有哪位大佬能帮解答一下吗？是不是SaceAs3语句的问题？
' s* Q# z/ g- H4 n) y  l

Lean_2017.feng

以下方法说明，请自行测试：

'Usage
& P# u& a, M: xIModelDocExtension.SaveAs3(Name, Version, Options, ExportData, AdvancedSaveAsOptions, Errors, Warnings)


1 ^/ J. l: E7 G9 }1 C'Func Declaration
. \1 G8 z5 e9 Y9 p, UFunction SaveAs3( _
" Z# ?- f' ~9 P# C- U3 P2 B   ByVal Name As System.String, _
   ByVal Version As System.Integer, _
1 H" @0 W: f  N) n9 @   ByVal Options As System.Integer, _
   ByVal ExportData As System.Object, _
* X: u) L$ o0 o9 N, E+ f$ }( O   ByVal AdvancedSaveAsOptions As System.Object, _
   ByRef Errors As System.Integer, _
( e$ j, ~, K- W5 Z3 o   ByRef Warnings As System.Integer _
3 C" p' N1 Y* j2 T) As System.Boolean
  `' l! j, z  t( W* m; N
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)
    Version
        Format in which to save this document as defined in swSaveAsVersion_e (see Remarks)
    Options
. W; e( g- s, B  j8 @5 b0 g3 u0 h        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)
    AdvancedSaveAsOptions
        IAdvancedSaveAsOptions (see Remarks)
    Errors
! J4 }  x- i; {        Errors that caused the save to fail as defined in swFileSaveError_e (see Remarks)
! p# s2 _  U, ~    Warnings
        Warnings or extra information generated during the save operation as defined in swFileSaveWarning_e (see Remarks)
Return Value
% |% H! \3 ~9 B3 B: A    True if the save is successful, false if not
0 D7 u, R9 O- T. \6 a
/ p' X4 v) G- S. p9 g. y2 Q4 m, B2 ?
内容摘自apihelp.chm（通常存于 xxx\SOLIDWORKS Corp\SOLIDWORKS\api\ ）
  o) `) Q: Z9 K, j
' L/ x/ X( a0 Y0 S  P/ C
$ m2 b  |! m/ ]. S

+ v& R! _/ X; F" K. N" ]

LIULISHAN

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

LIULISHAN

. c+ n" [! v' k) x) t) W8 K5 I拿去，不用谢
Status = swSelModelext.SaveAs2(mip, 0, 512, Nothing, "", False, Error, Warning) '更改零件文件名（替换装配体中的原文件）