You select the planes in a dialog with two listboxes (like in Customize Toolbars), one initially empty. I had to do it this way as I haven't found any way to create a normal Windows multi-select listbox in the PC-DMIS Basic language. This selection dialog technique may be useful for other scripts, too.
This script is supposed to be connected to a button in your own customized toolbar.
'===========================================================================
' Multi-feature plane
'
' Extract hits from two (or more) planes and creates a new plane from 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 118,120,52,12, "OK", .OKBtn
CancelButton 64,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
Attached Files
