solidworks 關(guān)聯(lián)圖紙重命名文件

子玉1990

solidworks真是不思進(jìn)取，連個(gè)關(guān)聯(lián)圖紙一起重命名的功能都沒有，但這并不是因?yàn)樗荒軐?shí)現(xiàn)，只是因?yàn)殚_發(fā)根本就不能從用戶實(shí)際需求去考慮問題，你文件另存為的時(shí)候直接關(guān)聯(lián)上同名的圖紙文件不就完了嗎，只能自己寫個(gè)宏文件，需要的朋友自己copy一下吧。

Dim swApp As Object
% a& W+ q( `! [7 z- O% g& n, ~Dim ActiveDoc As Object
: ^1 f5 O+ M+ h+ BDim Error As Long
Dim Warning As Long
Dim NewName As String
Dim NewPathName As String
Dim Status As Boolean
0 M7 t' Z9 \4 {2 D2 M, h. eDim vDepend() As String
6 @: u! Z' b$ W! A
' h: {/ a( u" R! s
Sub main()
+ h$ i9 o- G7 J- w4 K9 r    Set swApp = Application.SldWorks
    Set ActiveDoc = swApp.ActiveDoc
7 D0 I& J8 C9 W( T: v( Z& d    Set swSelMgr = ActiveDoc.SelectionManager
    Set swComp= swSelMgr.GetSelectedObjectsComponent4(1,0)

    '判斷是否選擇了當(dāng)前文件子裝配體對象
    If swSelMgr.GetSelectedObjectCount2(0) = 0 Then
) _; E9 x; \1 u4 F1 k        MsgBox "當(dāng)前功能只能對裝配體里的子文件進(jìn)行重命名", vbOKOnly, "提示信息"
& }6 M. ~+ r7 w0 ^5 Q: h    Else
# }4 x8 i! q) D8 K) O        swComp.SetSuppression2 (3)
        Set swSelModel = swComp.GetModelDoc2
2 Z. C+ q. j6 R/ `: a        Set swSelModelext = swSelModel.Extension

: l$ ~5 e$ Y* C$ u        OldPathName = swComp.GetPathName
* X$ l" x9 T2 ^! G        Path = Left(OldPathName, InStrRev(OldPathName, "\")) '路徑
6 W+ r  F! J' B2 D        Suffix = Mid(OldPathName, InStrRev(OldPathName, ".")) '后綴
- b5 m6 l6 h# c- n1 M/ }        OldNameWithSuffix = Mid(OldPathName, InStrRev(OldPathName, "\") + 1) '帶后綴的舊文件名

) V( E( n5 K3 q% q  @2 W7 s        OldName = Left(OldNameWithSuffix,InStrRev(OldNameWithSuffix,".")-1)
: \: H' S& R' u        NewName = InputBox("另存為新文件名：","更新文件名對話框",OldName)'輸入新文件名
4 \9 J6 J, ?: Z. n2 C+ I) U        NewPathName = Path & NewName & Suffix '新文件名帶路徑
2 C$ E% n! H* p" T& \
2 U2 U2 U% ]6 ^, P        If NewPathName <> "" And NewName <> OldName Then
            Status = swSelModelext.SaveAs3(NewPathName, 0, 512, Nothing, Nothing, Error, Warning) '將舊文件直接另存為新文件
            Kill OldPathName '刪除舊文件

            temFile = Dir(Path & OldName & ".SLDDRW") '只要返回值不為空就表明該文件是有工程圖紙的，返回值是有后綴的文件名
            If temFile <> "" Then
5 O" \1 N- {4 r6 f2 G                NewDrwName = Path & NewName & ".SLDDRW"
                OldDrwName = Path & OldName & ".SLDDRW"
                FileCopy OldDrwName , NewDrwName '復(fù)制工程圖為新文件
  j7 T8 ?# i' [& c( s, k- X                vDepend = swApp.GetDocumentDependencies2(OldDrwName, False, False, False) '查找舊文件工程圖依賴
$ Y2 Q* b. }4 R                Rp = swApp.ReplaceReferencedDocument(NewDrwName, vDepend(1), NewPathName) '替換工程圖依賴
                Kill OldDrwName
            Else
                MsgBox "文件沒有工程圖紙", vbOKOnly, "提示信息"
+ K) l  g/ p9 ~  j9 c7 f            End If
        Else
            MsgBox "無效的新文件名，請沖洗輸入", vbOKOnly, "提示信息"
% r0 h: n3 I. [+ X4 v& K0 X5 I        End If
+ D2 r, ~* I" J+ ^1 ~9 I
    End If
( B6 ~, s( B  y4 o" c  P( z, n
" j+ S" `5 L9 N2 w# w6 BEnd Sub

2 p& S, W* r" R7 |2 W
4 l' w# h2 m" N2 m" y# d; x+ V
' m& F& M# K8 j  m" w4 c; P

yioa

這個(gè)怎么用？

17516768450

請沖洗輸入？重新輸入吧？

命與火

Status = swSelModelext.SaveAs3(NewPathName, 0, 512, Nothing, Nothing, Error, Warning)這段一直報(bào)錯(cuò)

laotoule8

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

onestray

先復(fù)制，有空玩玩。

大江大河-Meche

命與火 發(fā)表于 2025-1-11 16:15
) Z( I1 p7 \7 ^5 ?& u3 KStatus = swSelModelext.SaveAs3(NewPathName, 0, 512, Nothing, Nothing, Error, Warning)這段一直報(bào)錯(cuò) ...

可能是你的版本不支持這個(gè)函數(shù)