solidworks 关联图纸重命名文件

子玉1990

solidworks真是不思进取，连个关联图纸一起重命名的功能都没有，但这并不是因为它不能实现，只是因为开发根本就不能从用户实际需求去考虑问题，你文件另存为的时候直接关联上同名的图纸文件不就完了吗，只能自己写个宏文件，需要的朋友自己copy一下吧。
3 L5 D! M8 ~4 b; `9 K8 b
Dim swApp As Object
6 ?- x$ o) h3 \$ z' \0 iDim ActiveDoc As Object
5 a. W  _% \' B) F2 ^3 O8 ?5 ^Dim Error As Long
Dim Warning As Long
, j" `" c8 u6 T- b7 V( xDim NewName As String
Dim NewPathName As String
0 S% N5 R6 m3 i! G, }1 SDim Status As Boolean
Dim vDepend() As String
0 v3 s4 S8 N) ?4 z* A% E/ p

' U* n+ ]& o" f- O3 }Sub main()
    Set swApp = Application.SldWorks
% n' x5 U, p2 R% B* I$ u    Set ActiveDoc = swApp.ActiveDoc
4 {' D8 W+ U9 J* I; h    Set swSelMgr = ActiveDoc.SelectionManager
) a/ H* P+ Q6 V# ^    Set swComp= swSelMgr.GetSelectedObjectsComponent4(1,0)

8 N* ~' F8 ~( Z5 g" o$ N) C    '判断是否选择了当前文件子装配体对象
    If swSelMgr.GetSelectedObjectCount2(0) = 0 Then
* B6 l/ ~1 J1 j' r        MsgBox "当前功能只能对装配体里的子文件进行重命名", vbOKOnly, "提示信息"
    Else
5 o/ j) P( k& ]7 _* ^/ r3 G6 m        swComp.SetSuppression2 (3)
3 d" @5 t) D/ O1 S        Set swSelModel = swComp.GetModelDoc2
/ j4 |& f+ B' l4 S' }$ d- ]4 F) _& q        Set swSelModelext = swSelModel.Extension
( O/ m; X) b* A
; r/ m# T, |* e. v3 A  f9 W        OldPathName = swComp.GetPathName
2 _! W. j. _3 Z3 E; U' ]3 ?        Path = Left(OldPathName, InStrRev(OldPathName, "\")) '路径
5 ]. ?1 ^$ M% C2 o; r, U  u5 d        Suffix = Mid(OldPathName, InStrRev(OldPathName, ".")) '后缀
        OldNameWithSuffix = Mid(OldPathName, InStrRev(OldPathName, "\") + 1) '带后缀的旧文件名

  k/ k' a- v9 W" H" w        OldName = Left(OldNameWithSuffix,InStrRev(OldNameWithSuffix,".")-1)
! a/ j  k) a0 h5 b2 G4 Q3 I6 m        NewName = InputBox("另存为新文件名：","更新文件名对话框",OldName)'输入新文件名
        NewPathName = Path & NewName & Suffix '新文件名带路径

        If NewPathName <> "" And NewName <> OldName Then
  o& j8 L, v  i1 n+ Y            Status = swSelModelext.SaveAs3(NewPathName, 0, 512, Nothing, Nothing, Error, Warning) '将旧文件直接另存为新文件
1 O% D$ m! B! ^            Kill OldPathName '删除旧文件

            temFile = Dir(Path & OldName & ".SLDDRW") '只要返回值不为空就表明该文件是有工程图纸的，返回值是有后缀的文件名
# R- B2 v) ^, i, `" G            If temFile <> "" Then
                NewDrwName = Path & NewName & ".SLDDRW"
6 V) b; r# I4 k& [                OldDrwName = Path & OldName & ".SLDDRW"
3 Q, G2 g  S, b9 m. ], K" u: q                FileCopy OldDrwName , NewDrwName '复制工程图为新文件
* k* S! C9 e7 y+ [                vDepend = swApp.GetDocumentDependencies2(OldDrwName, False, False, False) '查找旧文件工程图依赖
                Rp = swApp.ReplaceReferencedDocument(NewDrwName, vDepend(1), NewPathName) '替换工程图依赖
                Kill OldDrwName
# }* ~5 _7 t' }, U# k( J            Else
0 j  E$ [- a$ x* n& t- [0 }  s                MsgBox "文件没有工程图纸", vbOKOnly, "提示信息"
            End If
        Else
            MsgBox "无效的新文件名，请冲洗输入", vbOKOnly, "提示信息"
7 z9 t9 u; h( H9 D5 c        End If
9 ^, L. n- T# B/ g+ ?
6 F/ ^) N% J5 e$ S    End If

& d# M/ T+ f; X- i" QEnd Sub


  M  z! T# q( U% ]4 l, Q- u


+ f7 k' [2 \4 J9 F8 X. ]1 o! l6 I

yioa

这个怎么用？

17516768450

请冲洗输入？重新输入吧？

命与火

Status = swSelModelext.SaveAs3(NewPathName, 0, 512, Nothing, Nothing, Error, Warning)这段一直报错

laotoule8

复制的里面有些叽里呱啦的文字怎么删除？ 比如 t# m' |. _% d9 q: W- [4 o( \2 b* p6 V4 P8 m