Results from 2 programs

Hello all,
Very general question.
Is anyone aware of a program that would compare the results of 2 identical
programs and show the individual point deviations in an excel file.
Example--first program would be a best fit.
2nd program would be a final.

Programs would be identical in the sense that the theoretical point locations
would be the same in both programs, but the alignments would
be different in the first and 2nd programs.

Thanks to everyone for any help offered.

Parents

Henniger123 over 1 year ago

Hello,

To my regret, the TValue cannot be extracted. Or the function is bugy.
I hope the XYZ value is useful enough

Sub Main_pcDMIS_Excel()
  ' writes all pointdata to excel sheet
  ' the excel sheet must be saved manually
 
  ' Dim Something
    Const cPointName = "PT_"
 
    Dim pcDMISApp As Object
    Set pcDMISApp = CreateObject("PCDLRN.Application")
    Dim pcDMISPart As Object
    Set pcDMISPart = pcDMISApp.ActivePartProgram
    Dim pcDMISCmds As Object
    Set pcDMISCmds = pcDMISPart.Commands
    Dim pcDMISCmd As Object
 
    Dim objExcel As Object
    Dim objNewBook As Object
    Dim objSheet As Object
    
    Set objExcel = CreateObject("Excel.Application")
    Set objNewBook = objExcel.Workbooks.Add
    
    'Dim ExcelSheet As Object
    'Set ExcelSheet = CreateObject("Excel.Sheet")
    
    objExcel.ScreenUpdating = False
    objNewBook.Sheets(1).Cells(1, 1).Value = "name"
    objNewBook.Sheets(1).Cells(1, 2).Value = "X-Value"
    objNewBook.Sheets(1).Cells(1, 3).Value = "Y-Value"
    objNewBook.Sheets(1).Cells(1, 4).Value = "Z-Value"
    objNewBook.Sheets(1).Cells(1, 5).Value = "T-Value"

    Dim sPath As String
    Dim iCount As Integer
    Dim dTValue As Double
    Dim retval

  ' search pcDMIS
    iCount = 2
    
    For Each pcDMISCmd In pcDMISCmds
      If pcDMISCmd.Type = 602 Then 'CONTACT_VECTOR_POINT_FEATURE = 602
        If InStr(1, pcDMISCmd.ID, cPointName) > 0 Then
          objNewBook.Sheets(1).Cells(iCount, 1).Value = pcDMISCmd.ID
          objNewBook.Sheets(1).Cells(iCount, 2).Value = pcDMISCmd.GetText(MEAS_X, 0)
          objNewBook.Sheets(1).Cells(iCount, 3).Value = pcDMISCmd.GetText(MEAS_Y, 0)
          objNewBook.Sheets(1).Cells(iCount, 4).Value = pcDMISCmd.GetText(MEAS_Z, 0)
          
          retval = pcDMISCmd.FeatureCommand.GetHitTValue(0, dTValue)
          objNewBook.Sheets(1).Cells(iCount, 5).Value = dTValue
          retval = pcDMISCmd.FeatureCommand.GetHitTValue(1, dTValue)
          objNewBook.Sheets(1).Cells(iCount, 6).Value = dTValue
          retval = pcDMISCmd.FeatureCommand.GetHitTValue(2, dTValue)
          objNewBook.Sheets(1).Cells(iCount, 7).Value = dTValue
          
          iCount = iCount + 1
        End If
      End If
    Next pcDMISCmd
    
 
  ' close excel
    objExcel.ScreenUpdating = True
    objExcel.Visible = True
    sPath = "C:\Users\qs\Desktop\TEST.XLSX"
    'objNewBook.SaveAs sPath
    'objExcel.Quit

  ' unDim Something
    Set objNewBook = Nothing
    Set objExcel = Nothing
    Set pcDMISCmd = Nothing
    Set pcDMISCmds = Nothing
    Set pcDMISPart = Nothing
    Set pcDMISApp = Nothing
End Sub

Reply

Henniger123 over 1 year ago

Hello,

To my regret, the TValue cannot be extracted. Or the function is bugy.
I hope the XYZ value is useful enough

Sub Main_pcDMIS_Excel()
  ' writes all pointdata to excel sheet
  ' the excel sheet must be saved manually
 
  ' Dim Something
    Const cPointName = "PT_"
 
    Dim pcDMISApp As Object
    Set pcDMISApp = CreateObject("PCDLRN.Application")
    Dim pcDMISPart As Object
    Set pcDMISPart = pcDMISApp.ActivePartProgram
    Dim pcDMISCmds As Object
    Set pcDMISCmds = pcDMISPart.Commands
    Dim pcDMISCmd As Object
 
    Dim objExcel As Object
    Dim objNewBook As Object
    Dim objSheet As Object
    
    Set objExcel = CreateObject("Excel.Application")
    Set objNewBook = objExcel.Workbooks.Add
    
    'Dim ExcelSheet As Object
    'Set ExcelSheet = CreateObject("Excel.Sheet")
    
    objExcel.ScreenUpdating = False
    objNewBook.Sheets(1).Cells(1, 1).Value = "name"
    objNewBook.Sheets(1).Cells(1, 2).Value = "X-Value"
    objNewBook.Sheets(1).Cells(1, 3).Value = "Y-Value"
    objNewBook.Sheets(1).Cells(1, 4).Value = "Z-Value"
    objNewBook.Sheets(1).Cells(1, 5).Value = "T-Value"

    Dim sPath As String
    Dim iCount As Integer
    Dim dTValue As Double
    Dim retval

  ' search pcDMIS
    iCount = 2
    
    For Each pcDMISCmd In pcDMISCmds
      If pcDMISCmd.Type = 602 Then 'CONTACT_VECTOR_POINT_FEATURE = 602
        If InStr(1, pcDMISCmd.ID, cPointName) > 0 Then
          objNewBook.Sheets(1).Cells(iCount, 1).Value = pcDMISCmd.ID
          objNewBook.Sheets(1).Cells(iCount, 2).Value = pcDMISCmd.GetText(MEAS_X, 0)
          objNewBook.Sheets(1).Cells(iCount, 3).Value = pcDMISCmd.GetText(MEAS_Y, 0)
          objNewBook.Sheets(1).Cells(iCount, 4).Value = pcDMISCmd.GetText(MEAS_Z, 0)
          
          retval = pcDMISCmd.FeatureCommand.GetHitTValue(0, dTValue)
          objNewBook.Sheets(1).Cells(iCount, 5).Value = dTValue
          retval = pcDMISCmd.FeatureCommand.GetHitTValue(1, dTValue)
          objNewBook.Sheets(1).Cells(iCount, 6).Value = dTValue
          retval = pcDMISCmd.FeatureCommand.GetHitTValue(2, dTValue)
          objNewBook.Sheets(1).Cells(iCount, 7).Value = dTValue
          
          iCount = iCount + 1
        End If
      End If
    Next pcDMISCmd
    
 
  ' close excel
    objExcel.ScreenUpdating = True
    objExcel.Visible = True
    sPath = "C:\Users\qs\Desktop\TEST.XLSX"
    'objNewBook.SaveAs sPath
    'objExcel.Quit

  ' unDim Something
    Set objNewBook = Nothing
    Set objExcel = Nothing
    Set pcDMISCmd = Nothing
    Set pcDMISCmds = Nothing
    Set pcDMISPart = Nothing
    Set pcDMISApp = Nothing
End Sub

Children

No Data