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.
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
Solved! Go to Solution.
Solved by JelteDeJong. Go to 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
Jelte de Jong
Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
Blog: hjalte.nl - github.com
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 :light_bulb: or you can Explore My CONTRIBUTIONS
Wesley Crihfield
(Not an Autodesk Employee)
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
Wesley Crihfield
(Not an Autodesk Employee)
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
Wesley Crihfield
(Not an Autodesk Employee)
Can't find what you're looking for? Ask the community or share your knowledge.