Here is my rule to replace derived reference. I can't take complete credit for it though, as I got it off of a google search a couple of years ago.
Option Strict On
Sub Main
topDoc = ThisApplication.ActiveDocument
Replace()
End Sub
Private topDoc As Document
Public Sub Replace()
If (Not LevelOfDetailIsMaster()) Then Return
Dim docToReplace As Document = FindDocToReplace()
If (docToReplace Is Nothing) Then Return
Dim replacementFileName As String = SelectReplacementFilename(docToReplace.DisplayName)
If (String.IsNullOrEmpty(replacementFileName)) Then Return
If (String.Equals(docToReplace.FullFileName, replacementFileName, StringComparison.OrdinalIgnoreCase)) Then Return
Dim replacementPart As Document = ThisApplication.Documents.Open(replacementFileName, False)
Dim doReplace As Boolean = True
If (replacementPart.InternalName <> docToReplace.InternalName) Then
MessageBox.Show("The replacement part (" & replacementPart.DisplayName & ") does not seem to be closely related to the original part, so it cannot be used.", _
"Base Part Replacer", MessageBoxButtons.OK, MessageBoxIcon.Warning)
doReplace = False
End If
replacementPart.ReleaseReference()
If (Not doReplace) Then Return
Dim fileNameToReplace As String = docToReplace.FullFileName
ReplaceReferences(topDoc, fileNameToReplace, replacementFileName)
topDoc.Update()
End Sub
Function FindDocToReplace() As Document
Dim basePartList As New List(Of Document)
If (topDoc.DocumentType = DocumentTypeEnum.kPartDocumentObject) Then
AddBaseParts(basePartList, topDoc)
Else
For Each refDoc As Inventor.Document In topDoc.AllReferencedDocuments
If (refDoc.DocumentType = DocumentTypeEnum.kPartDocumentObject) Then
AddBaseParts(basePartList, refDoc)
End If
Next
End If
If (basePartList.Count = 0) Then
MessageBox.Show("No base parts were found in the document: " & topDoc.DisplayName, "Base Part Replacer")
ElseIf (basePartList.Count = 1) Then
Return basePartList(0)
Else
Dim partNameList As New List(Of String)
For Each baseDoc As Document In basePartList
partNameList.Add(baseDoc.DisplayName)
Next
Dim selectedName As String = InputListBox("Select the part to replace", partNameList, partNameList(0), "Replace Part", "Parts").ToString()
Dim selectedIndex As Integer = partNameList.IndexOf(selectedName)
Return basePartList(selectedIndex)
End If
Return Nothing
End Function
Sub AddBaseParts(ByVal basePartList As List(Of Document), ByVal doc As Document)
For Each refDoc As Document In doc.ReferencedDocuments
If (refDoc.DocumentType = DocumentTypeEnum.kPartDocumentObject AndAlso Not IsiPartMember(refDoc)) Then
If (Not basePartList.Contains(refDoc)) Then
basePartList.Add(refDoc)
End If
End If
Next
End Sub
Function IsiPartMember(ByVal doc As Document) As Boolean
If (doc.DocumentType <> DocumentTypeEnum.kPartDocumentObject) Then Return False
Dim partDoc As PartDocument = DirectCast(doc, PartDocument)
Return partDoc.ComponentDefinition.IsiPartMember
End Function
Function SelectReplacementFilename(ByVal filenameToReplace As String) As String
Dim oFileDlg As Inventor.FileDialog = Nothing
ThisApplication.CreateFileDialog(oFileDlg)
oFileDlg.Filter = "Part Files (*.ipt)|*.ipt"
oFileDlg.DialogTitle = "Replace " & filenameToReplace
'oFileDlg.InitialDirectory = ThisDoc.Path
oFileDlg.CancelError = False
Try
oFileDlg.ShowOpen()
Return oFileDlg.FileName
Catch
End Try
Return String.Empty
End Function
Sub ReplaceReferences(ByVal doc As Document, ByVal fileNameToReplace As String, ByVal replacementFileName As String)
ReplaceReferencesInOneDoc(doc, fileNameToReplace, replacementFileName)
For Each subDoc As Document In doc.AllReferencedDocuments
If (String.Equals(subDoc.FullFileName, fileNameToReplace, StringComparison.OrdinalIgnoreCase) OrElse _
String.Equals(subDoc.FullFileName, replacementFileName, StringComparison.OrdinalIgnoreCase)) Then
Continue For
End If
ReplaceReferencesInOneDoc(subDoc, fileNameToReplace, replacementFileName)
Next
End Sub
Sub ReplaceReferencesInOneDoc(ByVal doc As Document, ByVal fileNameToReplace As String, ByVal replacementFileName As String)
For Each docDesc As DocumentDescriptor In doc.ReferencedDocumentDescriptors
Dim desc As FileDescriptor = docDesc.ReferencedFileDescriptor
If (desc.ReferenceMissing) Then Continue For
Console.WriteLine("Referenced RelativeFileName = " & desc.RelativeFileName)
Trace.WriteLine("Referenced RelativeFileName = " & desc.RelativeFileName)
If (String.Equals(desc.FullFileName, fileNameToReplace, StringComparison.OrdinalIgnoreCase)) Then
desc.ReplaceReference(replacementFileName)
Exit For
End If
Next
End Sub
Function LevelOfDetailIsMaster() As Boolean
Dim assemDoc As AssemblyDocument = TryCast(topDoc, AssemblyDocument)
If (assemDoc Is Nothing) Then Return True
Dim repMgr As RepresentationsManager = assemDoc.ComponentDefinition.RepresentationsManager
Dim lodType As LevelOfDetailEnum = repMgr.ActiveLevelOfDetailRepresentation.LevelOfDetail
If (lodType <> LevelOfDetailEnum.kMasterLevelOfDetail) Then
MessageBox.Show("This rule can only be run in the Master Level of Detail.", "Base Part Replacer")
Return False
End If
Return True
End Function
Andrew In’t Veld
Designer / CAD Administrator
