模型改名同时改工程图

steve_suich

先在模型树选中所要修改的模型，再运行宏。宏内容如下：
0 B5 M' u o& U; |- c; J

1. Dim swApp As Object
   
2. Dim Part As Object
   
3. Sub main()
   
4. Set swApp = Application.SldWorks
   + k; @$ C# Y# c( {0 q
5. Set Part = swApp.ActiveDoc
   
6. Set swSelMgr = Part.SelectionManager
   " [( @! h" F& c3 U6 [
7. Set swComp = swSelMgr.GetSelectedObject(1)
   
8. oldpathname = swComp.GetPathName
   
9. Path = Left(oldpathname, InStrRev(oldpathname, ""))
   8 i: k9 r6 k9 x6 I6 D0 Q
10. ntype = Mid(oldpathname, InStrRev(oldpathname, "."))
    
11. oldfi = Mid(oldpathname, InStrRev(oldpathname, "") + 1)
    
12. oldname = Left(oldfi, InStrRev(oldfi, ".") - 1)
    
13. mip = InputBox("changename", "name", oldname)
    
14. If mip <> "" Then
    / A# _7 y3 t& a$ k, _
15. Part.Extension.RenameDocument mip
    
16. Part.Save
    
17. tmpfi = Dir(Path & "*.SLDDRW")
    
18. Do Until tmpfi = ""
    " m, ?* i0 o7 M( m4 o3 W
19. vDepend = swApp.GetDocumentDependencies(Path & tmpfi, False, False)
    
20. If Mid(vDepend(1), InStrRev(vDepend(1), "") + 1) = oldfi Then
    
21. Name Path & tmpfi As Path & mip & ".SLDDRW"
    J8 Q9 f+ W- t% ]
22. bl = swApp.ReplaceReferencedDocument(Path & mip & ".SLDDRW", vDepend(1), Path & mip & ntype)
    1 l! V1 l! M0 Y) Y5 m$ l
23. Exit Do
    3 q# i! s$ o d
24. End If
    9 C. e# E8 Z7 L* n6 G
25. tmpfi = Dir
    2 D8 {2 s' j4 \. H) B# o. f
26. Loop
    
27. End If
    
28. End Sub

复制代码

- K# J) w: ] v9 D
% R" r, d2 f4 I5 _/ h

happilly

sw嘛？.

da

你是chatgpt搞的？

steve_suich

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

sw的宏

行云亦

能说一下怎么用吗？

steve_suich

行云亦 发表于 2023-6-9 15:21
8 V3 J" r2 d- Z能说一下怎么用吗？

1、sw 新建一个宏文件，内容按上面的代码。2、打开一模型文件（装配体或者零件）
( M7 [* e; V$ f) H3、在打开的模型界面的模型树结构里面用鼠标点选所要改名的零件（或者子装配体）

1 I- ]/ M* O* f/ c4、运行刚才建好的宏文件，---弹出输入框--输入新的名字--点确定---完成。

顺子93

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

shentu

同样运行出错。。。。。

steve_suich

shentu 发表于 2023-6-9 22:21
0 m k8 J' s, K$ R同样运行出错。。。。。

Dim swApp As Object
7 ?, f1 s l6 R1 R7 n: q+ ADim Part As Object
R Z$ H, ?0 f; R6 K9 u: tSub main()
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
Set swSelMgr = Part.SelectionManager
Set swComp = swSelMgr.GetSelectedObject(1)
" S# j$ o+ g+ ~$ {7 P: [7 Goldpathname = swComp.GetPathName
Path = Left(oldpathname, InStrRev(oldpathname, "\"))
$ n+ Y" G! |6 Q) w& Jntype = Mid(oldpathname, InStrRev(oldpathname, "."))
oldfi = Mid(oldpathname, InStrRev(oldpathname, "\") + 1)
% E( A4 X5 [% E9 q" v( f9 P/ W joldname = Left(oldfi, InStrRev(oldfi, ".") - 1)
mip = InputBox("changename", "name", oldname)
8 R+ x) E% Y$ ~* z- C( FIf mip <> "" Then
- ~4 u( J+ |- Z) {7 jPart.Extension.RenameDocument mip
) u* X2 i6 i/ W9 `; A1 |7 tPart.Save
tmpfi = Dir(Path & "*.SLDDRW")
y6 m9 Q* _8 sDo Until tmpfi = ""
vDepend = swApp.GetDocumentDependencies(Path & tmpfi, False, False)
If Mid(vDepend(1), InStrRev(vDepend(1), "") + 1) = oldfi Then
2 x2 P( r- W" D& Y. b) XName Path & tmpfi As Path & mip & ".SLDDRW"
, ?$ m. |& F$ R: I3 a; E s( A9 |bl = swApp.ReplaceReferencedDocument(Path & mip & ".SLDDRW", vDepend(1), Path & mip & ntype)
Exit Do
End If
tmpfi = Dir
Loop
2 `3 ~) V$ Z: f) w8 w9 l! v$ uEnd If
9 `7 R3 h; q2 U3 F5 E6 W3 U- rEnd Sub

1. 
   

复制代码

c& ]! h% }# R3 x+ V9 S+ q& L; C" b1 S* f

人外有人

steve_suich 发表于 2023-6-10 09:20
- L, i" X( v& F- ]2 x' e& i7 GDim swApp As Object
. D. j$ ]' a% C( K7 Y G# ~ eDim Part As Object
& Y2 i% g. S" f V9 iSub main()

9 G( n) ^9 R3 r9 G9 D6 C$ ?试了下，只改了part文件名，图纸没变，问题出在哪呢？
* ]1 C2 o9 g2 E% n