Hi again @Curtis_Waguespack,
I have a need of your expertise. I would like this code to read the Excel rows until it hits an empty row. Currently I have it set to 500, but there are times it is much less or could be more. Would you please modify it so it checks if the row is empty?
Thanks in advance.
Bob
'Virtual Parts Excel Import
'based on a Curtis Waguespack rule (2019)
'[check that the active document is an assembly file
If ThisApplication.ActiveDocument.DocumentType <> kAssemblyDocumentObject Then
MessageBox.Show("Please run this rule from an assembly file.", "iLogic")
Exit Sub
End If
']
'[information
MessageBox.Show("This rule will read an Excel file of Virtual Parts and add them to the assembly." _
& vbLf & vbLf & "Use '$\Styles\MyCompany\iLogic\External Rules\Virtual Parts Excel Import Template.xlsx' as a template." _
& vbLf & vbLf & "Wait for Completed message. It may take some time to finish.", "Virtual Parts Import", _
MessageBoxButtons.OK)
']
'[browse for the Excel file
oMsg = "Select a Virtual Parts Excel File"
'update the status bar
ThisApplication.StatusBarText = oMsg
Dim oFileDlg As Inventor.FileDialog = Nothing
InventorVb.Application.CreateFileDialog(oFileDlg)
oFileDlg.Filter = "Excel Files (*.xls;*.xlsx)|*.xls;*.xlsx"
oFileDlg.DialogTitle = oMsg
oFileDlg.InitialDirectory = ThisDoc.Path
oFileDlg.CancelError = True
Try
oFileDlg.ShowOpen()
Catch
'catch error when no file is selected
Return 'exit rule
End Try
If Err.Number <> 0 Then
MessageBox.Show("A problem occured when getting the Excel file.", "iLogic",MessageBoxButtons.OK,MessageBoxIcon.Error)
Return 'exit if file not selected
ElseIf oFileDlg.FileName <> "" Then
myXLS = oFileDlg.FileName
'update the status bar with the Excel file name
ThisApplication.StatusBarText = "...reading info from " & myXLS
End If
']
Dim MyArrayList As New ArrayList
MyArrayList = GoExcel.CellValues(myXLS, "Sheet1", "A2", "A500")
'define assembly
Dim asmDoc As AssemblyDocument
asmDoc = ThisApplication.ActiveDocument
'define assembly Component Definition
Dim oAsmCompDef As AssemblyComponentDefinition
oAsmCompDef = ThisApplication.ActiveDocument.ComponentDefinition
Dim occs As ComponentOccurrences
occs = asmDoc.ComponentDefinition.Occurrences
Dim identity As Matrix
identity = ThisApplication.TransientGeometry.CreateMatrix
Dim sVirtPart As String
'[get info from the XLS file
For MyRow = 2 To 500 'index row 2 through 500
iQTY = GoExcel.CellValue("A" & MyRow) 'QTY
oProp1 = GoExcel.CellValue("B" & MyRow) 'Part Number
oProp2 = GoExcel.CellValue("C" & MyRow) 'UOM
oProp3 = GoExcel.CellValue("D" & MyRow) 'Description
oProp4 = GoExcel.CellValue("E" & MyRow) 'Item Description
oProp5 = GoExcel.CellValue("F" & MyRow) 'Has Drawing
oProp6 = GoExcel.CellValue("G" & MyRow) 'Product Code
oProp7 = GoExcel.CellValue("H" & MyRow) 'Spare Part
oProp8 = GoExcel.CellValue("I" & MyRow) 'Critical Spare
oProp9 = GoExcel.CellValue("J" & MyRow) 'Manufacturer
oProp10 = GoExcel.CellValue("K" & MyRow) 'Source Code
oProp11 = GoExcel.CellValue("L" & MyRow) 'MyCompany Supplied
sVirtPart = oProp1 'defines the virtual part name
']
'[Iterate through all of the occurrences in the assembly
Dim asmOcc As ComponentOccurrence
For Each asmOcc In oAsmCompDef.Occurrences
'get name of occurence only (sees only everything left of the colon)
Dim oOcc As Object
oOcc = asmOcc.Name.Split(":")(0)
'look at only virtual components
If TypeOf asmOcc.Definition Is VirtualComponentDefinition Then
'compare name selected from list to the
'existing virtual parts
If oOcc = sVirtPart Then
'delete existing virtual parts if name matches
asmOcc.Delete
End If
End If
Next
']
'[create first instance of the virtual part
Dim virtOcc As ComponentOccurrence
If iQTY >= 1 Then
virtOcc = occs.AddVirtual(sVirtPart, identity)
Try
iProperties.Value(sVirtPart & ":1", "Project", "Part Number") = oProp1
Catch 'catch error when oProp1 = nothing
End Try
Try
iProperties.Value(sVirtPart & ":1", "Custom", "UOM") = oProp2
Catch 'catch error when oProp2 = nothing
End Try
Try
iProperties.Value(sVirtPart & ":1", "Project", "Description") = oProp3
Catch 'catch error when oProp3 = nothing
End Try
Try
iProperties.Value(sVirtPart & ":1", "Custom", "Item Description") = oProp4
Catch 'catch error when oProp4 = nothing
End Try
Try
iProperties.Value(sVirtPart & ":1", "Custom", "Has Drawing") = oProp5
Catch 'catch error when oProp5 = nothing
End Try
Try
iProperties.Value(sVirtPart & ":1", "Custom", "Product Code") = oProp6
Catch 'catch error when oProp6 = nothing
End Try
Try
iProperties.Value(sVirtPart & ":1", "Custom", "Spare Part") = oProp7
Catch 'catch error when oProp7 = nothing
End Try
Try
iProperties.Value(sVirtPart & ":1", "Custom", "Critical Spare") = oProp8
Catch 'catch error when oProp8 = nothing
End Try
Try
iProperties.Value(sVirtPart & ":1", "Custom", "Manufacturer") = oProp9
Catch 'catch error when oProp9 = nothing
End Try
Try
iProperties.Value(sVirtPart & ":1", "Custom", "Source Code") = oProp10
Catch 'catch error when oProp10 = nothing
End Try
Try
iProperties.Value(sVirtPart & ":1", "Custom", "MyCompany Supplied") = oProp11
Catch 'catch error when oProp11 = nothing
End Try
End If
']
'[add next instance starting at instance2 (if applicable)
Dim index As Integer
index = 2
Do While index <= iQTY
occs.AddByComponentDefinition(virtOcc.Definition, identity)
index += 1
Loop
']
Next
'update the status bar
ThisApplication.StatusBarText = "Virtual components added!"
MessageBox.Show("Finished adding Virtual Parts to assembly!", "Completed")
__________________________________________________________
Product Design & Manufacturing Collection 2023 | Vault Professional 2023
Dell Precision 7670 | Intel i7-12850HX - 2100 Mhz - 64GB
nVIDIA RTX A3000 12GB | Windows 10/64 Pro
