Automatic Ballooning iteration script

Hi,

We allmost allways put balloonings on our drawings, but often have the same dimension 2.3.4.... times as evaluation in our report.
To be able to separate these measurements from one another for Qdas and better overview for our clients, we iterate the number of the ballooning (80.1 / 80.2/...) which can take quite some time if it's a complex part...

I wrote a script, that loops through all reporting-comments, counts the number of occurences, stores data in an array and then loops through everything again and adapts the Reporting commands.

Feel free to use / modify it to your personal needs ;-)

Sub Main()
    Dim PCDApp As Object
    Dim PCDPartPrograms As Object
    Dim PCDPartProgram As Object
    Dim PCDCommands As Object
    Dim PCDCommand As Object
    Dim PCDComment As Object

    Dim sContents As String
    Dim iCnt As Integer
    Dim j As Integer
    Dim count As Integer
    Dim num As Integer
    Dim arr(500) As Integer
    Dim arr_c(500) As Integer
    Dim retVal As Long

    Set PCDApp = CreateObject("PCDLRN.Application")
    Set PCDPartPrograms = PCDApp.PartPrograms
    Set PCDPartProgram = PCDApp.ActivePartProgram
    Set PCDCommands = PCDPartProgram.Commands

    For iCnt = 1 To PCDCommands.Count
        Set PCDCommand = PCDCommands.Item(iCnt)
        If (PCDCommand.IsComment) Then
            Set PCDComment = PCDCommand.CommentCommand
            If (PCDComment.CommentType = 1) And (inStr(1,PCDComment.Comment,"Aln")<1) Then
                For j = 1 To 20
                    If (PCDComment.GetLine(j)="") Then Exit For
                    sContents = PCDComment.GetLine(j)
                    count = Len(PCDComment.GetLine(j))-2
                    sContents = mid(PCDComment.GetLine(j),2,count)
                    If IsNumeric(sContents) Then
                        num = Cint(sContents)
                        arr(num) = arr(num) + 1
                    End If
                Next
            End If
        End If
    Next iCnt
    For iCnt = 1 To PCDCommands.Count
        Set PCDCommand = PCDCommands.Item(iCnt)
        If (PCDCommand.IsComment) Then
            Set PCDComment = PCDCommand.CommentCommand
            If (PCDComment.CommentType = 1) And (inStr(1,PCDComment.Comment,"Aln")<1) Then
                For j = 1 To 20
                    If (PCDComment.GetLine(j)="") Then Exit For
                    sContents = PCDComment.GetLine(j)
                    count = Len(PCDComment.GetLine(j))-2
                    sContents = mid(PCDComment.GetLine(j),2,count)
                    If IsNumeric(sContents) Then
                        num = Cint(sContents)
                        arr_c(num) = arr_c(num) + 1
                        If arr(num) > 1 Then
                            If arr(num) < 10 Then
                                sContents = "(" & sContents & "." & arr_c(num) & ")"
                            Else
                                sContents = "(" & sContents & "." & format(arr_c(num), "00") & ")"
                            End If
                        Else
                            sContents = "(" & sContents & ")"
                        End If
                        retVal = PCDComment.SetLine(j, sContents)
                    End If
                Next
            End If
        End If
    Next iCnt
End Sub