'===========================================================================
' To Points
'
' Extracts hits from features and creates vectorpoints with
' the hits THEO's.
'
' The names are created from the source feature name and a number that
' represents the hit index.
'
' Idea taken from 'to_points.exe' from the Wilcox Script Repository
' which sadly doesn't work as expected.
'
' (c) vpt.se 2010-06-15
'===========================================================================
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 hX As Double, hY As Double, hZ As Double, hI As Double, hJ As Double, hK 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, "Cancel", .CancelBtn
End Dialog
Dim Dlg1 As DIALOG_1
button = Dialog(Dlg1)
' button 1 = To points, button 2 = Cancel
'*****
'***** Vectorpoint generation
Fcntr = 0
If button = 1 Then
Set PCDCommand = PCDCommands.Item(FeatureList(Dlg1.Listbox))
Set PCDFeatCmd = PCDCommand.FeatureCommand
numhits = PCDCommand.GetText(N_HITS, 0)
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)
hX = CDbl(prbhit.X)
hY = CDbl(prbhit.Y)
hZ = CDbl(prbhit.Z)
' Get the probehits - IJK
Set prbhit = PCDFeatCmd.GetHit(Fcntr, FHITDATA_VECTOR, FDATA_THEO, FDATA_PART, AlignID, PLANE_TOP)
hI = CDbl(prbhit.X)
hJ = CDbl(prbhit.Y)
hK = CDbl(prbhit.Z)
' Create vectorpoints
Set cmd = PCDCommands.Add(602, True)
cmd.Marked = True
'Featurename is "sourcefeaturename-hitnumber" -> PLANE1-1
retval = cmd.PutText (PCDCommand.ID & "-" & Fcntr, ID, 0)
'Theo's
retval = cmd.PutText (hX, THEO_X, 0)
retval = cmd.PutText (hY, THEO_Y, 0)
retval = cmd.PutText (hZ, THEO_Z, 0)
retval = cmd.PutText (hI, THEO_I, 0)
retval = cmd.PutText (hJ, THEO_J, 0)
retval = cmd.PutText (hK, THEO_K, 0)
'Targ's
retval = cmd.PutText (hX, TARG_X, 0)
retval = cmd.PutText (hY, TARG_Y, 0)
retval = cmd.PutText (hZ, TARG_Z, 0)
retval = cmd.PutText (hI, TARG_I, 0)
retval = cmd.PutText (hJ, TARG_J, 0)
retval = cmd.PutText (hK, TARG_K, 0)
cmd.ReDraw
PCDPartProgram.RefreshPart
Next
End If
'*****
'***** Cleanup
Set PCDApp = Nothing
Set PCDPartPrograms = Nothing
Set PCDPartProgram = Nothing
Set PCDCommands = Nothing
Set prbhit = Nothing
'*****
End Sub
Code posted as-is, no guarantees.
Feel free to tweak it to suit your own needs, but please post your version as well - for others to learn from.
