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?

Henniger123 over 4 years ago

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)

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

GEOTEST.zip

Henniger123 over 3 years ago

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)

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

LostL over 3 years ago in reply to Henniger123

God damn it, you had me worried there...
Cancel
Vote Up 0 Vote Down

Sign in to reply

Cancel
Simon Leigh over 3 years ago

From the top example how do you get the diameter to get output as it only outputs the data regarding the position of a hole for example...
Cancel
Vote Up 0 Vote Down

Sign in to reply

Cancel

Henniger123 over 3 years ago

good day,

i assume you looking for this command
this only works if there is a reference with a diameter

getting the nominal of the reference ID

DmisCommand.GetTextEx(SIZE_NOMINAL, 0, "SIZE")

getting the mesured of the reference ID

DmisCommand.GetText(UPPER_SIZE, LoopIndex)

DmisCommand.GetText(LOWER_SIZE, LoopIndex)

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 & "Upper Toleranz: " & DmisCommand.GetText(FORM_TOLERANCE, 1) & Chr(13)
    OutputText = OutputText & "lower Toleranz: " & "0" & Chr(13)
    OutputText = OutputText & "SIZE_NOMINAL: " & DmisCommand.GetTextEx(SIZE_NOMINAL, 0, "SIZE") & Chr(13)

    LoopIndex = 1
    sPuffer = DmisCommand.GetText(REF_ID, LoopIndex)
    While sPuffer <> ""
      OutputText = OutputText & " ->" & sPuffer & " DIM_DEVIATION = " & DmisCommand.GetTextEx(DIM_DEVIATION, LoopIndex, "SEG=1") & Chr(13)
      OutputText = OutputText & " ->" & sPuffer & " UPPER_SIZE = " & DmisCommand.GetText(UPPER_SIZE, LoopIndex) & Chr(13)
      OutputText = OutputText & " ->" & sPuffer & " LOWER_SIZE = " & DmisCommand.GetText(LOWER_SIZE, LoopIndex) & Chr(13)
      OutputText = OutputText & " " & Chr(13)

      LoopIndex = LoopIndex + 1
      sPuffer = DmisCommand.GetText(REF_ID, LoopIndex)
    Wend


    MsgBox OutputText
  End If

  Next DmisCommand
End Sub

Fradders over 3 years ago in reply to Henniger123

Thanks Henniger123 I will make sure Simon see's this when he gets returns from his holiday
Cancel
Vote Up 0 Vote Down

Sign in to reply

Cancel
Simon Leigh over 3 years ago

That's great Henniger123 that works a treat...I can incorporate that into my existing code.....Thank you so much for this....
Cancel
Vote Up 0 Vote Down

Sign in to reply

Cancel

A-machine-insp over 3 years ago

I am not experienced with coding except for the online coding class Hexagon has. Where would this additional scrip go or what would it replace in the script I have? This script is a script they were using here before I started.

As it is right now, in the excel report it recognized the dimension number but not the nominal/tolerance/result. This is causing us to have to go back and enter these values in by hand which is very time consuming. I also have the Excel template if its needed to help figure this out.

I know I am asking someone to figure this out for me and I hate doing that. However, at this point in time, I need this fixed and don't have the time to figure it out myself.

Sub Main (strVariable As String, reasonVar As String)


'xl Declarations
Dim xlApp As Object
Dim xlWorkbooks As Object
Dim xlWorkbook As Object
Dim xlSheet As Object
Dim count As Integer


'pcdlrn declarations And Open ppg
Dim App As Object
Set App = CreateObject("PCDLRN.Application")
Dim Part As Object
Set Part = App.ActivePartProgram
Dim Cmds As Object
Set Cmds = Part.Commands
Dim Cmd As Object
Dim DCmd As Object
Dim DcmdID As Object
Dim DimID As String
Dim fs As Object
Dim ReportDim As String
Dim CheckDim As String


'Check To see If results file exists
FilePath = "" '.xlsm And .bas files location
DataPath = "" 'report save location
Set fs = CreateObject("Scripting.FileSystemObject")
ResFileExists = fs.fileexists(DataPath & Part.partname & " " & strVariable & " " & reasonVar & ".xlsm") 'check program folder For .xlsm file


