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

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

Reply

A-machine-insp over 3 years ago

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

Children

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