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

steve_suich

先在模型樹選中所要修改的模型，再運(yùn)行宏。宏內(nèi)容如下：
$ E$ A2 T/ X) ?# t* I8 U

1. Dim swApp As Object
   
2. Dim Part As Object
   " o* T) d! M) u& J- X: m
3. Sub main()
   
4. Set swApp = Application.SldWorks
   & {" g' u1 \' W2 H( \1 b
5. Set Part = swApp.ActiveDoc
   # b3 R/ e; O8 s  A6 ]7 L! V
6. Set swSelMgr = Part.SelectionManager
   ! [7 B" Z! s7 v- |
7. Set swComp = swSelMgr.GetSelectedObject(1)
   * m3 n1 ^6 I" ^+ g# l. l4 @, `
8. oldpathname = swComp.GetPathName
   
9. Path = Left(oldpathname, InStrRev(oldpathname, ""))
     y6 c8 L* w8 M1 _/ Q8 H
10. ntype = Mid(oldpathname, InStrRev(oldpathname, "."))
    / ^- [& A/ \: x8 }/ f/ T4 c
11. oldfi = Mid(oldpathname, InStrRev(oldpathname, "") + 1)
    8 [! g4 A, b0 S5 l7 I
12. oldname = Left(oldfi, InStrRev(oldfi, ".") - 1)
    
13.      mip = InputBox("changename", "name", oldname)
    1 l' y! p" v: N- ]4 h2 L8 e8 }
14. If mip <> "" Then
    4 k  Z) h. B$ G5 Q# j% d- e
15.   Part.Extension.RenameDocument mip
    
16.   Part.Save
    
17.   tmpfi = Dir(Path & "*.SLDDRW")
    
18.   Do Until tmpfi = ""
    . U: i1 g9 l  n
19.     vDepend = swApp.GetDocumentDependencies(Path & tmpfi, False, False)
    & R* \/ I7 u- a# D7 B3 }# s8 @
20.     If Mid(vDepend(1), InStrRev(vDepend(1), "") + 1) = oldfi Then
    % i$ w( C3 x9 s# @/ }
21.      Name Path & tmpfi As Path & mip & ".SLDDRW"
    
22.     bl = swApp.ReplaceReferencedDocument(Path & mip & ".SLDDRW", vDepend(1), Path & mip & ntype)
    . E) R, @: B# d
23.      Exit Do
    4 L, Y) F3 t! ]4 ]. R5 t1 P
24.    End If
    # ~6 i" f6 y5 L8 [( ~( R
25. tmpfi = Dir
    8 D6 E& N9 z1 T2 A
26. Loop
    ) w, r& m% R' X1 b+ M, {) H' y
27. End If
    
28. End Sub

復(fù)制代碼

* D2 E$ X& I3 J2 }1 C2 i/ q

happilly

sw嘛？.

da

你是chatgpt搞的？

steve_suich

happilly 發(fā)表于 2023-6-9 14:14
5 _* Q3 ~) `8 t( A2 @: ?7 `: Csw嘛？.

sw的宏
" }0 V. F! [4 N  y4 J5 t1 A& H0 g# A9 [

行云亦

能說一下怎么用嗎？

steve_suich

行云亦 發(fā)表于 2023-6-9 15:21
! O6 W9 w" J& E$ {) g能說一下怎么用嗎？

1、sw 新建一個(gè)宏文件，內(nèi)容按上面的代碼。2、打開一模型文件（裝配體或者零件）
3、在打開的模型界面的模型樹結(jié)構(gòu)里面用鼠標(biāo)點(diǎn)選所要改名的零件（或者子裝配體）
2 A' A6 h$ n6 L3 R, f* d: }
4、運(yùn)行剛才建好的宏文件，---彈出輸入框--輸入新的名字--點(diǎn)確定---完成。
2 X7 |) Y3 Q% E; x  R; f$ d/ D
+ [& |) M+ B7 l: @5 B
& e% J; n* j/ \: X

順子93

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

shentu

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

steve_suich

; j1 V% j; o; k: m5 e+ _' D

shentu 發(fā)表于 2023-6-9 22:21
同樣運(yùn)行出錯(cuò)。。。。。

Dim swApp As Object
2 F) B$ o( e7 n. V- n1 Y- JDim Part As Object
Sub main()
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
( o7 Y1 C6 e4 m+ J+ m, j, u7 qSet swSelMgr = Part.SelectionManager
Set swComp = swSelMgr.GetSelectedObject(1)
$ N  c1 f1 q7 e2 [oldpathname = swComp.GetPathName
# j; D9 w9 ^  S9 Y  x1 W$ sPath = Left(oldpathname, InStrRev(oldpathname, "\"))
ntype = Mid(oldpathname, InStrRev(oldpathname, "."))
& [* w' M" m& D" @oldfi = Mid(oldpathname, InStrRev(oldpathname, "\") + 1)
& P  I' b5 v0 S; Loldname = Left(oldfi, InStrRev(oldfi, ".") - 1)
' O4 X9 X4 ]! H! d  o( u     mip = InputBox("changename", "name", oldname)
If mip <> "" Then
: j4 x& Z* k( r  Part.Extension.RenameDocument mip
  Part.Save
  tmpfi = Dir(Path & "*.SLDDRW")
  Do Until tmpfi = ""
    vDepend = swApp.GetDocumentDependencies(Path & tmpfi, False, False)
0 l+ y/ J8 T# y  e! g( k. |    If Mid(vDepend(1), InStrRev(vDepend(1), "") + 1) = oldfi Then
     Name Path & tmpfi As Path & mip & ".SLDDRW"
6 @) J9 i4 C. N  g    bl = swApp.ReplaceReferencedDocument(Path & mip & ".SLDDRW", vDepend(1), Path & mip & ntype)
# B/ i8 ?! ^* @, t5 \4 w: L) }     Exit Do
   End If
tmpfi = Dir
Loop
# T; l/ {) L. j* IEnd If
6 h0 `9 e7 p- y% yEnd Sub
  M' ?1 p% D  S% A8 W

1. 
   

復(fù)制代碼

0 z1 N! r5 _0 ?3 j9 u4 V4 e

人外有人

steve_suich 發(fā)表于 2023-6-10 09:20
! g* e2 d8 ]+ B7 w8 QDim swApp As Object
Dim Part As Object
Sub main()

* G7 m- y) h; a2 Q& {+ v試了下，只改了part文件名，圖紙沒變，問題出在哪呢？