multiple PARTS LISTS per PAGE, show only balloons per page.....

[ryanTPVFU]

Per company standards I need 2 parts lists. The lists are fairly large. I need to display ONLY the balloons that are called out in the parts list. The link below is from an older thread. The code supplied works but only for a sheet with 1 Parts List.

https://forums.autodesk.com/t5/inventor-ilogic-api-vba-forum/inventor-drawing-bom-or-parts-list-to-s...

Is there a way to modify this so you can select the list that you want to run the code on?

The way I have my 2 lists separated are by "NORMAL" which are my components and "PURCHASED" which is my 2nd list of hardware.

The code that I am using that works on one list only is this:

Sub Main()

	Dim oDoc As Document = ThisDoc.Document
    If oDoc.DocumentType <> kDrawingDocumentObject Then: MsgBox("Run in drawings only!"): Exit Sub: End If
        
	Dim oSheet As Sheet = oDoc.ActiveSheet
    If oSheet Is Nothing Then: MsgBox("Only valid for dwg files with sheets!"): Exit Sub: End If
	
    If oSheet.PartsLists.Count <> 1 Then: MsgBox("Only valid for sheets with 1 PartsList"):Exit Sub: End If
	Dim oPL As PartsList = oSheet.PartsLists(1)
	
    If oPL.PartsListRows.Count < 1 Then: MsgBox("Only valid for partslists with actual rows"): Exit Sub: End If
	If oSheet.Balloons.Count < 1 Then: MsgBox("Rule only valid for sheets with balloons!"): Exit Sub: End If

     On Error Resume Next
        For Each oRow In oPL.PartsListRows
		oRow.Visible = False
	Next

       If Err.Number <> 0 Then: MsgBox("Issue setting row visibility or accessing rows..."): End If
       Err.Clear

     On Error Resume Next
        Dim oIN As String
	For Each oBalloon In oSheet.Balloons
		oIN = oBalloon.BalloonValueSets(1).ItemNumber
                If Err.Number <> 0 Then: MsgBox("Issue grabbing balloon item number.."): End If
		Err.Clear

		For Each oRow In oPL.PartsListRows
			If oRow.Item(1).Value = oIN
				oRow.Visible = True
			End If
		Next
                If Err.Number <> 0 Then: MsgBox("Issue iterating PL/setting visibility back on"): End If
                Err.Clear
	Next
     On Error GoTo 0
End Sub 

[JelteDeJong · Accepted solution]

You can try it like this:

Dim oDoc As Document = ThisDoc.Document
If oDoc.DocumentType <> DocumentTypeEnum.kDrawingDocumentObject Then : MsgBox("Run in drawings only!") : Exit Sub : End If

Dim oSheet As Sheet = oDoc.ActiveSheet
If oSheet Is Nothing Then : MsgBox("Only valid for dwg files with sheets!") : Exit Sub : End If

If oSheet.PartsLists.Count < 1 Then : MsgBox("Only valid for sheets with atleast 1 PartsList") : Exit Sub : End If

Dim partslists = oSheet.PartsLists.Cast(Of PartsList)
Dim names = partslists.Select(Function(l) l.Style.Name)

Dim selectedStyle = InputListBox("Select listbox by style", names, names.First(), Title := "Select", ListName := "List")

Dim oPL As PartsList = partslists.Where(Function(l) l.Style.Name.Equals(selectedStyle)).First()


If oPL.PartsListRows.Count < 1 Then : MsgBox("Only valid for partslists with actual rows") : Exit Sub : End If
If oSheet.Balloons.Count < 1 Then : MsgBox("Rule only valid for sheets with balloons!") : Exit Sub : End If

Try
    For Each oRow In oPL.PartsListRows
        oRow.Visible = False
    Next
Catch ex As Exception
    MsgBox("Issue setting row visibility or accessing rows...")
End Try

