"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

GomoFazter over 7 years ago

But I discovered another thing:

When you run TO_POINTS you must be in the same alignment as when the feature was measured/defined!

The script gets the numbers 'as is', and does not convert between alignments.

I had a need for this and ended up with the following. It's cut from routines doing something else but might lend itself to what you are after. "XformTwoHops" takes the current cursor location (and axis) as the destination for the hits. It then gets the axis for the feature of interest location. The GetData command only transforms the feature XYZ back to machine then forward to destination axis. This would have to be done for each xyz, ijk, nom, meas triplet for each hit in actual use. Pretty tedious. "CIR2" was used in a test program and should be replaced by the label of the feature being disected.

Sub XformTwoHops()
    Dim oApp As pcdlrn.Application
    Dim oPart As pcdlrn.PartProgram
    Dim oCmds As pcdlrn.Commands
    Dim oSrcCmd As pcdlrn.Command     'source feature from which to extract hits from
    Dim oTmpCmd As pcdlrn.Command     'cursor location at which to insert hits at
    Dim oSrcMat As pcdlrn.DmisMatrix  'active axis for source feature
    Dim oDestMat As pcdlrn.DmisMatrix 'destination axis into which hits are transformed into
    Dim oTrip As pcdlrn.PointData     'triplet
    Dim bRet As Boolean
    Dim sSrcFeat As String

    sSrcFeat = "CIR2"  ' FeatureList(Dlg1.Listbox) in vpt.se's original code
    Set oApp = CreateObject("PCDLRN.Application")
    Set oPart = oApp.ActivePartProgram
    Set oCmds = oPart.Commands
    Set oTmpCmd = oCmds.CurrentCommand  'starting cursor location in Edit Window - desired insertion location
    Set oDestMat = oCmds.CurrentAlignment.AlignmentCommand.MachineToPartMatrix

    'choosen feature to manipulate
    bRet = oCmds.SetCurrentCommand(oCmds.Item(sSrcFeat))
    Set oSrcCmd = oCmds.CurrentCommand
    oPart.RefreshPart
    'refresh needed to actually move cursor location to source feature
    'without refresh cursor remains at initial location before SetCurrentCommand with source feature
    'not refreshing causes the alignment of original cursor location to be rechoosen

    Set oSrcMat = oCmds.CurrentAlignment.AlignmentCommand.MachineToPartMatrix
    Set oTrip = oSrcMat.PrimaryAxis
    'need to initialize oTrip PointData object before it becomes usable
    'omitting this causes problems next with .GetData("Automation error - server threw an exception")

    bRet = oSrcCmd.FeatureCommand.GetData(oTrip, FDATA_CENTROID, FDATA_THEO, FDATA_PART, "", PLANE_TOP)
    oSrcMat.TransformDataBack oTrip, ROTATE_AND_TRANSLATE, PLANE_TOP  'into machine axis
    oDestMat.TransformDataForward oTrip, ROTATE_AND_TRANSLATE, PLANE_TOP  'into destination axis

    '
    ' do something with oTrip XYZ or IJK
    '

    Set oTrip = Nothing
    Set oSrcMat = Nothing
    Set oDestMat = Nothing
    Set oTmpCmd = Nothing
    Set oSrcCmd = Nothing
    Set oCmds = Nothing
    Set oPart = Nothing
    Set oApp = Nothing
End Sub

Cut out the middle man (machine) and transform directly from source axis to destination axis. Still lengthy.

