hexagon logo
Register Sign in
  • Replies 22 replies
  • Subscribers 30 subscribers
  • Views 523 views
  • Users 0 members are here
Options
Related

Results from 2 programs

gitalife
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.

  • Thanks VPT.SE,
    I will look at the YOUTUBE video at home.
    It's blocked at work.Disappointed

    Henniger123,
    The points are just your basic vector points.
    PT_1 thru PT_500. (Very creative Slight smile)

    I would mark only the points I want written to the Excel file.

    I would like the Excel file to look something this.
    Measurements in inches. Deviations are T value.

    BEST FIT FINAL DIFFERENCE

    PT_1 +.0061 .0052 .0009
    PT_2 +.0069 .0063 .0006

    AD INFINITUM

    Thanks for your comments.
  • 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
  • Hello,

    the formula calculates the T_Value. But my math isn't good enough right now to determine if the value is positive or negative
    (it's only positive right now, the vector direction is ignored, this is just the length) 

      ' 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
    Dim vTX, vTY, vTZ, vMX, vMY, vMZ As Double
    

  ' 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
          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)
          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 = Sqr(((vTX - vMX) ^ 2) + ((vTY - vMY) ^ 2) + ((vTZ - vMZ) ^ 2))
          
          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​
  • Thanks Henniger123,
    I will study the code and give it a try.
    It's obvious from my questions that I'm a newbie at Basic.
    I took Pascal in college. That should date me!Slight smile
  • Trying to post a reply and I get this error message. 1st time for everything.

    ​
  • 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
  • in reply to gitalife
    I can't reproduce
    maybe you are trying to post something that is partly used for HTML format and therefore the forum does not understand it?
  • Henniger123,
    Sorry. I'm guilty of the sin of omission.
    In other scripts, I have grabbed the "t" value from the dimension block.



    Something like

    If Cmd.IsDimension and Cmd.Marked THEN

    Set DimCmd = Cmd.DimensionCommand

    END IF

    If DimCmd.AxisLetter = "T" THEN
    value = DimCmd.Deviation​

    ETC, ETC.

    END IF​




    I might try to tweak your code to accomplish that.

    The code to have PCDMIS talk to Excel was especially enlightening.
    Thanks.​​​
  • Henniger123,
    Funny, I deleted the vector point block and the dimension block that was
    cut and pasted from the PCDMIS program, and then the reply went thru.
© 2024 Hexagon AB and/or its subsidiaries. Privacy Policy | Cloud Services Agreement