'Open Excel And Base form
Set xlApp = CreateObject("Excel.Application")
Set xlWorkbooks = xlapp.Workbooks
If ResFileExists = False Then
TempFilename = FilePath & "Loop Template Column.xlsm"
Else
TempFilename = DataPath & Part.partname & " " & strVariable & " " & reasonVar & ".xlsm"
End If
Set xlWorkbook = xlWorkbooks.Open(TempFilename)
Set xlSheet = xlWorkbook.Worksheets("Sheet1")


If ResFileExists = False Then
RCount=6
CCount=3
xlSheet.Range("B1").Value = Part.PartName
xlSheet.Range("E4").Value = Date() & " " & Time()
xlSheet.Range("D1").Value = strVariable
xlSheet.Range("C2").Value = reasonVar



For Each Cmd In Cmds
'Eliminate DATDEF's
If Cmd.Type <> 1299 Then
'Do Dimensions
If Cmd.IsDimension Then
If Cmd.Type = DIMENSION_START_LOCATION Or Cmd.Type = DIMENSION_TRUE_START_POSITION Then
Set DcmdID = Cmd.DimensionCommand
DimID = DcmdID.ID
ReportDim = Cmd.GetText ( OUTPUT_TYPE, 0)
End If
If Cmd.Type <> DIMENSION_START_LOCATION And Cmd.Type <> DIMENSION_END_LOCATION And _
Cmd.Type <> DIMENSION_TRUE_START_POSITION And Cmd.Type <> DIMENSION_TRUE_END_POSITION Then
Set DCmd = Cmd.DimensionCommand
CheckDim = Cmd.GetText ( OUTPUT_TYPE, 0)
If CheckDim <> "" Then
ReportDim = CheckDim
End If
If ReportDim = "BOTH" Or ReportDim = "STATS" Then
If DCmd.ID = "" Then
xlSheet.Cells(RCount,4).Value = DimID & " . "& DCmd.AxisLetter
Else
xlSheet.Cells(RCount,4).Value = DCmd.ID & " . " & "M"
End If
xlSheet.Cells(RCount,1).Value = DCmd.Nominal
xlSheet.Cells(RCount,2).Value = DCmd.Plus
xlSheet.Cells(RCount,3).Value = DCmd.Minus
'Measured Or Deviation With check For True Position
If DCmd.AxisLetter <> "TP" Then
xlSheet.Cells(RCount,5).Value = DCmd.Measured
Else
xlSheet.Cells(RCount,5).Value = DCmd.Deviation
End If
'Add Min/Max For Profile dimensions
If Cmd.Type = 1118 Or Cmd.Type = 1105 Then
RCount=RCount+1
xlSheet.Cells(RCount,4).Value = DCmd.ID & "." & "Max"
xlSheet.Cells(RCount,1).Value = DCmd.Nominal
xlSheet.Cells(RCount,2).Value = DCmd.Plus
xlSheet.Cells(RCount,3).Value = DCmd.Minus
xlSheet.Cells(RCount,5).Value = DCmd.Max
RCount=RCount+1
xlSheet.Cells(RCount,4).Value = DCmd.ID & "." & "Min"
xlSheet.Cells(RCount,1).Value = DCmd.Nominal
xlSheet.Cells(RCount,2).Value = DCmd.Plus
xlSheet.Cells(RCount,3).Value = DCmd.Minus
xlSheet.Cells(RCount,5).Value = DCmd.Min
End If
RCount=RCount+1
End If
End If
End If
'Do GDT
If Cmd.Type = 184 Then
ReportDim = Cmd.GetText ( OUTPUT_TYPE, 0)
If ReportDim = "BOTH" Or ReportDim = "STATS" Then
xlSheet.Cells(RCount,4).Value = Cmd.GetText (ID, 0) & "." & "FCF"
xlSheet.Cells(RCount,1).Value = "0"
xlSheet.Cells(RCount,2).Value = Cmd.GetText (LINE2_PLUSTOL, 1)
xlSheet.Cells(RCount,3).Value = "0"
xlSheet.Cells(RCount,5).Value = Cmd.GetText (LINE2_DEV, 1)
RCount=RCount+1
End If
End If
End If
Next Cmd


