模型改名同时改工程图

steve_suich

先在模型树选中所要修改的模型，再运行宏。宏内容如下：
% K. M( d' E+ F

1. Dim swApp As Object
   * Q3 B, e* S2 e
2. Dim Part As Object
   
3. Sub main()
   
4. Set swApp = Application.SldWorks
   
5. Set Part = swApp.ActiveDoc
   $ {: O1 _2 K, n5 b: n
6. Set swSelMgr = Part.SelectionManager
   6 N8 J/ W* r2 t" R, d8 W
7. Set swComp = swSelMgr.GetSelectedObject(1)
   8 p3 s" C# S3 K# N( ^1 O
8. oldpathname = swComp.GetPathName
   
9. Path = Left(oldpathname, InStrRev(oldpathname, ""))
   ! d5 p. I* o- g5 g" \
10. ntype = Mid(oldpathname, InStrRev(oldpathname, "."))
    
11. oldfi = Mid(oldpathname, InStrRev(oldpathname, "") + 1)
      v3 l2 A8 _# R1 }5 ^
12. oldname = Left(oldfi, InStrRev(oldfi, ".") - 1)
    
13.      mip = InputBox("changename", "name", oldname)
    
14. If mip <> "" Then
    
15.   Part.Extension.RenameDocument mip
    " q7 ~4 U* ]: z9 ?7 r
16.   Part.Save
    
17.   tmpfi = Dir(Path & "*.SLDDRW")
    / R4 L. x# Q+ ]8 @" g4 M# F
18.   Do Until tmpfi = ""
    ' [4 G; Z+ U7 i+ m; _, @8 k
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"
    
22.     bl = swApp.ReplaceReferencedDocument(Path & mip & ".SLDDRW", vDepend(1), Path & mip & ntype)
    
23.      Exit Do
    
24.    End If
    
25. tmpfi = Dir
    
26. Loop
    
27. End If
    
28. End Sub

复制代码

" J, P* q7 E) R6 @# G, k" Q6 A% @8 O

happilly

sw嘛？.

da

你是chatgpt搞的？

steve_suich

happilly 发表于 2023-6-9 14:14
+ P0 w8 k, d5 {5 a: lsw嘛？.

sw的宏
7 C" s* X& N( Z/ |9 \0 e8 Y, l

行云亦

能说一下怎么用吗？

steve_suich

行云亦 发表于 2023-6-9 15:21
4 i! D* v: @$ o8 Z: Z  {3 G能说一下怎么用吗？

5 f# `, k& ]4 i1、sw 新建一个宏文件，内容按上面的代码。2、打开一模型文件（装配体或者零件）
3、在打开的模型界面的模型树结构里面用鼠标点选所要改名的零件（或者子装配体）
- X' E8 k& `1 t1 V
4、运行刚才建好的宏文件，---弹出输入框--输入新的名字--点确定---完成。
* x2 I0 C6 u# I$ Q8 R. L  ~$ B5 }, A
7 d( }# X, h- T8 {$ \4 {0 e
8 K/ Q% J2 }$ N3 u3 ]

顺子93

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

shentu

同样运行出错。。。。。

steve_suich

3 Q) K' D' J  f8 d0 K  t1 I8 v0 ]: y

shentu 发表于 2023-6-9 22:21
5 t$ r, a, C$ x% a. a) Q- X7 A同样运行出错。。。。。

Dim swApp As Object
( j( Q; U, y" yDim Part As Object
4 \. N7 G9 r9 x- @$ XSub main()
Set swApp = Application.SldWorks
# b5 C" b) ]" G" n" ^' [Set Part = swApp.ActiveDoc
% e( ^( J: G1 T' jSet swSelMgr = Part.SelectionManager
Set swComp = swSelMgr.GetSelectedObject(1)
1 S( G8 Y& _# K/ U  e  d% Moldpathname = swComp.GetPathName
7 ~1 ~1 [9 R, q; g4 R/ k8 E: R7 r' MPath = Left(oldpathname, InStrRev(oldpathname, "\"))
ntype = Mid(oldpathname, InStrRev(oldpathname, "."))
" x$ [- V! t2 T% H3 {) L, coldfi = Mid(oldpathname, InStrRev(oldpathname, "\") + 1)
oldname = Left(oldfi, InStrRev(oldfi, ".") - 1)
' }1 d; k$ l+ t  }7 {0 z; E     mip = InputBox("changename", "name", oldname)
If mip <> "" Then
  Part.Extension.RenameDocument mip
6 n. U# R; A6 `! h) w  Part.Save
5 Y1 K- M. ~! A9 q+ {  tmpfi = Dir(Path & "*.SLDDRW")
  Do Until tmpfi = ""
    vDepend = swApp.GetDocumentDependencies(Path & tmpfi, False, False)
! ?/ W, b) F) G8 ]- T' l- K/ m    If Mid(vDepend(1), InStrRev(vDepend(1), "") + 1) = oldfi Then
% j0 t! S' i/ a0 z+ Y. c0 v# z4 s0 c& I     Name Path & tmpfi As Path & mip & ".SLDDRW"
( A5 K7 S( H" p: n) z; ]# ^    bl = swApp.ReplaceReferencedDocument(Path & mip & ".SLDDRW", vDepend(1), Path & mip & ntype)
/ ?& ^$ x2 Y8 c; Y9 H     Exit Do
   End If
' v0 K: N! x6 a0 J% Ntmpfi = Dir
Loop
End If
End Sub

$ @6 ?2 q  I, V4 d

1. 
   ' |* E6 N; E, V, v. c+ n/ M

复制代码

: _' \0 |, |. B$ Y" L$ c. R

人外有人

steve_suich 发表于 2023-6-10 09:20
8 _2 S' y/ @* g% s# F. k0 ?# Y8 dDim swApp As Object
Dim Part As Object
9 m1 c+ _" |/ ^7 vSub main()

试了下，只改了part文件名，图纸没变，问题出在哪呢？
  @% l$ y5 |! `0 p: U
6 t6 e4 w7 y( q0 y0 l5 c