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.
  • Don't forget to post your modified versions of the code...

    Sharing is caring, people!
  • that or vpt.se just wants to know ur secrets.
  • that or vpt.se just wants to know ur secrets.


    You got me! Slight smile
  • I'm not getting this script to work in 2012 MR1. I made the suggested change of "PCDFeatCmd.NumHits*PCDFeatCmd.NumRows". Any suggestions?
  • I believe you need to do the editing like this:

    Change this line:
    numhits = PCDCommand.GetText(N_HITS, 0)

    To:
    numhits = PCDFeatCmd.NumHits

    Will not work in some (all?) versions of 4.3, where it was necessary to do "PCDFeatCmd.NumHits*PCDFeatCmd.NumRows" to get the total number of hits.
  • '===========================================================================
    ' 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 = PCDFeatCmd.NumHits
      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
  • Hey Vpt.se have you tried playing with the GET TEXT/GET COMMAND function to obtain the feature the cursor is currently highlighting? Just a thought.
  • Hey Vpt.se have you tried playing with the GET TEXT/GET COMMAND function to obtain the feature the cursor is currently highlighting? Just a thought.


    PCDLRN.PartProgram.Commands.CurrentCommand returns the command on which the cursor is located.
  • That would allow you to use your script on the feature you have the cursor in. That way you don't have to an input box. Just a thought.