模型改名同时改工程图

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

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

Dim swApp As Object
% d {: i! B9 C( g
Dim Part As Object0 d3 L/ N" O- X: x8 u `
Sub main()
) A# a7 T3 M7 W0 X- {
Set swApp = Application.SldWorks
' x* u( a9 F! H" y! L0 G% k
Set Part = swApp.ActiveDoc* S7 J, E4 r" d2 v4 |* o. E
Set swSelMgr = Part.SelectionManager
p- \7 n1 ?5 g- C2 a
Set swComp = swSelMgr.GetSelectedObject(1) 3 q# o$ y7 i8 {5 a
oldpathname = swComp.GetPathName
4 `- H2 t# N7 B
Path = Left(oldpathname, InStrRev(oldpathname, ""))" J+ r% ?3 W. \
ntype = Mid(oldpathname, InStrRev(oldpathname, "."))/ \" z- } N% c
oldfi = Mid(oldpathname, InStrRev(oldpathname, "") + 1)# b7 N9 n2 z3 R5 s4 r) D1 }
oldname = Left(oldfi, InStrRev(oldfi, ".") - 1)
5 `2 d8 a1 x3 |' G4 t
mip = InputBox("changename", "name", oldname)9 P, e8 v7 b, Q+ a d( V
If mip <> "" Then
9 {* {6 @3 _" d0 c8 I$ Y! a, c
Part.Extension.RenameDocument mip 3 U9 ]9 C* b- `& b6 }% f
Part.Save
( |! s# S/ o7 U8 n e1 W4 e4 j2 ~
tmpfi = Dir(Path & "*.SLDDRW")
$ E2 D3 \. R( H( E7 R
Do Until tmpfi = ""& ^4 l* T) L$ k( S
vDepend = swApp.GetDocumentDependencies(Path & tmpfi, False, False)
: N6 W- D+ @8 i+ B6 E/ D
If Mid(vDepend(1), InStrRev(vDepend(1), "") + 1) = oldfi Then
) U" P* i- D; g/ P) T
Name Path & tmpfi As Path & mip & ".SLDDRW" 9 a$ ~: Z; J$ f% ~
bl = swApp.ReplaceReferencedDocument(Path & mip & ".SLDDRW", vDepend(1), Path & mip & ntype)
/ n" x/ ?" a' Q1 u
Exit Do
3 T3 I. o) }5 d7 v+ N9 T) k
End If: `8 K9 v) T0 k5 n1 P! s" L
tmpfi = Dir" o8 j9 \3 J! {4 @3 F+ a
Loop
( |1 k5 ?( N3 H2 x1 _, Q4 R
End If' {7 r' w ]& n$ s) |
End Sub

复制代码

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

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

shentu 发表于 2023-6-9 22:216 i1 k# A* j. b- U8 N% i9 Z0 ?3 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

8 P$ t% \6 s( w& t5 a

复制代码

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" A7 T% V6 H `! S% o
sw嘛？.

sw的宏

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

能说一下怎么用吗？

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

行云亦发表于 2023-6-9 15:21# o6 @, I- J& n2 h2 i; x
能说一下怎么用吗？

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

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

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

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

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

同样运行出错。。。。。

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

steve_suich 发表于 2023-6-10 09:20
5 R" e% ?' p- X' \- U$ A" PDim swApp As Object6 }- U2 o# ?4 Y* |" [% i
Dim Part As Object/ l y# e$ l& e
Sub main()

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

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

模型改名同时改工程图

评分

点评

点评