"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

AndersI over 9 years ago

As a spin-off of this script, I made another one where you select two planes and the script inserts code for creating one plane from the hits of the two.

Does anyone know how to make a multi-select listbox in PC-DMIS Basic (if at all possible)?

'===========================================================================
' Multi-feature plane
'
' Extract hits from two planes And create a new plane of them
'
' Anders Isaksson, Hexagon Metrology Nordic AB
'===========================================================================
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 NumFeat As Integer
Dim FeatureList$(9999)

Dim RetVal As Integer
Dim ID1 As String
Dim ID2 As String


'***** Predialog START
FeatureList$(0)="<select one>"
NumFeat = 1
' Enumerate commands
For Each cmd In PCDCommands
' Measured (learned) feature
  If cmd.IsMeasuredFeature And cmd.Feature = F_PLANE Then 
    FeatureList(NumFeat) = cmd.ID
    NumFeat = NumFeat + 1
  End If
' Autofeature (flagged As DCC feature)
  If cmd.IsDCCFeature And cmd.Feature = F_PLANE Then
    FeatureList(NumFeat) = cmd.ID
    NumFeat = NumFeat + 1
  End If
' Constructed feature [Not allowed]
'If cmd.IsConstructedFeature Then
'    FeatureList(NumFeat) = cmd.ID
'    NumFeat = NumFeat + 1
'  End If
Next cmd

'*****
'***** Dialog START
Begin Dialog DIALOG_1 31,48, 178, 141, "Create a plane from 2 planes' hits"
  ListBox 8,8,80,110, FeatureList$(), .ListBox1
  ListBox 90,8,80,110, FeatureList$(), .ListBox2
  OKButton 118,120,52,12, "OK", .OKBtn
  CancelButton 64,120,52,12, "Cancel", .CancelBtn
End Dialog

Dim Dlg1 As DIALOG_1

Again:
Button = Dialog(Dlg1)
' button -1 = OK 0 = Cancel

If (Button <> 0) And ((Dlg1.ListBox1 = 0) Or (Dlg1.ListBox2 = 0)) Then
  MsgBox "Select one plane in each list!"
  GoTo Again
End If

If (Button <> 0) And (Dlg1.ListBox1 <> 0) And (Dlg1.ListBox2 <> 0) Then

  ID1 = FeatureList$(Dlg1.ListBox1)
  ID2 = FeatureList$(Dlg1.ListBox2)
  Set cmd = PCDCommands.Add(571, True)
  retval = cmd.PutText (ID1 & "_" & ID2, ID, 0)
  retval = cmd.SetExpression (ID1 & "." & "HIT" & "[1.." & ID1 & ".NUMHITS]" , REF_ID, 1)
  retval = cmd.SetExpression (ID2 & "." & "HIT" & "[1.." & ID2 & ".NUMHITS]" , REF_ID, 2)
    
  '*****
  '***** Cleanup
  Set prbhit = Nothing
  Set PCDCommand = Nothing
  Set PCDCommands = Nothing
  Set PCDPartProgram = Nothing
  Set PCDPartPrograms = Nothing
  Set PCDApp = Nothing
  '*****
  
End If 

End Sub

Running the dialog and selecting PLN2 and PLN3 will produce the following in the EditWindow:

PLN2_PLN3  =FEAT/PLANE,CARTESIAN,TRIANGLE,NO
            THEO/<74.618,0,-18.746>,<0,-1,0>
            ACTL/<74.618,0,-18.746>,<0,-1,0>
            CONSTR/PLANE,BF,PLN2.HIT[1..PLN2.NUMHITS],PLN3.HIT[1..PLN3.NUMHITS],,
            OUTLIER_REMOVAL/OFF,3
            FILTER/OFF,WAVELENGTH=0

Reply

AndersI over 9 years ago

'===========================================================================
' Multi-feature plane
'
' Extract hits from two planes And create a new plane of them
'
' Anders Isaksson, Hexagon Metrology Nordic AB
'===========================================================================
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 NumFeat As Integer
Dim FeatureList$(9999)

Dim RetVal As Integer
Dim ID1 As String
Dim ID2 As String


'***** Predialog START
FeatureList$(0)="<select one>"
NumFeat = 1
' Enumerate commands
For Each cmd In PCDCommands
' Measured (learned) feature
  If cmd.IsMeasuredFeature And cmd.Feature = F_PLANE Then 
    FeatureList(NumFeat) = cmd.ID
    NumFeat = NumFeat + 1
  End If
' Autofeature (flagged As DCC feature)
  If cmd.IsDCCFeature And cmd.Feature = F_PLANE Then
    FeatureList(NumFeat) = cmd.ID
    NumFeat = NumFeat + 1
  End If
' Constructed feature [Not allowed]
'If cmd.IsConstructedFeature Then
'    FeatureList(NumFeat) = cmd.ID
'    NumFeat = NumFeat + 1
'  End If
Next cmd

'*****
'***** Dialog START
Begin Dialog DIALOG_1 31,48, 178, 141, "Create a plane from 2 planes' hits"
  ListBox 8,8,80,110, FeatureList$(), .ListBox1
  ListBox 90,8,80,110, FeatureList$(), .ListBox2
  OKButton 118,120,52,12, "OK", .OKBtn
  CancelButton 64,120,52,12, "Cancel", .CancelBtn
End Dialog

Dim Dlg1 As DIALOG_1

Again:
Button = Dialog(Dlg1)
' button -1 = OK 0 = Cancel

If (Button <> 0) And ((Dlg1.ListBox1 = 0) Or (Dlg1.ListBox2 = 0)) Then
  MsgBox "Select one plane in each list!"
  GoTo Again
End If

If (Button <> 0) And (Dlg1.ListBox1 <> 0) And (Dlg1.ListBox2 <> 0) Then

  ID1 = FeatureList$(Dlg1.ListBox1)
  ID2 = FeatureList$(Dlg1.ListBox2)
  Set cmd = PCDCommands.Add(571, True)
  retval = cmd.PutText (ID1 & "_" & ID2, ID, 0)
  retval = cmd.SetExpression (ID1 & "." & "HIT" & "[1.." & ID1 & ".NUMHITS]" , REF_ID, 1)
  retval = cmd.SetExpression (ID2 & "." & "HIT" & "[1.." & ID2 & ".NUMHITS]" , REF_ID, 2)
    
  '*****
  '***** Cleanup
  Set prbhit = Nothing
  Set PCDCommand = Nothing
  Set PCDCommands = Nothing
  Set PCDPartProgram = Nothing
  Set PCDPartPrograms = Nothing
  Set PCDApp = Nothing
  '*****
  
End If 

End Sub

Running the dialog and selecting PLN2 and PLN3 will produce the following in the EditWindow:

PLN2_PLN3  =FEAT/PLANE,CARTESIAN,TRIANGLE,NO
            THEO/<74.618,0,-18.746>,<0,-1,0>
            ACTL/<74.618,0,-18.746>,<0,-1,0>
            CONSTR/PLANE,BF,PLN2.HIT[1..PLN2.NUMHITS],PLN3.HIT[1..PLN3.NUMHITS],,
            OUTLIER_REMOVAL/OFF,3
            FILTER/OFF,WAVELENGTH=0

Children

No Data