模型改名同时改工程图

steve_suich

先在模型树选中所要修改的模型，再运行宏。宏内容如下：
; P$ J9 q, m" o9 q

1. Dim swApp As Object
   
2. Dim Part As Object
     `. x% J4 u4 A6 ]* g  E3 I/ Z
3. Sub main()
   ! F1 T  v! z  R1 ]
4. Set swApp = Application.SldWorks
   " a) e: s5 X8 L2 {2 f8 P
5. Set Part = swApp.ActiveDoc
   
6. Set swSelMgr = Part.SelectionManager
   
7. Set swComp = swSelMgr.GetSelectedObject(1)
   
8. oldpathname = swComp.GetPathName
   / q0 T7 L7 V1 }% z  ~' C+ ]) }
9. Path = Left(oldpathname, InStrRev(oldpathname, ""))
   
10. ntype = Mid(oldpathname, InStrRev(oldpathname, "."))
    ' v+ E5 ~3 D/ T& g& d
11. oldfi = Mid(oldpathname, InStrRev(oldpathname, "") + 1)
    0 ^  ?% |; H  z9 D9 i3 [
12. oldname = Left(oldfi, InStrRev(oldfi, ".") - 1)
    & M8 i0 U8 s: ?% V8 ]8 G
13.      mip = InputBox("changename", "name", oldname)
    
14. If mip <> "" Then
    
15.   Part.Extension.RenameDocument mip
    
16.   Part.Save
    - k7 b8 p2 V/ Z! U: m
17.   tmpfi = Dir(Path & "*.SLDDRW")
    
18.   Do Until tmpfi = ""
    
19.     vDepend = swApp.GetDocumentDependencies(Path & tmpfi, False, False)
      C7 g) P6 F2 O: p! D! q
20.     If Mid(vDepend(1), InStrRev(vDepend(1), "") + 1) = oldfi Then
    7 [; y6 }; Q/ h; Y
21.      Name Path & tmpfi As Path & mip & ".SLDDRW"
    3 k5 Y4 E: d# I* k  W
22.     bl = swApp.ReplaceReferencedDocument(Path & mip & ".SLDDRW", vDepend(1), Path & mip & ntype)
    & q$ E9 f0 w* q6 f7 M8 y
23.      Exit Do
    ' A& _7 N0 r  A! }  \2 k% T" I7 i
24.    End If
    1 b, d- A/ E9 m( }6 W$ S. T
25. tmpfi = Dir
    
26. Loop
    
27. End If
    ' V' H; j) r( z
28. End Sub

复制代码

5 z# b3 [* M' ]" g4 U+ ]' Z

happilly

sw嘛？.

da

你是chatgpt搞的？

steve_suich

happilly 发表于 2023-6-9 14:14
# A; _# B% x! z1 M8 p5 o1 d' }7 dsw嘛？.

# S9 x9 u$ z. ]% C, x! a" _sw的宏
/ }5 D, Y6 O0 v9 x6 s( R

行云亦

能说一下怎么用吗？

steve_suich

行云亦 发表于 2023-6-9 15:21
: D1 J1 E1 ?# V  z能说一下怎么用吗？

1 R5 Q; t4 v* G4 O' L: G  b" t1、sw 新建一个宏文件，内容按上面的代码。2、打开一模型文件（装配体或者零件）
3、在打开的模型界面的模型树结构里面用鼠标点选所要改名的零件（或者子装配体）

4、运行刚才建好的宏文件，---弹出输入框--输入新的名字--点确定---完成。


; x* v( L" z! w* @8 N' e0 F5 _+ \# v& L% J

顺子93

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

shentu

同样运行出错。。。。。

steve_suich

shentu 发表于 2023-6-9 22:21
同样运行出错。。。。。

Dim swApp As Object
Dim Part As Object
. C( h5 X: H) Q" R' VSub main()
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
Set swSelMgr = Part.SelectionManager
Set swComp = swSelMgr.GetSelectedObject(1)
+ ^% K: w/ b3 J4 v$ A6 Poldpathname = swComp.GetPathName
Path = Left(oldpathname, InStrRev(oldpathname, "\"))
; C3 H: C) t* q3 {( N5 Entype = Mid(oldpathname, InStrRev(oldpathname, "."))
+ H# G0 e7 B! x- V- ^' joldfi = Mid(oldpathname, InStrRev(oldpathname, "\") + 1)
oldname = Left(oldfi, InStrRev(oldfi, ".") - 1)
     mip = InputBox("changename", "name", oldname)
4 ?9 F: ?% w* B2 {* ~/ |* BIf mip <> "" Then
  Part.Extension.RenameDocument mip
  Part.Save
  _) \7 [9 \) S3 c6 b, N& a  tmpfi = Dir(Path & "*.SLDDRW")
  Do Until tmpfi = ""
- Z) R8 w, J% F* ^+ @    vDepend = swApp.GetDocumentDependencies(Path & tmpfi, False, False)
    If Mid(vDepend(1), InStrRev(vDepend(1), "") + 1) = oldfi Then
7 [3 e: a, j* P4 G     Name Path & tmpfi As Path & mip & ".SLDDRW"
. y$ \& `! Y+ Z/ Y1 m/ P    bl = swApp.ReplaceReferencedDocument(Path & mip & ".SLDDRW", vDepend(1), Path & mip & ntype)
; k( w" d. U! V4 T6 f, v     Exit Do
7 F& `2 j2 D. C" u7 c   End If
0 Q: B  V" t% `% J1 f1 ntmpfi = Dir
$ ^, P" \# {( d8 M% ]; GLoop
. G' E4 T* x" nEnd If
- x0 v) ^) |$ \, ^8 e1 y6 o. [2 Y+ XEnd Sub

( j0 _/ {" h  l9 [* `6 T

1. 
   

复制代码

! h, e5 o- G& N% V7 E# f

人外有人

steve_suich 发表于 2023-6-10 09:20
Dim swApp As Object
' Y  d. s5 C+ @4 s  O$ h7 o3 ?Dim Part As Object
$ S4 i( u, ]% M& U& HSub main()

* |+ ?0 @2 F3 b& Y8 k/ G+ P3 u试了下，只改了part文件名，图纸没变，问题出在哪呢？
; K- R9 b0 F0 F4 Q- c; _