模型改名同时改工程图

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

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

Dim swApp As Object0 J/ _$ g% s( a: S2 ~2 B; ?
Dim Part As Object
! v4 [# d$ K. y' t7 d7 [" _$ x, [! ^
Sub main()
) Q+ F, N' ?, u9 _8 g1 L! q
Set swApp = Application.SldWorks/ U) B' S* _4 Y9 w- q
Set Part = swApp.ActiveDoc7 J6 ?; H3 |& Q/ f! A* F( R- l
Set swSelMgr = Part.SelectionManager: S0 r% G9 d% H: |2 H! k
Set swComp = swSelMgr.GetSelectedObject(1) / }2 ]$ {, J' a& `/ `% `
oldpathname = swComp.GetPathName2 |" i3 V! P- A0 O: H( g6 z2 P
Path = Left(oldpathname, InStrRev(oldpathname, ""))
$ k% K/ b( E/ I
ntype = Mid(oldpathname, InStrRev(oldpathname, "."))3 p9 u ]' g) I. z1 Y
oldfi = Mid(oldpathname, InStrRev(oldpathname, "") + 1)7 ]+ e7 F* Z( P9 |
oldname = Left(oldfi, InStrRev(oldfi, ".") - 1)6 t! W. Z a4 ?- I
mip = InputBox("changename", "name", oldname), e) P" d* k9 ]" L/ [ T2 t
If mip <> "" Then9 K2 [+ e! ?9 M
Part.Extension.RenameDocument mip
, T. t4 u$ _+ j
Part.Save0 L: O/ R" i( J! P
tmpfi = Dir(Path & "*.SLDDRW")5 ^' }4 ]% R9 d( y
Do Until tmpfi = ""
; Z% v- ]' C% T* @4 v, k' ~
vDepend = swApp.GetDocumentDependencies(Path & tmpfi, False, False), ^) P, w- F1 I
If Mid(vDepend(1), InStrRev(vDepend(1), "") + 1) = oldfi Then
. Y' |% w" @- }& V' Y
Name Path & tmpfi As Path & mip & ".SLDDRW"
& b/ p9 @& `1 E V5 x: Q3 j. |# s
bl = swApp.ReplaceReferencedDocument(Path & mip & ".SLDDRW", vDepend(1), Path & mip & ntype)
) e, w/ s; n. X* c1 [# @* e* [
Exit Do6 ^: K( K, A8 r6 T6 C1 W! x
End If
' E; B+ O) T9 o5 l( t2 O- h- |$ h
tmpfi = Dir: x4 O$ F. x7 `& J" U
Loop
, y5 @6 U3 C$ x* ]
End If
& M+ l. t. O4 I4 _2 J* S9 }( Q6 @
End Sub

复制代码

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

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

shentu 发表于 2023-6-9 22:21
( ^0 ]6 D8 P# p1 ?2 W同样运行出错。。。。。

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

. q3 ]4 ^! ?" A; a6 F0 p

复制代码

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
v _" v; E* |- I+ f! m8 e) ^& \sw嘛？.

sw的宏

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

能说一下怎么用吗？

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

行云亦发表于 2023-6-9 15:21
2 \' K' A# R- j I能说一下怎么用吗？

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
2 s2 c8 i, r% ZDim swApp As Object5 e( F: H, T; b; I. S
Dim Part As Object' Y8 Q% A- r+ b9 r; M9 ]- R
Sub main()

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

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

模型改名同时改工程图

评分

点评

点评