MULTIPLAN.BAS - script to create one plane from the hits of many

OK, so here's my Basic script which allows me to select two or more of all available planes, and then create a single plane from the hits.

It's mainly an example of how to define and use a dialog in PC-DMIS Basic, react on buttons and still be in the dialog, and then finally produce the command that create a plane from hits.

Warning: It shows all planes in the program, it doesn't know to stop at the current line of the cursor, so you can select planes that are not yet measured.

Corrections and additions welcome!

'===========================================================================
' Multi-feature plane
'
' Extract hits from two (or more) planes and create a new plane of them
'
' Anders Isaksson, Hexagon Metrology Nordic AB
'===========================================================================
Sub Main()

Dim PCDApp as Object
Dim PCDPartPrograms as Object
Dim PCDPartProgram as Object
Dim PCDCommands as Object
Dim PCDCommand as Object

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

Dim Fcntr As Integer
Dim RetVal As Integer
Dim NumFeat As Integer
Dim NumSelect as Integer
Dim I as Integer

Dim FeatureList(1001) as string
Dim SelectList(101) as string
Dim ID1 As String
Dim ID2 As String


'***** Predialog START
NumFeat = 0
NumSelect = 0
' Enumerate commands
For Each PCDCommand In PCDCommands
' Measured (learned) feature
  If PCDCommand.IsMeasuredFeature And PCDCommand.Feature = F_PLANE Then 
    FeatureList(NumFeat) = PCDCommand.ID
    if (NumFeat < 1000) then
      NumFeat = NumFeat + 1
    end if
  End If
' Autofeature (flagged As DCC feature)
  If PCDCommand.IsDCCFeature And PCDCommand.Feature = F_PLANE Then
    FeatureList(NumFeat) = PCDCommand.ID
    if (NumFeat < 1000) then
      NumFeat = NumFeat + 1
    end if
  End If
Next PCDCommand

'*****
'***** Dialog START
Begin Dialog DIALOG_1 31,48, 198, 141, "Create a plane from other planes' hits"
  ListBox 8,8,80,110, FeatureList(), .ListBox1
  ListBox 110,8,80,110, SelectList(), .ListBox2
  PushButton 91, 8, 16, 16, "->", .pbSelect
  PushButton 91, 28, 16, 16, "<-", .pbUnSelect
  OKButton 138,120,52,12, "OK", .OKBtn
  CancelButton 84,120,52,12, "Cancel", .CancelBtn
End Dialog

Dim Dlg1 As DIALOG_1

Again:
Button = Dialog(Dlg1)
' button -1 = OK 0 = Cancel, 1 = Select, 2 = UnSelect

if (Button = 1) then
  if (Dlg1.ListBox1 >= 0) then
    SelectList(NumSelect) = FeatureList(Dlg1.ListBox1)
    for i = Dlg1.ListBox1 to 1000
      FeatureList(i) = FeatureList(i+1)
    next i
    NumSelect = NumSelect + 1
    NumFeat = NumFeat - 1
  else
    MsgBox "Nothing to add!"
  end if
  GoTo Again
end if

if (Button = 2) then
  if (Dlg1.ListBox2 >= 0)then
    FeatureList(NumFeat) = SelectList(Dlg1.ListBox2)
    for i = Dlg1.ListBox2 to 100
      SelectList(i) = SelectList(i+1)
    next i
    NumSelect = NumSelect - 1
    NumFeat = NumFeat + 1
  else
    MsgBox "Nothing to delete!"
  end if
  GoTo Again
end if

If (Button = -1) then
  if (NumSelect = 0) Then
    MsgBox "You must select one or more planes!"
    GoTo Again
  else
    ID1 = SelectList(0)
    ID2 = SelectList(1)
    Set cmd = PCDCommands.Add(571, True)
    retval = cmd.PutText ("M" & NumSelect & "_" & ID1 & "_" & ID2, ID, 0)
    for i = 0 to NumSelect-1
      ID1 = SelectList(i)
      if (ID1 <> "") then 
        retval = cmd.SetExpression (ID1 & "." & "HIT" & "[1.." & ID1 & ".NUMHITS]" , REF_ID, i+1)
      end if
    next i
  end if
End If 
    
'*****
'***** Cleanup
Set PCDCommand = Nothing
Set PCDCommands = Nothing
Set PCDPartProgram = Nothing
Set PCDPartPrograms = Nothing
Set PCDApp = Nothing
'*****


End Sub