Sub XformOneHop()
    Dim oApp As pcdlrn.Application
    Dim oPart As pcdlrn.PartProgram
    Dim oCmds As pcdlrn.Commands
    Dim oSrcCmd As pcdlrn.Command     'source feature from which to extract hits from
    Dim oTmpCmd As pcdlrn.Command     'cursor location at which to insert hits at
    Dim oSrcMat As pcdlrn.DmisMatrix  'active axis for source feature
    Dim oDestMat As pcdlrn.DmisMatrix 'destination axis into which hits are transformed into
    Dim oDeltMat As pcdlrn.DmisMatrix 'delta transformation from source axis to destination axis
    Dim oTrip As pcdlrn.PointData     'triplet
    Dim bRet As Boolean
    Dim sSrcFeat As String

    sSrcFeat = "CIR2"  ' FeatureList(Dlg1.Listbox) in vpt.se's original code
    Set oApp = CreateObject("PCDLRN.Application")
    Set oPart = oApp.ActivePartProgram
    Set oCmds = oPart.Commands

    'get destination location & axis
    Set oTmpCmd = oCmds.CurrentCommand  'starting cursor location in Edit Window - desired insertion location
    Set oDestMat = oCmds.CurrentAlignment.AlignmentCommand.MachineToPartMatrix

    'choosen feature to manipulate
    bRet = oCmds.SetCurrentCommand(oCmds.Item(sSrcFeat))  'FeatureList(Dlg1.Listbox) in vpt.se's original code
    Set oSrcCmd = oCmds.CurrentCommand
    oPart.RefreshPart
    'refresh apparently needed to actually move cursor location to source feature
    'without refresh cursor remains at initial location before SetCurrentCommand with source feature
    'not refreshing causes the alignment of original cursor location to be rechoosen

    Set oSrcMat = oCmds.CurrentAlignment.AlignmentCommand.MachineToPartMatrix

    Set oTrip = oSrcMat.PrimaryAxis
    'need to initialize oTrip PointData object before it becomes usable
    'omitting this causes problems next with .GetData ("Automation error - server threw an exception")

    bRet = oSrcCmd.FeatureCommand.GetData(oTrip, FDATA_CENTROID, FDATA_THEO, FDATA_PART, "", PLANE_TOP)
    'substitute above .GetData parameters for whatever is needed (nom, meas, xyz, ijk)

    'delta transformation matrix directly from source system to destination system
    Set oDeltMat = oSrcMat.Inverse.Multiply(oDestMat)
    oDeltMat.TransformDataForward oTrip, ROTATE_AND_TRANSLATE, PLANE_TOP

    '
    ' do something with oTrip XYZ or IJK
    '

    Set oTrip = Nothing
    Set oDeltMat = Nothing
    Set oSrcMat = Nothing
    Set oDestMat = Nothing
    Set oTmpCmd = Nothing
    Set oSrcCmd = Nothing
    Set oCmds = Nothing
    Set oPart = Nothing
    Set oApp = Nothing
End Sub

I ended up using the following which allows PcDmis to do the heavy lifting. Wasn't able to manipulate the EditWindow.SetPasteWithPatternParameters for the pasted feature to have a unique name (this feature gets deleted anyway if the command is uncommented).

Sub XfrmCopyPaste()
    Dim oApp As pcdlrn.Application
    Dim oPart As pcdlrn.PartProgram
    Dim oCmds As pcdlrn.Commands
    Dim oSrcCmd As pcdlrn.Command
    Dim oTmpCmd As pcdlrn.Command
    Dim oEditWin As pcdlrn.EditWindow
    Dim bRet As Boolean
    Dim sSrcFeat As String

    sSrcFeat = "CIR2"  ' FeatureList(Dlg1.Listbox) in vpt.se's original code
    Set oApp = CreateObject("PCDLRN.Application")
    Set oPart = oApp.ActivePartProgram
    Set oEditWin = oPart.EditWindow
    Set oCmds = oPart.Commands

    'save desired insertion location
    Set oTmpCmd = oCmds.CurrentCommand  'cursor location in Edit Window

    'choosen feature to manipulate
    bRet = oCmds.SetCurrentCommand(oCmds.Item(sSrcFeat))
    oEditWin.SelectCommand
    oEditWin.CopySelectedToClipboard
    bRet = oCmds.SetCurrentCommand(oTmpCmd)
    bRet = oCmds.InsertionPointAfter(oTmpCmd)
    oEditWin.PasteFromClipboard
    oTmpCmd.Next  'have newly inserted copy/pasted command in current axis

    '
    'extract hits from oTmpCmd per vpt.se code
    '

    'oTmpCmd.Remove  'delete copy/pasted command from commands list & Edit Window
    oPart.RefreshPart  'redraw Edit Window

    Set oEditWin = Nothing
    Set oTmpCmd = Nothing
    Set oSrcCmd = Nothing
    Set oCmds = Nothing
    Set oPart = Nothing
    Set oApp = Nothing
