here is the script
Sub Main()
'This *.bas is a simple, modified version of Craigs modified outtol.bas (whose original author nobody seems To know).
'Jan.
'What it does:
'It takes all Dimensions that have an ID that starts With CD (For Critical dimension), regardless whether they are legacy Or XactMeasure.
'Then it will look whether this dimension is out of tolerance Or Not.
' If it is OutTol, it will increase PC-DMIS variable "NUMBEROUTTOL".
' This works also For the second tier of the FCF For the XactMeasure GD&T.
' One known problem: this does Not address the XactMeasure Profile tolerance issue (PC-DMIS does Not evaluate that properly). To correct this
' a lot more code will need To be developed.
' For debug purposes, the results are stored In a file called COMMANDS.TXT.
Dim objApp As Object
Set objApp = CreateObject("PCDLRN.Application")
Dim objPart As Object
Set objPart = objApp.ActivePartProgram
Dim objCmds As Object
Set objCmds = objPart.Commands
Dim objCmd As Object
Dim objDimCmd As Object
Dim dblOutTol As Long
dblOutTol = 0
Dim objOutTol As Object
Set objOutTol = objPart.GetVariableValue("NUMBEROUTTOL") 'number of outtols found
Open "C:\COMMANDS.TXT" For Output As #3
Dim objCmdIDName As String
Dim prevIDName As String
Dim objCmdDeviation As Double
Dim objCmdOuttol As Double
For Each objCmd In objCmds
objCmdIDName=objCmd.ID 'capture the ID Name of the command that is being looked at.
If objCmdIDName="" Then 'Make sure that commands always have a Name.
objCmdIDName=prevIDName
End If
prevIDName= objCmdIDName 'save the old Name just In Case the Next one is ""
'First Step: hunt For all the dimensions that start With CD For Critical Dimension.
'If you find a cmd that starts With CD, Then there are 2 posibilities.
'Second Step: first possibility: hunt For legacy dimensions
If objCmd.IsDimension Then
Set objDimCmd=objCmd.DimensionCommand
If objDimCmd.OutTol<>0 Then
dblOutTol=dblOutTol+1
End If 'objDimCmd.OutTol<>0
Print #3, "***LEGACY***" & objCmdIDName & "***"
Print #3, "OUTTOL number: " & objDimCmd.OutTol
Print #3, "Number out of tolerance: " & dblOutTol
Print #3, ""
End If 'objCmd.IsDimension
'Third Step: second possibility: hunt For XactMeasure GD&T dimensions
If objCmd.Type=184 Then 'this seems To be the way To find an XactMeasure GD&T Call.
If objCmd.gettext(LINE1_OUTTOL,1)<>"" Then 'look In Line 1 For an OUTTOL
If objCmd.gettext(LINE1_OUTTOL,1)<>0 Then 'If there is an OUTTOL In Line 1, is it Not zero?
dblOutTol=dblOutTol+1
End If 'objCmd.gettext(LINE1_OUTTOL,1)<>0
Print #3, "***XactMeasure Line1***" & objCmdIDName & "***"
Print #3, "OUTTOL number: " & objCmd.gettext(LINE1_OUTTOL,1)
Print #3, "Number out of tolerance: " & dblOutTol
Print #3, ""
End If 'objCmd.gettext(LINE1_OUTTOL,1)<>""
If objCmd.gettext(LINE2_OUTTOL,1)<>"" Then 'look In Line 2 For an OUTTOL
If objCmd.gettext(LINE2_OUTTOL,1)<>0 Then 'If there is an OUTTOL In Line 2, is it Not zero?
dblOutTol=dblOutTol+1
End If 'objCmd.gettext(LINE1_OUTTOL,1)<>0
Print #3, "***XactMeasure Line2***" & objCmdIDName & "***"
Print #3, "OUTTOL number: " & objCmd.gettext(LINE2_OUTTOL,1)
Print #3, "Number out of tolerance: " & dblOutTol
Print #3, ""
End If 'objCmd.gettext(LINE2_OUTTOL,1)<>""
If objCmd.gettext(LINE3_OUTTOL,1)<>"" Then 'look In Line 3 For an OUTTOL
If objCmd.gettext(LINE3_OUTTOL,1)<>0 Then 'If there is an OUTTOL In Line 3, is it Not zero?
dblOutTol=dblOutTol+1
End If 'objCmd.gettext(LINE3_OUTTOL,1)<>0
Print #3, "***XactMeasure Line3***" & objCmdIDName & "***"
Print #3, "OUTTOL number: " & objCmd.gettext(LINE3_OUTTOL,1)
Print #3, "Number out of tolerance: " & dblOutTol
Print #3, ""
End If 'objCmd.gettext(LINE3_OUTTOL,1)<>""
End If 'objCmd.Type=184
Next objCmd
Close #3
objOutTol.DoubleValue=dblOutTol
objPart.SetVariableValue "NUMBEROUTTOL",objOutTol
End Sub
here is what it looks like in the command window.
CS1 =SCRIPT/FILENAME= Z:\SCRIPTS\OUTTOL.BAS
FUNCTION/Main,SHOW=YES,,
STARTSCRIPT/
ASSIGN/OUTTOL=NUMBEROUTTOL
IF_GOTO/OUTTOL > 0,GOTO = L2
COMMENT/OPER,NO,FULL SCREEN=YES,AUTO-CONTINUE=NO,
THIS PART IS GOOD
L2 =LABEL/
COMMENT/OPER,NO,FULL SCREEN=YES,AUTO-CONTINUE=NO,
"THERE ARE " +OUTTOL + "DIMENSIONS OUT OF TOLERANCE"
