The generic points are now in your program to use for whatever purpose you need.
Much thanks to vpt.se , sleshholdofthedeep , & others
Feel free to use and change it as you like.
Have fun.
Sub Main()
Dim PCDApp, PCDPartPrograms, PCDPartProgram, PCDCommands, PCDCommand
Dim PCDFeatCmd
Dim prbhit
Dim numhits As Integer
Set PCDApp = CreateObject ("PCDLRN.Application")
Set PCDPartPrograms = PCDApp.PartPrograms
Set PCDPartProgram = PCDApp.ActivePartProgram
Set PCDCommands = PCDPartProgram.Commands
Dim cmd As Object
Dim Fcntr As Integer
Dim FeatureList$ (999)
Dim MX As Double, MY As Double, MZ As Double, MI As Double, MJ As Double, MK As Double
Dim TX As Double, TY As Double, TZ As Double, TI As Double, TJ As Double, TK As Double
' ********* Predialog START
Fcntr = 0
'Enumerate commands
For Each cmd In PCDCommands
' Measured (learned) feature
If cmd.IsMeasuredFeature Then
FeatureList(Fcntr) = cmd.ID
Fcntr = Fcntr + 1
End If
' Autofeature (flagged As DCC feature)
If cmd.IsDCCFeature Then
FeatureList(Fcntr) = cmd.ID
Fcntr = Fcntr + 1
End If
Next cmd
' ************
' ********* Dialog START
Begin Dialog DIALOG_1 31, 48, 172, 141, "Feature to points"
ListBox 68, 8, 96, 128, FeatureList$(), .ListBox
PushButton 8, 8, 52, 12, "To points", .PointsBtn
PushButton 8, 120, 52, 12, "CancelBtn", .CancelBtn
End Dialog
Dim dlg1 As Dialog_1
button = Dialog(Dlg1)
' button 1 = To points, button 2 = Cancel
' *****
' ******** GENERIC FEATURE - point generation
Fcntr = 0
If Button = 1 Then
Set PCDCommand = PCDCommands.Item(FeatureList(Dlg1.ListBox))
Set PCDFeatCmd = PCDCommand.FeatureCommand
nhits = PCDCommand.GetText(N_HITS, 0)
' nrows is part of autofeatures ex. autoplane 2 hits 2 rows
nrows = PCDCommand.GetText(N_ROWS, 0)
' test For nrows, Set To 1 For calculation
If nrows < 1 Then
nrows = 1
End If
numhits = (nhits)*(nrows)
Set prbhit = CreateObject("PCDLRN.PointData")
For Fcntr = 1 To numhits
' Get the probehits - XYZ
Set prbhit = PCDFeatCmd.GetHit(Fcntr, FHITDATA_CENTROID, FDATA_THEO, FDATA_PART, AlignID, PLANE_TOP)
TX = CDbl(prbhit.x)
TY = CDbl(prbhit.y)
TZ = CDbl(prbhit.z)
' Get the probehits - IJK
Set prbhit = PCDFeatCmd.GetHit(Fcntr, FHITDATA_VECTOR, FDATA_THEO, FDATA_PART, AlignID, PLANE_TOP)
TI = CDbl(prbhit.i)
TJ = CDbl(prbhit.j)
TK = CDbl(prbhit.k)
' Get the probehits - XYZ
Set prbhit = PCDFeatCmd.GetHit(Fcntr, FHITDATA_CENTROID, FDATA_MEAS, FDATA_PART, AlignID, PLANE_TOP)
MX = CDbl(prbhit.x)
MY = CDbl(prbhit.y)
MZ = CDbl(prbhit.z)
' Get the probehits - IJK
Set prbhit = PCDFeatCmd.GetHit(Fcntr, FHITDATA_VECTOR, FDATA_MEAS, FDATA_PART, AlignID, PLANE_TOP)
MI = CDbl(prbhit.i)
MJ = CDbl(prbhit.j)
MK = CDbl(prbhit.k)
'////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
' Create generic feature (COMMAND INFORMATION CODE edit screen) 597
Set cmd = PCDCommands.Add(597, True)
'////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
cmd.Marked = True
'Featurename is "GEN_FEAT_sourcefeaturename_hitnumber" => GF_PLANE1_1
retval = cmd.PutText ("GF_" & PCDCommand.ID & "_" & Fcntr, ID, 0)
'Theo's
retval = cmd.PutText (TX, THEO_X, 0)
retval = cmd.PutText (TY, THEO_Y, 0)
retval = cmd.PutText (TZ, THEO_Z, 0)
retval = cmd.PutText (TI, THEO_I, 0)
retval = cmd.PutText (TJ, THEO_J, 0)
retval = cmd.PutText (TK, THEO_K, 0)
'Targ's
'retval = cmd.PutText (MX, TARG_X, 0)
'retval = cmd.PutText (MY, TARG_Y, 0)
'retval = cmd.PutText (MZ, TARG_Z, 0)
'retval = cmd.PutText (MI, TARG_I, 0)
'retval = cmd.PutText (MJ, TARG_J, 0)
'retval = cmd.PutText (MK, TARG_K, 0)
'Meas's
retval = cmd.PutText (MX, MEAS_X, 0)
retval = cmd.PutText (MY, MEAS_Y, 0)
retval = cmd.PutText (MZ, MEAS_Z, 0)
retval = cmd.PutText (MI, MEAS_I, 0)
retval = cmd.PutText (MJ, MEAS_J, 0)
retval = cmd.PutText (MK, MEAS_K, 0)
cmd.redraw
Next
End If
' ***********
' *********** Cleanup
Set PCDApp = Nothing
Set PCDPartPrograms = Nothing
Set PCDPartProgram = Nothing
Set prbhit = Nothing
' ***********
End Sub