VBA Save and replace all instances of a part

[pball]

I'm trying to make a script to replace all instances of a part/assembly in an assembly with a new copy of that file. So I'm trying to make an improved version of the "save and replace component" feature since it will only replace one part. I've created an ideastation post to have "save and replace component" be able to replace all instances of the part you replacing, but I want this feature in the mean time.

So far the script prompts you to select a part, enter a few filename, and does a check on the new file name. I need help with saving a new copy of the selected part and replacing all instances of the original part in the assembly. Is there a simple way to replace all instances or will it require a loop through all components and checking the filename then replacing ones that match, if so that's something I should be able to do. Thanks.

Public Sub Save_Replace_All()
    'Checks if open document is assembly
    If (ThisApplication.ActiveDocument.DocumentType <> kAssemblyDocumentObject) Then
        MsgBox "This is NOT an assembly document!", vbExclamation
        Exit Sub
    End If
    
    Dim oPart As ComponentOccurrence
    Dim opartdoc As Document
    Dim oPartdoc2 As Document
    Dim NewFileName As String
    Dim NewFilePath As String
    
    Set oPart = ThisApplication.CommandManager.Pick(kAssemblyOccurrenceFilter, "Select the part to save and replace all.")
    Set opartdoc = oPart.Definition.Document
        
    NewFileName = InputBox("What is the new file name for " & filename_noext(opartdoc.FullFileName) & "?", "New File Name", filename_noext(opartdoc.FullFileName))
    NewFilePath = ThisApplication.FileLocations.Workspace & "\" & NewFileName & "." & file_ext(opartdoc.FullFileName)
    
    If (fileExists(NewFilePath)) Or (NewFileName = "") Then
        MsgBox ("Error! Either file exists or no filename given")
        Exit Sub
    End If

    'needs to save a copy of opartdoc as newfilepath, found this in another script but the script editor doesn't like it
    opartdoc.SaveAs(newfilepath,False)

    'This replaces the selected part but I need to replace them all
    Call oPart.Replace(NewFilePath, False)
End Sub

[Anonymous]

You only have to set the second parameter to TRUE. That's all.

oPart.Replace(NewFilePath, True)

[pball]

I still get an error from the vba editor.

Compile error:
Expected: =

[pball · Accepted solution]

Well I finally got everything working. Found out how to save a copy of the selected part/assembly and replace all instances in the active assembly. So it won't affect sub-assemblies or parent assemblies if you are editing a sub-assembly.

Public Sub Save_Replace_All()
    'Checks if open document is assembly
    If (ThisApplication.ActiveDocument.DocumentType <> kAssemblyDocumentObject) Then
        MsgBox "This is NOT an assembly document!", vbExclamation
        Exit Sub
    End If
    
    Dim oPart As ComponentOccurrence
    Dim opartdoc As Document
    Dim oPartdoc2 As Document
    Dim NewFileName As String
    Dim NewFilePath As String
    
    Set oPart = ThisApplication.CommandManager.Pick(kAssemblyOccurrenceFilter, "Select the part to save and replace all.")
    Set opartdoc = oPart.Definition.Document
        
    NewFileName = InputBox("What is the new file name for " & filename_noext(opartdoc.FullFileName) & "?", "New File Name", filename_noext(opartdoc.FullFileName))
    NewFilePath = ThisApplication.FileLocations.Workspace & "\" & NewFileName & "." & file_ext(opartdoc.FullFileName)
    
    If (fileExists(NewFilePath)) Or (NewFileName = "") Then
        MsgBox ("Error! Either file exists or no filename given")
        Exit Sub
    End If

    Call opartdoc.SaveAs(NewFilePath, True)

    Dim fd As DocumentDescriptor
    For Each fd In ThisApplication.ActiveEditDocument.ReferencedDocumentDescriptors
        If (fd.FullDocumentName = opartdoc.FullFileName) Then fd.ReferencedFileDescriptor.ReplaceReference (NewFilePath)
    Next
End Sub

[Anonymous]

Get a compile error:

Sub or Fnction not defined

filename_noext

[Anonymous]

And fileExists

I don't have your function in the project. But it still works if I delete functions. 

It will be better if it uses ThisApplication.CreateFileDialog.

[pball]

Well here are the couple of functions I use in this script if anyone is interested.

Also apparently that is my old version, since I did add a file save dialog afterwards.

Public Sub Save_Replace_All()
    On Error GoTo err:
    'Checks if open document is assembly
    If (ThisApplication.ActiveDocument.DocumentType <> kAssemblyDocumentObject) Then
        MsgBox "This is NOT an assembly document!", vbExclamation
        Exit Sub
    End If
    
    Dim oPart As ComponentOccurrence
    Dim opartdoc As Document
    Dim NewFileName As String
    Dim NewFilePath As String
    
    Set oPart = ThisApplication.CommandManager.Pick(kAssemblyOccurrenceFilter, "Select the part to save and replace all.")
    If (oPart Is Nothing) Then Exit Sub
    Set opartdoc = oPart.Definition.Document

   'Create a new FileDialog object.
    Dim oFileDlg As FileDialog
    Call ThisApplication.CreateFileDialog(oFileDlg)

    'check file type and set dialog filter
    If opartdoc.DocumentType = kPartDocumentObject Then
        oFileDlg.Filter = "Autodesk Inventor Part Files (*.ipt)|*.ipt"
    ElseIf opartdoc.DocumentType = kAssemblyDocumentObject Then
        oFileDlg.Filter = "Autodesk Inventor Assembly Files (*.iam)|*.iam"
    End If

    oFileDlg.InitialDirectory = ThisApplication.FileLocations.Workspace
    oFileDlg.filename = filename(opartdoc.FullFileName)
    oFileDlg.CancelError = True
    
    On Error Resume Next
    
    Call oFileDlg.ShowSave

    If err Then
        Exit Sub
    ElseIf oFileDlg.filename <> "" Then
        NewFilePath = oFileDlg.filename
    End If

    ThisApplication.SilentOperation = True
    Call opartdoc.SaveAs(NewFilePath, True)
    ThisApplication.SilentOperation = False

    Dim fd As DocumentDescriptor
    For Each fd In ThisApplication.ActiveEditDocument.ReferencedDocumentDescriptors
        If (fd.FullDocumentName = opartdoc.FullFileName) Then fd.ReferencedFileDescriptor.ReplaceReference (NewFilePath)
    Next
    
    Exit Sub
err:
    ThisApplication.SilentOperation = False
    On Error GoTo 0
    Resume
End Sub

Function filename_noext(spth As String)
    'Returns filename without extension from full path
    If spth <> "" Then
        filename_noext = Mid(spth, InStrRev(spth, "\") + 1, InStrRev(spth, ".") - InStrRev(spth, "\") - 1)
    Else:
        filename_noext = ""
    End If
End Function

[Chad.Snyder8B8AB]

I am trying to use this macro and its coming up with an error message that says compile error can't find project or library. 

I am very very very raw with macros and just trying to get this to work to save me some steps.

[Yijiang.Cai]

This idea has been implemented within Autodesk Inventor 2024.2. Please review the Inventor 2024.2 What's New article here. For more information regarding how you may leverage the feature, and please review this page. Special thanks to everyone who cast a vote for it.