End Sub

I think I tried some of this a while back but drew a blank. Initiating the PointData object and refreshing the Edit Window seemed to help. Funny how something that doesn't even seem to matter can stop me in my tracks at times. Haven't timed anything so have no idea which technique might be more efficient.

Reply

GomoFazter over 7 years ago

But I discovered another thing:

When you run TO_POINTS you must be in the same alignment as when the feature was measured/defined!

The script gets the numbers 'as is', and does not convert between alignments.

Sub XformTwoHops()
    Dim oApp As pcdlrn.Application
    Dim oPart As pcdlrn.PartProgram
    Dim oCmds As pcdlrn.Commands
    Dim oSrcCmd As pcdlrn.Command     'source feature from which to extract hits from
    Dim oTmpCmd As pcdlrn.Command     'cursor location at which to insert hits at
    Dim oSrcMat As pcdlrn.DmisMatrix  'active axis for source feature
    Dim oDestMat As pcdlrn.DmisMatrix 'destination axis into which hits are transformed into
    Dim oTrip As pcdlrn.PointData     'triplet
    Dim bRet As Boolean
    Dim sSrcFeat As String

    sSrcFeat = "CIR2"  ' FeatureList(Dlg1.Listbox) in vpt.se's original code
    Set oApp = CreateObject("PCDLRN.Application")
    Set oPart = oApp.ActivePartProgram
    Set oCmds = oPart.Commands
    Set oTmpCmd = oCmds.CurrentCommand  'starting cursor location in Edit Window - desired insertion location
    Set oDestMat = oCmds.CurrentAlignment.AlignmentCommand.MachineToPartMatrix

    'choosen feature to manipulate
    bRet = oCmds.SetCurrentCommand(oCmds.Item(sSrcFeat))
    Set oSrcCmd = oCmds.CurrentCommand
    oPart.RefreshPart
    'refresh needed to actually move cursor location to source feature
    'without refresh cursor remains at initial location before SetCurrentCommand with source feature
    'not refreshing causes the alignment of original cursor location to be rechoosen

    Set oSrcMat = oCmds.CurrentAlignment.AlignmentCommand.MachineToPartMatrix
    Set oTrip = oSrcMat.PrimaryAxis
    'need to initialize oTrip PointData object before it becomes usable
    'omitting this causes problems next with .GetData("Automation error - server threw an exception")

    bRet = oSrcCmd.FeatureCommand.GetData(oTrip, FDATA_CENTROID, FDATA_THEO, FDATA_PART, "", PLANE_TOP)
    oSrcMat.TransformDataBack oTrip, ROTATE_AND_TRANSLATE, PLANE_TOP  'into machine axis
    oDestMat.TransformDataForward oTrip, ROTATE_AND_TRANSLATE, PLANE_TOP  'into destination axis

    '
    ' do something with oTrip XYZ or IJK
    '

    Set oTrip = Nothing
    Set oSrcMat = Nothing
    Set oDestMat = Nothing
    Set oTmpCmd = Nothing
    Set oSrcCmd = Nothing
    Set oCmds = Nothing
    Set oPart = Nothing
    Set oApp = Nothing
End Sub

Cut out the middle man (machine) and transform directly from source axis to destination axis. Still lengthy.

