模型改名同时改工程图

steve_suich

先在模型树选中所要修改的模型，再运行宏。宏内容如下：
4 [$ `7 v( ]' ~- ?& I$ O0 U! O

1. Dim swApp As Object
   
2. Dim Part As Object
   * D. R9 v% H8 d: b
3. Sub main()
   
4. Set swApp = Application.SldWorks
     |! r, d& P0 u5 ^; H$ }+ t
5. Set Part = swApp.ActiveDoc
   ) y; E. w5 ?7 V6 v8 @
6. Set swSelMgr = Part.SelectionManager
   1 g+ J( v& ]( p% ?$ C6 ^' q- o  u. B
7. Set swComp = swSelMgr.GetSelectedObject(1)
   
8. oldpathname = swComp.GetPathName
   
9. Path = Left(oldpathname, InStrRev(oldpathname, ""))
   
10. ntype = Mid(oldpathname, InStrRev(oldpathname, "."))
    5 \+ d% ]! p2 y9 h3 {3 P4 Z/ |  D
11. oldfi = Mid(oldpathname, InStrRev(oldpathname, "") + 1)
    
12. oldname = Left(oldfi, InStrRev(oldfi, ".") - 1)
    4 C, K2 K: F( w0 u  ?
13.      mip = InputBox("changename", "name", oldname)
    
14. If mip <> "" Then
    2 D% v8 r. b; p4 I3 W3 h
15.   Part.Extension.RenameDocument mip
    
16.   Part.Save
    
17.   tmpfi = Dir(Path & "*.SLDDRW")
    
18.   Do Until tmpfi = ""
    
19.     vDepend = swApp.GetDocumentDependencies(Path & tmpfi, False, False)
    ( N* f8 H( R3 K  w6 \
20.     If Mid(vDepend(1), InStrRev(vDepend(1), "") + 1) = oldfi Then
    # I, s/ K* t/ e$ ~! W
21.      Name Path & tmpfi As Path & mip & ".SLDDRW"
    
22.     bl = swApp.ReplaceReferencedDocument(Path & mip & ".SLDDRW", vDepend(1), Path & mip & ntype)
    
23.      Exit Do
    
24.    End If
    & ?' ]7 h. B+ f1 N: g; p
25. tmpfi = Dir
    
26. Loop
    
27. End If
    
28. End Sub

复制代码

5 w) R% w9 t/ z, U: `8 m8 W

happilly

sw嘛？.

da

你是chatgpt搞的？

steve_suich

happilly 发表于 2023-6-9 14:14
sw嘛？.

7 ]  S# U3 y1 ]4 H4 A# }  `3 jsw的宏
; r- L: Y5 h. l; y; m% o

行云亦

能说一下怎么用吗？

steve_suich

行云亦 发表于 2023-6-9 15:21
能说一下怎么用吗？

  s' O) W/ |4 I  ^" ]- Q. s- @1、sw 新建一个宏文件，内容按上面的代码。2、打开一模型文件（装配体或者零件）
% [. ^9 i$ n  @; H8 ^' w3、在打开的模型界面的模型树结构里面用鼠标点选所要改名的零件（或者子装配体）

8 B, _; m0 F  k% g3 y4、运行刚才建好的宏文件，---弹出输入框--输入新的名字--点确定---完成。
( {* N1 ?4 n, S2 \
& v$ H5 r  v3 H2 i# D* f" D+ s' {# W
9 A+ u9 K, N$ C0 u* n9 u- F

顺子93

运行出错，08行有问题。错误91，对象变量或with 块变量未设置

shentu

同样运行出错。。。。。

steve_suich

shentu 发表于 2023-6-9 22:21
1 [! {) t) B4 J  L1 I! G/ Y  D( |" ?同样运行出错。。。。。

Dim swApp As Object
Dim Part As Object
; p; B7 ~3 H! \Sub main()
Set swApp = Application.SldWorks
% w: y% j( n, l( ]  a: j( rSet Part = swApp.ActiveDoc
2 H3 G: p* r# _3 pSet swSelMgr = Part.SelectionManager
* R; ~8 D4 Z  s' ^Set swComp = swSelMgr.GetSelectedObject(1)
) |4 q0 k" s4 K% Y$ Uoldpathname = swComp.GetPathName
+ b7 h- k/ p$ V, P: RPath = Left(oldpathname, InStrRev(oldpathname, "\"))
ntype = Mid(oldpathname, InStrRev(oldpathname, "."))
oldfi = Mid(oldpathname, InStrRev(oldpathname, "\") + 1)
oldname = Left(oldfi, InStrRev(oldfi, ".") - 1)
5 E2 ^) z/ P1 l! D6 f& z; L0 y     mip = InputBox("changename", "name", oldname)
! s- d' J3 N5 c0 }- y0 H) h2 k5 m) AIf mip <> "" Then
  Part.Extension.RenameDocument mip
2 [4 S* R' Z5 X8 b# S- B  Part.Save
% k" X& b) D5 `3 X" m; Q  tmpfi = Dir(Path & "*.SLDDRW")
5 N% x+ U$ l: l1 E& t# P  Do Until tmpfi = ""
    vDepend = swApp.GetDocumentDependencies(Path & tmpfi, False, False)
    If Mid(vDepend(1), InStrRev(vDepend(1), "") + 1) = oldfi Then
     Name Path & tmpfi As Path & mip & ".SLDDRW"
    bl = swApp.ReplaceReferencedDocument(Path & mip & ".SLDDRW", vDepend(1), Path & mip & ntype)
4 s! H5 v* K5 P7 c- Y" I. K' Z) a     Exit Do
9 v+ ?$ l8 I! P1 `% v1 h   End If
tmpfi = Dir
0 A1 V& V- T4 c) h- q" Z, t9 ^, `Loop
3 ]- ]$ J8 T- sEnd If
End Sub

% w5 _$ M! u' {' s; |

1. 
   , m! B  r* [+ v3 ~$ P

复制代码

1 C+ [! X1 r! s+ z0 _- {

人外有人

steve_suich 发表于 2023-6-10 09:20
9 X9 ?3 x, ?$ M. i7 IDim swApp As Object
# `. t  D* I  z, n. jDim Part As Object
1 D. u, h) `$ Y( y+ |( ?% h9 rSub main()

试了下，只改了part文件名，图纸没变，问题出在哪呢？
* a* S; P8 e  g# A8 ?  O