VBA Replace Selected Instances of a Part
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
So the intention of the macro is to have the user have preselected components that they want to replace (for example replace bolts for a different size, etc)
This is my code
Sub ReplaceComponent()
'Initialize Variables
Dim InvApp As Inventor.Application
Dim InvDoc As Inventor.Document
Set InvApp = ThisApplication
Set InvDoc = InvApp.ActiveDocument
'Get AssemblyName for later use
Dim AssemblyName As String
AssemblyName = InvDoc.DisplayName
'Debug.Print AssemblyName
'Check to make sure something is selected
If InvDoc.SelectSet.Count < 1 Then
MsgBox ("Please select at least one document")
Exit Sub
End If
'Get the first part
Dim FirstDoc As ComponentOccurrence
Set FirstDoc = InvDoc.SelectSet.Item(1)
Dim FirstPart As Document
Set FirstPart = FirstDoc.Definition.Document
Dim FirstPartName As String
FirstPartName = FirstPart.FullFileName
'Debug.Print FirstPartName
'Check to make sure all the selected parts are the same
Dim SelDoc As ComponentOccurrence
Dim SelPart As Document
Dim SelPartName As String
Dim SelSet As SelectSet
Set SelSet = InvDoc.SelectSet
Dim Count As Integer
Count = InvDoc.SelectSet.Count
Dim j As Integer
For j = 2 To Count
Set SelDoc = SelSet.Item(j)
Set SelPart = SelDoc.Definition.Document
SelPartName = SelPart.FullFileName
'Debug.Print SelPartName
If SelPartName <> FirstPartName Then
MsgBox ("You can only select multiple items if they are all the same")
Exit Sub
End If
Next j
'Get the file path of the selected part
Dim FilePath As String
FilePath = FirstPart.FullFileName
'Debug.Print FilePath
'Get the file path of the replacement part
Dim NewFilePath As String
NewFilePath = InputBox("Input the location of the replacement part.", "Replace Component", FilePath)
'Debug.Print NewFilePath
'Check if the new file exists
If Dir(NewFilePath) = "" Then
MsgBox ("The specified file does not exist")
Exit Sub
End If
If NewFilePath = "" Then
Exit Sub
End If
'Loop thru all of the selected components & replace them
Dim i As Integer
Dim SelOcc As ComponentOccurrence
For i = 1 To Count
Set SelOcc = SelSet.Item(i)
Set SelPart = SelOcc.Definition.Document
SelPartName = SelPart.DisplayName
'Debug.Print SelPartName
Call SelOcc.Replace(NewFilePath, False)
Set SelOcc = Nothing
Next i
im getting invalid procedure call or argument error and when i debug the yellow arrow is pointing to the "Set SelOcc = SelSet.Item(i) line
I commented out the call SelOcc.Replace line and the macro ran fine - so im not sure if the replace line is the issue or the Set SelOcc line is the issue
End Sub