|
发表于 2023-8-10 16:20:47
|
显示全部楼层
Dim swApp As Object
Dim swAssy As SldWorks.AssemblyDoc
Dim swAssyEvents As Class1
Dim swprt As SldWorks.PartDoc
Dim swprtEvents As Class2
Sub main()
Set swApp = Application.SldWorks
Set prt = swApp.GetFirstDocument
If Not prt Is Nothing Then
Set prt = swApp.ActiveDoc
If prt.GetType = 2 Then
Set swAssy = prt
Set swAssyEvents = New Class1
Set swAssyEvents.swAssy = swApp.ActiveDoc
ElseIf prt.GetType = 1 Then
Set swprt = prt
Set swprtEvents = New Class2
Set swprtEvents.swprt = swApp.ActiveDoc
End If
End If
End Sub
//////////////////////////////////
Class1
//////////////////////////////////
Public WithEvents swAssy As SldWorks.AssemblyDoc
Public Function swAssy_RenameItemNotify(ByVal entType As Long, ByVal oldName As String, ByVal NewName As String) As Long
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
If InStrRev(oldName, "\") <> 0 Then
Path = Left(oldName, InStrRev(oldName, "\"))
nfi = Left(NewName, InStrRev(NewName, ".") - 1)
tmpfi = Dir(Path & "*.SLDDRW")
Do Until tmpfi = ""
vDepend = swApp.GetDocumentDependencies(Path & tmpfi, False, False)
If Mid(vDepend(1), InStrRev(vDepend(1), "\") + 1) = Right(oldName, Len(oldName) - InStrRev(oldName, "\")) Then
Name Path & tmpfi As nfi & ".SLDDRW"
bl = swApp.ReplaceReferencedDocument(nfi & ".SLDDRW", vDepend(1), NewName)
Exit Do
End If
tmpfi = Dir
Loop
Part.Save
Else
Set swSelMgr = Part.SelectionManager
Set swComp = swSelMgr.GetSelectedObject(1)
mip = swComp.GetPathName
oldn = Left(oldName, InStrRev(oldName, "-") - 1)
Path = Left(mip, InStrRev(mip, "\"))
ntype = Mid(mip, InStrRev(mip, "."))
If mip <> "" Then
tmpfi = Dir(Path & "*.SLDDRW")
Do Until tmpfi = ""
vDepend = swApp.GetDocumentDependencies(Path & tmpfi, False, False)
If Mid(vDepend(1), InStrRev(vDepend(1), "\") + 1) = (oldn & ntype) Then
Name Path & tmpfi As Left(mip, InStrRev(mip, ".") - 1) & ".SLDDRW"
bln = swApp.ReplaceReferencedDocument(Left(mip, InStrRev(mip, ".") - 1) & ".SLDDRW", vDepend(1), mip)
Exit Do
End If
tmpfi = Dir
Loop
End If
End If
Set Part = Nothing
End Function
//////////////////////////////////
Class2
//////////////////////////////////
Public WithEvents swprt As SldWorks.PartDoc
Public Function swprt_RenameItemNotify(ByVal entType As Long, ByVal oldName As String, ByVal NewName As String) As Long
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
Path = Left(oldName, InStrRev(oldName, "\"))
nfi = Left(NewName, InStrRev(NewName, ".") - 1)
tmpfi = Dir(Path & "*.SLDDRW")
Do Until tmpfi = ""
vDepend = swApp.GetDocumentDependencies(Path & tmpfi, False, False)
If Mid(vDepend(1), InStrRev(vDepend(1), "\") + 1) = Right(oldName, Len(oldName) - InStrRev(oldName, "\")) Then
Name Path & tmpfi As nfi & ".SLDDRW"
bl = swApp.ReplaceReferencedDocument(nfi & ".SLDDRW", vDepend(1), NewName)
Exit Do
End If
tmpfi = Dir
Loop
Part.Save
End Function
|
|