Sub XformOneHop()
    Dim oApp As pcdlrn.Application
    Dim oPart As pcdlrn.PartProgram
    Dim oCmds As pcdlrn.Commands
    Dim oSrcCmd As pcdlrn.Command     'source feature from which to extract hits from
    Dim oTmpCmd As pcdlrn.Command     'cursor location at which to insert hits at
    Dim oSrcMat As pcdlrn.DmisMatrix  'active axis for source feature
    Dim oDestMat As pcdlrn.DmisMatrix 'destination axis into which hits are transformed into
    Dim oDeltMat As pcdlrn.DmisMatrix 'delta transformation from source axis to destination axis
    Dim oTrip As pcdlrn.PointData     'triplet
    Dim bRet As Boolean
    Dim sSrcFeat As String

    sSrcFeat = "CIR2"  ' FeatureList(Dlg1.Listbox) in vpt.se's original code
    Set oApp = CreateObject("PCDLRN.Application")
    Set oPart = oApp.ActivePartProgram
    Set oCmds = oPart.Commands

    'get destination location & axis
    Set oTmpCmd = oCmds.CurrentCommand  'starting cursor location in Edit Window - desired insertion location
    Set oDestMat = oCmds.CurrentAlignment.AlignmentCommand.MachineToPartMatrix

    'choosen feature to manipulate
    bRet = oCmds.SetCurrentCommand(oCmds.Item(sSrcFeat))  'FeatureList(Dlg1.Listbox) in vpt.se's original code
    Set oSrcCmd = oCmds.CurrentCommand
    oPart.RefreshPart
    'refresh apparently needed to actually move cursor location to source feature
    'without refresh cursor remains at initial location before SetCurrentCommand with source feature
    'not refreshing causes the alignment of original cursor location to be rechoosen

    Set oSrcMat = oCmds.CurrentAlignment.AlignmentCommand.MachineToPartMatrix

    Set oTrip = oSrcMat.PrimaryAxis
    'need to initialize oTrip PointData object before it becomes usable
    'omitting this causes problems next with .GetData ("Automation error - server threw an exception")

    bRet = oSrcCmd.FeatureCommand.GetData(oTrip, FDATA_CENTROID, FDATA_THEO, FDATA_PART, "", PLANE_TOP)
    'substitute above .GetData parameters for whatever is needed (nom, meas, xyz, ijk)

    'delta transformation matrix directly from source system to destination system
    Set oDeltMat = oSrcMat.Inverse.Multiply(oDestMat)
    oDeltMat.TransformDataForward oTrip, ROTATE_AND_TRANSLATE, PLANE_TOP

    '
    ' do something with oTrip XYZ or IJK
    '

    Set oTrip = Nothing
    Set oDeltMat = Nothing
    Set oSrcMat = Nothing
    Set oDestMat = Nothing
    Set oTmpCmd = Nothing
    Set oSrcCmd = Nothing
    Set oCmds = Nothing
    Set oPart = Nothing
    Set oApp = Nothing
End Sub

Sub XfrmCopyPaste()
    Dim oApp As pcdlrn.Application
    Dim oPart As pcdlrn.PartProgram
    Dim oCmds As pcdlrn.Commands
    Dim oSrcCmd As pcdlrn.Command
    Dim oTmpCmd As pcdlrn.Command
    Dim oEditWin As pcdlrn.EditWindow
    Dim bRet As Boolean
    Dim sSrcFeat As String

    sSrcFeat = "CIR2"  ' FeatureList(Dlg1.Listbox) in vpt.se's original code
    Set oApp = CreateObject("PCDLRN.Application")
    Set oPart = oApp.ActivePartProgram
    Set oEditWin = oPart.EditWindow
    Set oCmds = oPart.Commands

    'save desired insertion location
    Set oTmpCmd = oCmds.CurrentCommand  'cursor location in Edit Window

    'choosen feature to manipulate
    bRet = oCmds.SetCurrentCommand(oCmds.Item(sSrcFeat))
    oEditWin.SelectCommand
    oEditWin.CopySelectedToClipboard
    bRet = oCmds.SetCurrentCommand(oTmpCmd)
    bRet = oCmds.InsertionPointAfter(oTmpCmd)
    oEditWin.PasteFromClipboard
    oTmpCmd.Next  'have newly inserted copy/pasted command in current axis

    '
    'extract hits from oTmpCmd per vpt.se code
    '

    'oTmpCmd.Remove  'delete copy/pasted command from commands list & Edit Window
    oPart.RefreshPart  'redraw Edit Window

    Set oEditWin = Nothing
    Set oTmpCmd = Nothing
    Set oSrcCmd = Nothing
    Set oCmds = Nothing
    Set oPart = Nothing
    Set oApp = Nothing
End Sub

Children

No Data