Try
    Dim oIN As String
    For Each oBalloon In oSheet.Balloons
        Try
            oIN = oBalloon.BalloonValueSets(1).ItemNumber
        Catch ex As Exception
            MsgBox("Issue grabbing balloon item number..")
        End Try

        Try
            For Each oRow In oPL.PartsListRows
                If oRow.Item(1).Value = oIN Then
                    oRow.Visible = True
                End If
            Next
        Catch ex As Exception
            MsgBox("Issue iterating PL/setting visibility back on")
        End Try

    Next
Catch ex As Exception
End Try

[WCrihfield]

Hi @ryanTPVFU.  You can try this version if you want:

Sub Main
	If ThisDoc.Document.DocumentType <> DocumentTypeEnum.kDrawingDocumentObject Then
		MsgBox("This rule only works on Drawings. Exiting rule.", vbCritical, "")
		Exit Sub
	End If
	Dim oDDoc As DrawingDocument = ThisDoc.Document
	oSheet = oDDoc.ActiveSheet 'there will always be an active sheet
	If oSheet.PartsLists.Count = 0 Then
		MsgBox("No Parts Lists found on active sheet.  Exiting rule.", vbCritical, "")
		Exit Sub
	End If
	If oSheet.Balloons.Count = 0 Then
		MsgBox("There must be Balloons on the active sheet for this rule to work.  Exiting rule.", vbCritical, "")
		Exit Sub
	End If
	For Each oPList As PartsList In oSheet.PartsLists
		If oPList.PartsListRows.Count = 0 Then Continue For
		For Each oRow As PartsListRow In oPList.PartsListRows
			If Not oRow.Ballooned Then
				oRow.Visible = False
			Else
				Dim oFound As Boolean = False
				For Each oBln As Balloon In oSheet.Balloons
					'this assumes that ItemNumber is in first column of Parts List
					If oBln.BalloonValueSets.Item(1).ItemNumber = oRow.Item(1).Value Then
						oFound = True
						oRow.Visible = True
					End If
				Next
				If Not oFound Then oRow.Visible = False
			End If
		Next
	Next
End Sub

Oops.  Looks like not only was I a couple minutes too late, but I forgot to put the manual parts list selection bit of code in there.

If this solved your problem, or answered your question, please click ACCEPT SOLUTION.
Or, if this helped you, please click (LIKE or KUDOS) 👍.

If you want and have time, I would appreciate your Vote(s) for My IDEAS 💡 or you can Explore My CONTRIBUTIONS

[WCrihfield]

I revised the code I posted a bit to include the Pick method, which will allow you to manually choose which parts list you want to process.  Then I put the main process within a Do...Loop, so that you can repeat it multiple times in a row, if needed.  The loop will break and finish when nothing is selected (like when you use the escape keyboard key at selection).

Sub Main
	If ThisDoc.Document.DocumentType <> DocumentTypeEnum.kDrawingDocumentObject Then
		MsgBox("This rule only works on Drawings. Exiting rule.", vbCritical, "")
		Exit Sub
	End If
	Dim oDDoc As DrawingDocument = ThisDoc.Document
	oSheet = oDDoc.ActiveSheet 'there will always be an active sheet
	If oSheet.PartsLists.Count = 0 Then
		MsgBox("No Parts Lists found on active sheet.  Exiting rule.", vbCritical, "")
		Exit Sub
	End If
	If oSheet.Balloons.Count = 0 Then
		MsgBox("There must be Balloons on the active sheet for this rule to work.  Exiting rule.", vbCritical, "")
		Exit Sub
	End If
	
	Do 'starts a loop (you can repeat this process as many times as needed)
		oObj = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kDrawingPartsListFilter, "Select a Parts List to process.")
		If oObj Is Nothing OrElse Not TypeOf oObj Is PartsList Then Exit Sub
		Dim oPList As PartsList = oObj
		If oPList.PartsListRows.Count = 0 Then Exit Sub
		For Each oRow As PartsListRow In oPList.PartsListRows
			If Not oRow.Ballooned Then
				oRow.Visible = False
			Else
				Dim oFound As Boolean = False
				For Each oBln As Balloon In oSheet.Balloons
					'this assumes that ItemNumber is in first column of Parts List
					If oBln.BalloonValueSets.Item(1).ItemNumber = oRow.Item(1).Value Then
						oFound = True
						oRow.Visible = True
					End If
				Next
				If Not oFound Then oRow.Visible = False
			End If
		Next
	Loop Until oObj Is Nothing
