hexagon logo

"to_points.exe" the script version

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

  • Is there a way to turn off the "Should the insertion point move to the end bla..." prompt at the beginning of the program?

    My experience is, if you load the script in the script editor and run it you always get this prompt. If you set the script to run from a button or hot key, you never get this prompt.



    Sent from my SM-G900P using Tapatalk
Reply

  • Is there a way to turn off the "Should the insertion point move to the end bla..." prompt at the beginning of the program?

    My experience is, if you load the script in the script editor and run it you always get this prompt. If you set the script to run from a button or hot key, you never get this prompt.



    Sent from my SM-G900P using Tapatalk
Children
No Data