模型改名同时改工程图

steve_suich · 发表于 2023-6-9 13:46:29

先在模型树选中所要修改的模型，再运行宏。宏内容如下：

Dim swApp As Object
3 _; ^: h3 r8 ^' J8 V
Dim Part As Object! g2 q* |% K. N$ f
Sub main()! C/ H5 V, y% p9 j1 d
Set swApp = Application.SldWorks
) J, L: l3 L3 N2 q, Z
Set Part = swApp.ActiveDoc
$ H+ Z4 v' X8 V3 s
Set swSelMgr = Part.SelectionManager) y& c: Y0 d1 N# ?4 Q( m4 B8 r
Set swComp = swSelMgr.GetSelectedObject(1)
/ T3 U6 W. _2 h
oldpathname = swComp.GetPathName
) w; h" d6 Q. ~2 [" X, j! d
Path = Left(oldpathname, InStrRev(oldpathname, ""))
7 l- Q4 p# O9 J W) A) s
ntype = Mid(oldpathname, InStrRev(oldpathname, "."))5 T D8 m' X2 Y* l/ |9 |
oldfi = Mid(oldpathname, InStrRev(oldpathname, "") + 1)( G$ [+ m2 ^, e# q
oldname = Left(oldfi, InStrRev(oldfi, ".") - 1)
8 T! a2 t5 H t# A6 r
mip = InputBox("changename", "name", oldname). P0 L$ g) B+ O5 {, N
If mip <> "" Then( v4 {& I2 k9 K5 B! |; P0 }0 z
Part.Extension.RenameDocument mip ) s5 J8 u" X. e
Part.Save
' U2 `7 a9 K6 C/ F8 l, y S2 t
tmpfi = Dir(Path & "*.SLDDRW")
3 ?5 v' R( Y8 ^/ R" h! @
Do Until tmpfi = ""
7 t, ^! g( L6 m6 {& Z+ H
vDepend = swApp.GetDocumentDependencies(Path & tmpfi, False, False)
" A$ d( E |; R& d
If Mid(vDepend(1), InStrRev(vDepend(1), "") + 1) = oldfi Then0 L% _) I$ m1 j f, h* t
Name Path & tmpfi As Path & mip & ".SLDDRW"
# f( o; p/ p" ?: R) t$ S
bl = swApp.ReplaceReferencedDocument(Path & mip & ".SLDDRW", vDepend(1), Path & mip & ntype) 9 _% \0 T0 B0 ?# P8 l7 V- T
Exit Do
, N' t* W* K ]9 d9 V- \& f
End If
1 N# ?* d1 S$ F8 ]5 Q1 O8 @/ x
tmpfi = Dir, w. [4 N) w- ?) b
Loop
' g1 q: ^+ a* ~5 Q0 s9 P+ t
End If1 o3 t& ?6 T" k! Q# l
End Sub

复制代码

happilly · 发表于 2023-6-9 14:14:20

sw嘛？.

da · 发表于 2023-6-9 14:24:40

你是chatgpt搞的？

steve_suich · 发表于 2023-6-9 14:28:38

happilly 发表于 2023-6-9 14:14
|# q9 d3 z' u4 tsw嘛？.

sw的宏

行云亦 · 发表于 2023-6-9 15:21:17

能说一下怎么用吗？

steve_suich · 发表于 2023-6-9 17:21:12

行云亦发表于 2023-6-9 15:21
, m' q8 \5 e7 [4 N- |3 U能说一下怎么用吗？

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

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

顺子93 · 发表于 2023-6-9 21:52:39

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

shentu · 发表于 2023-6-9 22:21:02

同样运行出错。。。。。

steve_suich · 发表于 2023-6-10 09:20:42

本帖最后由 steve_suich 于 2023-6-10 09:21 编辑

shentu 发表于 2023-6-9 22:21
# P" c: O6 E) r) v6 x同样运行出错。。。。。

Dim swApp As Object
Dim Part As Object
Sub main()
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
Set swSelMgr = Part.SelectionManager
Set swComp = swSelMgr.GetSelectedObject(1)
oldpathname = swComp.GetPathName
Path = Left(oldpathname, InStrRev(oldpathname, "\"))
ntype = Mid(oldpathname, InStrRev(oldpathname, "."))
oldfi = Mid(oldpathname, InStrRev(oldpathname, "\") + 1)
oldname = Left(oldfi, InStrRev(oldfi, ".") - 1)
   mip = InputBox("changename", "name", oldname)
If mip <> "" Then
  Part.Extension.RenameDocument mip
  Part.Save
  tmpfi = Dir(Path & "*.SLDDRW")
  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)
   Exit Do
End If
tmpfi = Dir
Loop
End If
End Sub

( o3 U+ ^' _2 |) t4 Y3 P6 n' s

复制代码

人外有人 · 发表于 2023-6-19 10:59:33

steve_suich 发表于 2023-6-10 09:20
7 r/ j9 z: j' s3 `Dim swApp As Object
; O0 E s% {9 P8 |3 K( C7 eDim Part As Object; _/ z6 a$ p$ V5 }3 C q
Sub main()

试了下，只改了part文件名，图纸没变，问题出在哪呢？

		自动登录	找回密码
密码			注册会员

模型改名同时改工程图

评分

点评

点评