Else

'Find first Open column.
CCount=5
Found=0
Do Until Found = 1
CCount = CCount + 1
If xlSheet.Cells(4,CCount).Value = "" Then
Found=1
End If
Loop

xlSheet.Cells(4,CCount).Value = Date() & " " & Time()
xlSheet.Cells(5,CCount).Value = " Part " & CCount - 4

'Fill In measured data
RCount = 6
For Each Cmd In Cmds
'Eliminate DATDEF's
If Cmd.Type <> 1299 Then
'Do Dimensions
If Cmd.IsDimension Then
If Cmd.Type = DIMENSION_START_LOCATION Or Cmd.Type = DIMENSION_TRUE_START_POSITION Then
Set DcmdID = Cmd.DimensionCommand
DimID = DcmdID.ID
ReportDim = Cmd.GetText ( OUTPUT_TYPE, 0)
End If
If Cmd.Type <> DIMENSION_START_LOCATION And Cmd.Type <> DIMENSION_END_LOCATION And _
Cmd.Type <> DIMENSION_TRUE_START_POSITION And Cmd.Type <> DIMENSION_TRUE_END_POSITION Then
Set DCmd = Cmd.DimensionCommand
CheckDim = Cmd.GetText ( OUTPUT_TYPE, 0)
If CheckDim <> "" Then
ReportDim = CheckDim
End If
If ReportDim = "BOTH" Or ReportDim = "STATS" Then
'Measured Or Deviation With check For True Position
If DCmd.AxisLetter <> "TP" Then
xlSheet.Cells(RCount,CCount).Value = DCmd.Measured
Else
xlSheet.Cells(RCount,CCount).Value = DCmd.Deviation
End If
'Add Min/Max For Profile dimensions
If Cmd.Type = 1118 Or Cmd.Type = 1105 Then
RCount=RCount+1
xlSheet.Cells(RCount,CCount).Value = DCmd.Max
RCount=RCount+1
xlSheet.Cells(RCount,CCount).Value = DCmd.Min
End If
Rcount=Rcount+1
End If
End If
End If
'Do GDT
If Cmd.Type = 184 Then
ReportDim = Cmd.GetText ( OUTPUT_TYPE, 0)
If ReportDim = "BOTH" Or ReportDim = "STATS" Then
xlSheet.Cells(RCount,CCount).Value = Cmd.GetText (ID, 0) & "." & "FCF"
xlSheet.Cells(RCount,CCount).Value = "0"
xlSheet.Cells(RCount,CCount).Value = Cmd.GetText (LINE2_PLUSTOL, 1)
xlSheet.Cells(RCount,CCount).Value = "0"
xlSheet.Cells(RCount,CCount).Value = Cmd.GetText (LINE2_DEV, 1)
RCount=RCount+1
End If
End If
End If
Next Cmd
End If


'Save And Cleanup
Set xlSheet = Nothing
SaveName = DataPath & Part.partname & " " & strVariable & " " & reasonVar & ".xlsm"
If ResFileExists = False Then
xlWorkBook.SaveAs SaveName
Else
xlWorkBook.Save
End If
xlWorkbook.Close
Set xlWorkbook = Nothing
xlWorkbooks.Close
Set xlWorkbooks = Nothing
xlApp.Quit
Set xlApp = Nothing

LabelEnd:

End Sub

Henniger123 over 3 years ago in reply to A-machine-insp

this should be no problem,
give me some time
Cancel
Vote Up 0 Vote Down

Sign in to reply

Cancel
Henniger123 over 3 years ago

hi A-machine-insp

i have modified your basic Script " ExtractGEOv2.txt "

i dont have a Machine free so i couldn't test it

please use reasonable caution
Cancel
Vote Up 0 Vote Down

Sign in to reply

Cancel