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?

Parents

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

Reply

Henniger123 over 4 years ago

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

Children

No Data