模型改名同時(shí)改工程圖

steve_suich

先在模型樹(shù)選中所要修改的模型，再運(yùn)行宏。宏內(nèi)容如下：

1. Dim swApp As Object
     C# O- a4 I# r9 A& D: @
2. Dim Part As Object
   
3. Sub main()
   : A$ S5 q+ s4 a+ B# L8 U
4. Set swApp = Application.SldWorks
   
5. Set Part = swApp.ActiveDoc
   
6. Set swSelMgr = Part.SelectionManager
   
7. Set swComp = swSelMgr.GetSelectedObject(1)
   ! [( ^/ e. R9 l" e
8. oldpathname = swComp.GetPathName
   
9. Path = Left(oldpathname, InStrRev(oldpathname, ""))
   
10. ntype = Mid(oldpathname, InStrRev(oldpathname, "."))
    ) i& t9 ^4 j% W4 @7 _, r( a
11. oldfi = Mid(oldpathname, InStrRev(oldpathname, "") + 1)
    
12. oldname = Left(oldfi, InStrRev(oldfi, ".") - 1)
    
13.      mip = InputBox("changename", "name", oldname)
    - P8 F( k0 n0 u2 g/ p3 F4 m8 Q
14. If mip <> "" Then
    
15.   Part.Extension.RenameDocument mip
    
16.   Part.Save
    ' Y" P! g- s" C& M
17.   tmpfi = Dir(Path & "*.SLDDRW")
    ; _2 `; q& S2 t: z/ {: Y
18.   Do Until tmpfi = ""
    6 m; P# A2 O0 g$ x0 D- O
19.     vDepend = swApp.GetDocumentDependencies(Path & tmpfi, False, False)
    $ ]/ R$ {: r; h. j8 |( y
20.     If Mid(vDepend(1), InStrRev(vDepend(1), "") + 1) = oldfi Then
    
21.      Name Path & tmpfi As Path & mip & ".SLDDRW"
      s7 D8 \; ~6 l! w5 A
22.     bl = swApp.ReplaceReferencedDocument(Path & mip & ".SLDDRW", vDepend(1), Path & mip & ntype)
    
23.      Exit Do
    1 C" S0 Z1 r* S- C/ x# `" f$ L
24.    End If
    
25. tmpfi = Dir
    
26. Loop
    . g- G3 i7 R: O
27. End If
    / Q# m2 p% C& @8 f( l1 G: p
28. End Sub

復(fù)制代碼

4 A( z2 Y; i1 G; J

happilly

sw嘛？.

da

你是chatgpt搞的？

steve_suich

happilly 發(fā)表于 2023-6-9 14:14
5 z2 r" B1 k; v  z% h1 W5 Lsw嘛？.

( n0 ~. i8 l1 W" w3 j: A9 usw的宏

行云亦

能說(shuō)一下怎么用嗎？

steve_suich

行云亦 發(fā)表于 2023-6-9 15:21
, b4 i5 W- ~, ?+ l" @能說(shuō)一下怎么用嗎？

  i. |2 w4 P) ]# @! _, w7 r3 q4 ~1、sw 新建一個(gè)宏文件，內(nèi)容按上面的代碼。2、打開(kāi)一模型文件（裝配體或者零件）
3、在打開(kāi)的模型界面的模型樹(shù)結(jié)構(gòu)里面用鼠標(biāo)點(diǎn)選所要改名的零件（或者子裝配體）
: y9 L+ |1 P6 [
: r* Z5 H  c; s+ h+ |/ `, j4、運(yùn)行剛才建好的宏文件，---彈出輸入框--輸入新的名字--點(diǎn)確定---完成。
) p/ G4 v7 O9 r3 I
, Y/ S' j4 C$ u, k) m& q7 x- I
% ?: j% ?$ G; P) D9 _* D* l

順子93

運(yùn)行出錯(cuò)，08行有問(wèn)題。錯(cuò)誤91，對(duì)象變量或with 塊變量未設(shè)置

shentu

同樣運(yùn)行出錯(cuò)。。。。。

steve_suich

0 ?! H$ O' `0 i) V6 c

shentu 發(fā)表于 2023-6-9 22:21
9 b9 U# Z) R# [- C同樣運(yùn)行出錯(cuò)。。。。。

Dim swApp As Object
& t, D$ I+ f9 k; cDim Part As Object
Sub main()
Set swApp = Application.SldWorks
; i" C- ]; A3 G& I# ?0 m0 VSet Part = swApp.ActiveDoc
4 S+ u* Q! s/ H8 ^Set swSelMgr = Part.SelectionManager
Set swComp = swSelMgr.GetSelectedObject(1)
/ Q% d# O1 @" x7 Z/ Xoldpathname = swComp.GetPathName
9 f) J- y8 S& J# @' A8 g: M6 k8 ZPath = Left(oldpathname, InStrRev(oldpathname, "\"))
ntype = Mid(oldpathname, InStrRev(oldpathname, "."))
oldfi = Mid(oldpathname, InStrRev(oldpathname, "\") + 1)
oldname = Left(oldfi, InStrRev(oldfi, ".") - 1)
) y- f% p* Z  o: w0 n" t     mip = InputBox("changename", "name", oldname)
If mip <> "" Then
  Part.Extension.RenameDocument mip
  Part.Save
  tmpfi = Dir(Path & "*.SLDDRW")
  Do Until tmpfi = ""
    vDepend = swApp.GetDocumentDependencies(Path & tmpfi, False, False)
! S. [+ b. o% M) m6 B    If Mid(vDepend(1), InStrRev(vDepend(1), "") + 1) = oldfi Then
     Name Path & tmpfi As Path & mip & ".SLDDRW"
4 o1 Z: l! P$ F# |* ^+ x, m5 M    bl = swApp.ReplaceReferencedDocument(Path & mip & ".SLDDRW", vDepend(1), Path & mip & ntype)
: R2 F( }0 s1 L" n* E% q     Exit Do
1 B- o) O+ f8 M0 y5 Z9 V$ O" }8 i   End If
8 V+ X# \% L% l0 l/ ftmpfi = Dir
; ^; L0 u$ c* m4 o% `Loop
End If
End Sub

& g1 f6 Z7 V- \* t8 m7 j

1. 
   0 g8 g% B/ U( a0 a

復(fù)制代碼

" V" g2 z8 F3 Y2 Q' Y

人外有人

steve_suich 發(fā)表于 2023-6-10 09:20
Dim swApp As Object
Dim Part As Object
' Z" X5 r9 x3 o% a) @% oSub main()

: X& s3 F4 I; U- a試了下，只改了part文件名，圖紙沒(méi)變，問(wèn)題出在哪呢？
; ]1 l. T$ {( _
0 _! _- i% w2 o9 I" H0 e