End Sub

[ryanTPVFU]

Works great, THANK YOU!
Inventor needs to add this filter option built into the parts list!

[ryanTPVFU]

I appreciate the code. It did work but it seemed to have flaws. When I select the list it will take some time before it actually starts to run. Once its done it will do nothing with the second list. It prompts to select but nothing further happens.

[davis.j]

@WCrihfield Could you modify the code so it looks for attached balloons too?

 

[WCrihfield]

Hi @davis.j.  I think I understand what you want.  I believe that when any other balloons attached to balloon, they can be accessed by looping through the Balloon.BalloonValueSets.  So, I slightly modified my last posted code above to accommodate your request.  I also may have fixed the continuation of the loop issue, by changing the loop to a While instead of a Do loop, and incorporating a couple 'Continue While' statements in there.  And I moved the Pick method out into a separate custom Function.  Plus I fixed the assumption about the first column being the Item column by including a search loop for it.  We need to know which column is for the ItemNumber so that we can compare balloon value to the proper parts list row cell's value.

See if this meets your needs:

Sub Main
	If ThisDoc.Document.DocumentType <> DocumentTypeEnum.kDrawingDocumentObject Then
		MsgBox("This rule only works on Drawings. Exiting rule.", vbCritical, "")
		Exit Sub
	End If
	Dim oDDoc As DrawingDocument = ThisDoc.Document
	oSheet = oDDoc.ActiveSheet 'there will always be an active sheet
	If oSheet.PartsLists.Count = 0 Then
		MsgBox("No Parts Lists found on active sheet.  Exiting rule.", vbCritical, "")
		Exit Sub
	End If
	If oSheet.Balloons.Count = 0 Then
		MsgBox("There must be Balloons on the active sheet for this rule to work.  Exiting rule.", vbCritical, "")
		Exit Sub
	End If
	
	While True 'starts a loop (you can repeat this process as many times as needed)
		Dim oPList As PartsList = PickPartsList
		If IsNothing(oPList) Then Exit While
		If oPList.PartsListRows.Count = 0 Then Continue While
		'determine which column in the PartsList is for ItemNumber
		Dim oItemCol As PartsListColumn = Nothing
		For Each oCol As PartsListColumn In oPList.PartsListColumns
			If oCol.PropertyType = PropertyTypeEnum.kItemPartsListProperty Then
				oItemCol = oCol
			End If
		Next
		For Each oRow As PartsListRow In oPList.PartsListRows
			If Not oRow.Ballooned Then
				oRow.Visible = False
			Else
				Dim oFound As Boolean = False
				If IsNothing(oItemCol) Then 'ItemNumber column was not found
					MsgBox("No 'ItemNumber' column found in this PartsList.", vbCritical, "")
					Continue While
				End If
				For Each oBln As Balloon In oSheet.Balloons
					For Each oBVS As BalloonValueSet In oBln.BalloonValueSets
						If oBVS.ItemNumber = oRow.Item(oItemCol).Value Then
							oFound = True
							oRow.Visible = True
						End If
					Next
				Next
				If Not oFound Then oRow.Visible = False
			End If
		Next
	End While
End Sub

Function PickPartsList(Optional oPrompt As String = vbNullString) As PartsList
	If oPrompt = "" Then oPrompt = "Select a Parts List."
	oObj = ThisApplication.CommandManager.Pick(SelectionFilterEnum.kDrawingPartsListFilter, oPrompt)
	If oObj Is Nothing OrElse (TypeOf oObj Is PartsList = False) Then Return Nothing
	Dim oPList As PartsList = oObj
	Return oPList
End Function