Problem with Command.GetFieldValue and the new GeoTol (2020 R2)

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • Problem with Command.GetFieldValue and the new GeoTol (2020 R2)

    Greetings,


    I have been using the VB.Script ".GetFieldValue" since version 2014.1 to transfer measured values ​​to an external application.
    This function ".GetFieldValue" ​​was nice to transfer data without an additional assign command

    Unfortunately this no longer works with the new GeoTol in 2020R2.
    There are simply no measured values ​​stored in GeoTol.Commands or I cannot find them.

    Can someone tell me how else to access this data, if possible with a single function?











  • #2
    Greetings,

    i found a compromise. It is possible to read out the measured values ​​from the EditWindow.
    Because since 2020R2 the measured values ​​are also displayed there.

    don't get me wrong but this is a wheelchair with different sized tires.
    I would still be happy about a correct solution.


    But with this script, the measured values ​​of GeoTol can be extracted at runtime without additional commands
    This script probably only works with the English language setting because it parses the command text directly.
    (testet with English and German)


    Code:
    Sub Main()
    On Error Resume Next
    
    ' Dim something
    Dim sOutput As String
    Dim vOutput As Object
    Set vOutput = CreateObject("PCDLRN.DimData")
    
    Dim CmdText, StrValue, SubCmdText, NumTest As String
    Dim nPos1, nPos2 As Integer
    Dim DblTest1, DblTest2 As Double
    NumTest = "0123456789"
    
    Dim App, Part, Cmds, Cmd As Object
    Set App = CreateObject("PCDLRN.Application")
    If (Not App.WaitUntilReady(300)) Or (App Is Nothing) Then
    MsgBox "Machine did not initialize, Exiting"
    Exit Sub
    End If
    Set Part = App.ActivePartProgram
    Set Cmds = Part.Commands
    Set Cmd = Nothing
    
    
    
    ' Loop all Commands
    For Each Cmd In Cmds
    ' Get Command Text from EditWindow
    CmdText = Cmd.Application.ActivePartProgram.EditWindow.GetCommandText(Cmd)
    
    
    ' only Geometric_Tolerace
    If (Cmd.IsDimension) And (InStr(1, CmdText, "=GEOMETRI") <> 0) Then
    
    ' Parse CmdText To OTOL
    'SEGMENT
    nPos1 = InStr(1, CmdText, "SEGMENT")
    vOutput.Plus = 0
    If nPos1 > 0 Then
    nPos2 = InStr(nPos1 + 1, CmdText, ":")
    SubCmdText = Mid(CmdText, nPos1 + 1, nPos2 - nPos1 - 1)
    
    nPos1 = InStr(1, SubCmdText, ",")
    nPos2 = InStr(nPos1 + 1, SubCmdText, ",")
    While nPos1 <> 0
    StrValue = Mid(SubCmdText, nPos1 + 1, nPos2 - nPos1 - 1)
    If InStr(1, NumTest, Left(StrValue, 1)) <> 0 Then
    vOutput.Plus = CDbl(StrValue)
    End If
    nPos1 = nPos2
    nPos2 = InStr(nPos1 + 1, SubCmdText, ",")
    Wend
    End If
    
    ' Parse CmdText To MEASURED
    'MULT=
    ':
    ': ,
    nPos1 = InStr(1, CmdText, "MULT=")
    vOutput.Meas = 0
    If nPos1 > 0 Then
    nPos2 = InStr(nPos1 + 1, CmdText, ":")
    If nPos2 > 0 Then
    nPos1 = InStr(nPos2 + 1, CmdText, ":")
    nPos2 = InStr(nPos1 + 1, CmdText, ",")
    
    While nPos1 <> 0
    StrValue = Mid(CmdText, nPos1 + 1, nPos2 - nPos1 - 1)
    If InStr(1, NumTest, Left(StrValue, 1)) <> 0 Then
    If vOutput.Meas = 0 Then
    ' Single Line MEASURED
    vOutput.Meas = CDbl(StrValue)
    vOutput.Max = vOutput.Meas
    vOutput.Min = vOutput.Meas
    Else
    ' special Case multi Line MEASURED
    If CDbl(StrValue) > vOutput.Max Then vOutput.Max = CDbl(StrValue)
    If CDbl(StrValue) < vOutput.Min Then vOutput.Min = CDbl(StrValue)
    End If
    End If
    nPos1 = InStr(nPos2 + 1, CmdText, ":")
    nPos2 = InStr(nPos1 + 1, CmdText, ",")
    Wend
    End If
    End If
    
    ' the rest
    vOutput.Bonus = 0
    vOutput.nom = 0
    vOutput.Minus = 0
    vOutput.Dev = vOutput.Meas
    vOutput.DevAngle = 0
    DblTest1 = vOutput.Plus
    DblTest2 = vOutput.Max
    If (DblTest1 - DblTest2) < 0 Then
    vOutput.Out = Abs(DblTest1 - DblTest2)
    Else
    vOutput.Out = 0
    End If
    
    
    ' Do something With vOutput
    sOutput = Cmd.ID & Chr(10) & Chr(13)
    sOutput = sOutput & "nominal:" & CStr(vOutput.nom) & Chr(10) & Chr(13)
    sOutput = sOutput & "measured: " & CStr(vOutput.Meas) & Chr(10) & Chr(13)
    sOutput = sOutput & "tol plus: " & CStr(vOutput.Plus) & Chr(10) & Chr(13)
    sOutput = sOutput & "tol minus: " & CStr(vOutput.Minus) & Chr(10) & Chr(13)
    sOutput = sOutput & "out of Tol: " & CStr(vOutput.Out) & Chr(10) & Chr(13)
    sOutput = sOutput & "max: " & CStr(vOutput.Max) & Chr(10) & Chr(13)
    sOutput = sOutput & "min: " & CStr(vOutput.Min)
    
    MsgBox sOutput
    
    End If
    Next Cmd
    
    
    Set Cmds = Nothing
    Set Cmd = Nothing
    Set Part = Nothing
    Set App = Nothing
    
    Set vOutput = Nothing
    End Sub
    Attached Files
    Last edited by Henniger123; 10-15-2020, 02:06 AM. Reason: additional information

    Comment


    • #3
      Good Day,

      Finally, i figured out how it supposed to be done:

      With this you can call up the measured values ​​from the geoTol commands (2020R2) in a script and use them for something.
      (for example database storage)


      Code:
      Sub test()
      
        Dim App, Part, Cmds, DmisCommand As Object
        Dim OutputText, sPuffer As String
        Dim RetVal
        Dim LoopIndex As Integer
      
        Set App = CreateObject("PCDLRN.Application")
        Set Part = App.PartPrograms.Item(1)
        Set Cmds = Part.Commands
      
        For Each DmisCommand In Cmds
      
          If (DmisCommand.Type = ISO_TOLERANCE_COMMAND) Or (DmisCommand.Type = ASME_TOLERANCE_COMMAND) Then
            OutputText = "STANDARD: " & DmisCommand.GetText(STANDARD, 0) & Chr(13)
            OutputText = OutputText & "UNIT_TYPE: " & DmisCommand.GetText(UNIT_TYPE, 0) & Chr(13)
            OutputText = OutputText & "SEGMENT_TYPE_TOGGLE: " & DmisCommand.GetText(SEGMENT_TYPE_TOGGLE, 1) & Chr(13)
            OutputText = OutputText & "OUTPUT_TYPE: " & DmisCommand.GetText(OUTPUT_TYPE, 0) & Chr(13)
            OutputText = OutputText & "ARROW_DENSITY: " & DmisCommand.GetText(ARROW_DENSITY, 0) & Chr(13)
            OutputText = OutputText & "Upper Toleranz: " & DmisCommand.GetText(FORM_TOLERANCE, 1) & Chr(13)
            OutputText = OutputText & "lower Toleranz: " & "0" & Chr(13)
      
      
            LoopIndex = 1
            sPuffer = DmisCommand.GetText(REF_ID, LoopIndex)
            While sPuffer <> ""
              OutputText = OutputText & " ->" & sPuffer & " = " & DmisCommand.GetTextEx(DIM_DEVIATION, LoopIndex, "SEG=1") & Chr(13)
      
              LoopIndex = LoopIndex + 1
              sPuffer = DmisCommand.GetText(REF_ID, LoopIndex)
            Wend
      
            MsgBox OutputText
          End If
      
        Next DmisCommand
      End Sub

      Comment


      • LostL
        LostL commented
        Editing a comment
        God **** it, you had me worried there...

    Related Topics

    Collapse

    Working...
    X