'=========================================================================== ' 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.