iLogic - Expand Structured Parts List based on Keyword

One of my drafting processes is to create basic engineering drawings for the client.

Depending on the task, the model may contain certain components to be used in the final design.

The Engineering drawing GA will contain a Member Schedule, with associated member marks, these marks are more of a broad stroke, e.g. C1 for a column. The final workshop model may contain numerous C1 columns, each with a unique identifier. e.g. C1-1 and C1-2 (But they are still all C1.) These member marks are accessed via a custom Balloon.

When I create my BOM, I will create 2 member mark fields, ENG1 and ENG2. ENG2 is generally used for Engineering Drawing member marks. e.g. ENG1=C1-1; and ENG2=C1

On occasion these can be nested deeper into the BOM. I then create a small text entry in the BOM called 'EXP' (In other words, Expand Me) this will indicate that when I place a parts list on the drawing, in order for the Balloon to access the correct member mark, the Parts list needs to be formatted correctly. This may entail expanding or collapsing certain levels/rows of the Parts List.

Exploding the parts list has always been a manual process and can sometimes take quite a long time when dealing with a large Parts list.

The following code, will process the Parts List, and for each row containing the work 'EXP' in the Description field, it will expand this row. This will continue until the entire Parts list has been processed.

Its quick and it works well for my requirements.  

Below is quick view of the final model (This is not a final drawing, just an indication of the balloons in place)

Note:
There is a link to the text file at the bottom of the post.

----- Start Of Code -----

Sub Main()

'Title: Parts List Row Expand

'Date: 04/02/2019

'Reg Hasell

'This rule checks the Parts List sequence number

'Looks for the words "EXP" or "exp"

'If found, it will expand the Parts list row

'This will continue untill the entire parts list has been exposed.

'Caveat:

'I am unable to collapse the parts list. This must be done manually.

'--oOo--

'Get the Parts list Sequence Number

oPRTL = InputBox("Choose the Parts List", "Parts List Filter", "1")

'Once done, call the sort and pass the Parts List number through.

Call oQTY(oPRTL)

End Sub

'--------------------------------

Sub oQTY(oPRTL)

        'On Error Resume Next

        ' Set a reference to the drawing document.

        ' This assumes a drawing document is active.

        Dim oDrawDoc As DrawingDocument

        oDrawDoc = ThisApplication.ActiveDocument

        Dim oPartList As PartsList

        '''---------------------

        ' Set a reference to the first parts list on the active sheet.

        'Dim oPartList As PartsList

        'expand the parts list

        oPartList = oDrawDoc.ActiveSheet.PartsLists.Item(oPRTL)

        ' Iterate through the contents of the parts list.

        Dim i As Long

        Dim oRow As PartsListRow

        'Start counting the parts list rows

        'as the parts list grows due to expansion, the row counter will increase.

        Dim FirstRowCount As Integer = oPartList.PartsListRows.Count

        Dim LastRowCount As Integer = 0

        '

        Do Until FirstRowCount = LastRowCount

               FirstRowCount = oPartList.PartsListRows.Count ' Included in the loop.

               For i = 1 To oPartList.PartsListRows.Count

                       'look for the cell titled "Description"      

                       oCell = oPartList.PartsListRows.Item(i).Item("DESCRIPTION")

                       'oCell2  = oPartList.PartsListRows.Item(i).Item("LENGTH") ' left this for possible later use.

                       Try

                               If oCell.Value = "EXP" Or oCell.Value = "exp" Then

                                      oPartList.PartsListRows.Item(i).Expanded = True

                                      'oCell.Value = "EXP"

                               End If

                       Catch ex As Exception

                       End Try

               Next

               'Count the new size of the Parts List

               LastRowCount = oPartList.PartsListRows.Count

        Loop

        MessageBox.Show("All Done", "BOM QTY")

        'End Sub 'Added the repeat for multiple parts lists

        oAgain = MessageBox.Show("Again", "Rinse and Repeat", MessageBoxButtons.YesNo, MessageBoxIcon.Question, MessageBoxDefaultButton.Button2) 'Added rev2

        If oAgain = vbYes

               AGAIN

        End If

End Sub

Sub AGAIN

        Main

End Sub

---End Code ---


Link to text file