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

little update
* the t-values are now calculated correctly
* you can now use the start and end number to control which points should be added

ExtractVectorPoints.txt
File must be renamed to *.BAS, then you can load the file into a measurement program with "insert Basic Script"

Function pcDMIS_extract_Number(ByVal aText As String) As Integer
  pcDMIS_extract_Number = 0
  If aText = "" Then Exit Function
  Dim I As Integer
  Dim S As String
    
  S = ""
  For I = 1 To Len(aText)
    If InStr(1, "0123456789", Mid(aText, I, 1)) > 0 Then
      S = S + Mid(aText, I, 1)
    End If
  Next I
  If S <> "" Then pcDMIS_extract_Number = CInt(S)
End Function

Sub Main()
  ' writes all pointdata to excel sheet
  ' the excel sheet must be saved manually
 
  ' constants
    Const sVectorPointName = "PT_"
    Const iStartPointNr = 1 '0 = All
    Const iEndPointNr = 0 '0 = All
 
  ' Dim Something
    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
    
    Set objExcel = CreateObject("Excel.Application")
    Set objNewBook = objExcel.Workbooks.Add
    
    Dim sPath As String
    Dim iCount, iNumber As Integer
    Dim vTX, vTY, vTZ, vMX, vMY, vMZ As Double
    Dim vMI, vMJ, vMK As Double

  ' write excel header
    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"
    
  ' search pcDMIS
    iCount = 2 'Excel start row
    
    For Each pcDMISCmd In pcDMISCmds
      If pcDMISCmd.Type = 602 Then 'CONTACT_VECTOR_POINT_FEATURE = 602
        iNumber = pcDMIS_extract_Number(pcDMISCmd.ID)
        If (InStr(1, pcDMISCmd.ID, sVectorPointName) > 0) And _
           ((iNumber >= iStartPointNr) Or (iStartPointNr = 0)) And _
           ((iNumber <= iEndPointNr) Or (iEndPointNr = 0)) _
        Then
          ' get some values from command
          vTX = pcDMISCmd.GetText(THEO_X, 0)
          vTY = pcDMISCmd.GetText(THEO_Y, 0)
          vTZ = pcDMISCmd.GetText(THEO_Z, 0)
          vMX = pcDMISCmd.GetText(MEAS_X, 0)
          vMY = pcDMISCmd.GetText(MEAS_Y, 0)
          vMZ = pcDMISCmd.GetText(MEAS_Z, 0)
          vMI = pcDMISCmd.GetText(MEAS_I, 0)
          vMJ = pcDMISCmd.GetText(MEAS_J, 0)
          vMK = pcDMISCmd.GetText(MEAS_K, 0)
          
          ' write to Excel
          objNewBook.Sheets(1).Cells(iCount, 1).Value = pcDMISCmd.ID
          objNewBook.Sheets(1).Cells(iCount, 2).Value = vMX
          objNewBook.Sheets(1).Cells(iCount, 3).Value = vMY
          objNewBook.Sheets(1).Cells(iCount, 4).Value = vMZ
          objNewBook.Sheets(1).Cells(iCount, 5).Value = (((vTX - vMX) * vMI) + ((vTY - vMY) * vMJ) + ((vTZ - vMZ) * vMK)) * -1
          
          ' next excel row
          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

Attached Files

ExtractVectorPoints.txt

Reply

Henniger123 over 1 year ago

Function pcDMIS_extract_Number(ByVal aText As String) As Integer
  pcDMIS_extract_Number = 0
  If aText = "" Then Exit Function
  Dim I As Integer
  Dim S As String
    
  S = ""
  For I = 1 To Len(aText)
    If InStr(1, "0123456789", Mid(aText, I, 1)) > 0 Then
      S = S + Mid(aText, I, 1)
    End If
  Next I
  If S <> "" Then pcDMIS_extract_Number = CInt(S)
End Function

Sub Main()
  ' writes all pointdata to excel sheet
  ' the excel sheet must be saved manually
 
  ' constants
    Const sVectorPointName = "PT_"
    Const iStartPointNr = 1 '0 = All
    Const iEndPointNr = 0 '0 = All
 
  ' Dim Something
    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
    
    Set objExcel = CreateObject("Excel.Application")
    Set objNewBook = objExcel.Workbooks.Add
    
    Dim sPath As String
    Dim iCount, iNumber As Integer
    Dim vTX, vTY, vTZ, vMX, vMY, vMZ As Double
    Dim vMI, vMJ, vMK As Double

  ' write excel header
    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"
    
  ' search pcDMIS
    iCount = 2 'Excel start row
    
    For Each pcDMISCmd In pcDMISCmds
      If pcDMISCmd.Type = 602 Then 'CONTACT_VECTOR_POINT_FEATURE = 602
        iNumber = pcDMIS_extract_Number(pcDMISCmd.ID)
        If (InStr(1, pcDMISCmd.ID, sVectorPointName) > 0) And _
           ((iNumber >= iStartPointNr) Or (iStartPointNr = 0)) And _
           ((iNumber <= iEndPointNr) Or (iEndPointNr = 0)) _
        Then
          ' get some values from command
          vTX = pcDMISCmd.GetText(THEO_X, 0)
          vTY = pcDMISCmd.GetText(THEO_Y, 0)
          vTZ = pcDMISCmd.GetText(THEO_Z, 0)
          vMX = pcDMISCmd.GetText(MEAS_X, 0)
          vMY = pcDMISCmd.GetText(MEAS_Y, 0)
          vMZ = pcDMISCmd.GetText(MEAS_Z, 0)
          vMI = pcDMISCmd.GetText(MEAS_I, 0)
          vMJ = pcDMISCmd.GetText(MEAS_J, 0)
          vMK = pcDMISCmd.GetText(MEAS_K, 0)
          
          ' write to Excel
          objNewBook.Sheets(1).Cells(iCount, 1).Value = pcDMISCmd.ID
          objNewBook.Sheets(1).Cells(iCount, 2).Value = vMX
          objNewBook.Sheets(1).Cells(iCount, 3).Value = vMY
          objNewBook.Sheets(1).Cells(iCount, 4).Value = vMZ
          objNewBook.Sheets(1).Cells(iCount, 5).Value = (((vTX - vMX) * vMI) + ((vTY - vMY) * vMJ) + ((vTZ - vMZ) * vMK)) * -1
          
          ' next excel row
          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

Attached Files

ExtractVectorPoints.txt

Children

No Data