模型改名同時改工程圖

cszhouhx01

樓主你好！我按著你給的代碼宏運行了還是有問題呢   運行報錯

steve_suich

cszhouhx01 發表于 2024-9-25 21:43
, y5 @, a# s; y4 M8 y7 r樓主你好！我按著你給的代碼宏運行了還是有問題呢   運行報錯

提供一下你的宏，我檢查一下
8 }7 Y; K8 ]6 t. x

cszhouhx01

- i# ~* u. {/ S) F3 v7 GDim swApp As Object
Dim Part As Object
Sub main()( d; Q1 b; F0 ?# l- {
: _  J0 F& a. }Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc4 t2 a3 y3 ~0 J9 @
Set swSelMgr = Part.SelectionManager
6 C" @( b. `+ X. i& h: d- \2 H$ YSet swComp = swSelMgr.GetSelectedObject(1)! D. @) D9 Z1 O4 s% c
oldpathname = swComp.GetPathName! t: i  S9 z% v% S$ R$ _# x
Path = Left(oldpathname, InStrRev(oldpathname, "\"))
ntype = Mid(oldpathname, InStrRev(oldpathname, ".")): f% I; o3 ^. B# V/ i  N- Y( I5 s
5 p6 _1 [  c: `+ a5 E  g0 Foldfi = Mid(oldpathname, InStrRev(oldpathname, "\") + 1)& _! r& R0 n4 o
oldname = Left(oldfi, InStrRev(oldfi, ".") - 1)2 d! N5 r1 [/ I# B  M" H6 j
- k& d! q7 ~# G% B" A) V     mip = InputBox("changename", "name", oldname)$ e* \5 I$ z- t; B" w
If mip <> "" Then
  Part.Extension.RenameDocument mip8 b: X. F' n' y  w
! x( _- `  u$ _  Part.Save
  tmpfi = Dir(Path & "*.SLDDRW")
2 f7 Y# C  D0 Y+ U: h2 O. a  Do Until tmpfi = ""- v4 j; l6 {8 v9 h# M5 [
4 o4 I) k6 }- B  g( a3 i    vDepend = swApp.GetDocumentDependencies(Path & tmpfi, False, False)
    If Mid(vDepend(1), InStrRev(vDepend(1), "") + 1) = oldfi Then% I+ Y3 @) [4 D" ]
: ^; J0 K, n) ^$ c' ?0 z     Name Path & tmpfi As Path & mip & ".SLDDRW"
3 [+ ]1 n9 c; p& O: s    bl = swApp.ReplaceReferencedDocument(Path & mip & ".SLDDRW", vDepend(1), Path & mip & ntype)9 s+ K- S$ t8 i9 a& j' E0 B4 o2 @% w
! K9 s4 L4 N! R$ w% L: q! d     Exit Do
8 ^) x, O  p6 m+ a/ h   End If
8 W6 p$ d, x5 t7 f+ ?( qtmpfi = Dir* @: D+ V& b  H3 |; B
# m/ t4 ]0 Z  [$ A! ^* j  K1 ULoop
End If  @/ K' \6 k  [/ y
End Sub2


你好   我就是按你這提供的代碼寫的宏

前流氓用戶新號

怎么講

) H2 ]; B1 u- j3 E3 w

steve_suich

這個宏代碼確實有點奇怪，同樣的代碼在不同的電腦上運行有的可以，有的不行。SW版本都是2016，不好排查原因了。

steve_suich

發現一個問題，如果工程圖里面沒有參考任何模型。那么這個代碼vDepend = swApp.GetDocumentDependencies(Path & tmpfi, False, False)就會報錯。

steve_suich

cszhouhx01 發表于 2024-9-27 21:36
Dim swApp As Object
. ~6 n5 X2 ]- s' I, sDim Part As Object
Sub main()( d; Q1 b; F0 ?# l- {

7 x1 @6 U8 ^7 u( |If Mid(vDepend(1), InStrRev(vDepend(1), "") + 1) = oldfi Then  缺少"\"
正確的應該是If Mid(vDepend(1), InStrRev(vDepend(1), "\") + 1) = oldfi Then
$ b  F/ s9 m- s0 l8 B2 u