Code for showing out of tolerance dims.

MRW1971 over 15 years ago

Currently I have a report template that is in landscape layout. I have been asked to add a section to the report showing ONLY the out of tolerance dimensions in text only format. The issue is that in the landscape orientation, listing these labels vertically will waste a great deal of space.

To attempt to make the most use of the space I'm trying to get the labels to go left to right top to bottom in order (i.e. core #1 top left, core #2 top right, core #3 beneath Core #1 label and so on.) I got a chance to talk to some helpful guys from the applications department, who recommended setting 2 text report objects side by side and changing the rules so that one only show even # variables and the other uneven. Right now the rules i have set are:

IF "VariableValue=uneven" THEN USE TEMPLATE "OUT_TOL.lbl" (left side)
IF "VariableValue=even" THEN USE TEMPLATE "OUT_TOL.lbl" (right side)

OUT_TOL is my own custom label. Assuming that that language is correct now I need to create a script that will count the out of tolerance dimensions so they can appear in the correct place on the text report objects. Any suggestions on how to do this?

Jan d. over 15 years ago

Here is how I count OUTTOLS: First, make the label for the DIMS something that can be easily searched. In my case all my dimensions that are critical start with "CD" for critical dimension. It only looks at those and not at others.

Also, be aware that XactMeasure dimensions are handled differently. I kind of blindly felt my way through them in this code, but it seems to work.

Jan.

Sub Main(newdir As String)

'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 dblTotalMeas As Long
dblTotalMeas = 0
Dim objOutTol As Object
Set objOutTol = objPart.GetVariableValue("NUMBEROUTTOL")               'number of outtols found
Dim objTotalMeas As Object
Set objTotalMeas = objPart.GetVariableValue("TOTALMEASURE")           'number of dimensions evaluated

Open newdir & "\DIMENSIONSEVALUATED.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 left(objCmdIDName,2)="CD" Then        '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 And objCmd.Type<>1000 Then
            dblTotalMeas=dblTotalMeas+1
            Set objDimCmd=objCmd.DimensionCommand
            If objDimCmd.OutTol<>0 Then
                dblOutTol=dblOutTol+1
            End If 'objDimCmd.OutTol<>0
            Print #3, "***LEGACY***" & objCmdIDName & "***"
            Print #3, "objCmd.Type: " & objcmd.Type
            Print #3, "OUTTOL number: " & objDimCmd.OutTol
            Print #3, "Number out of tolerance: " & dblOutTol
            Print #3, "Total evaluated: " & dblTotalMeas
            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
                dblTotalMeas=dblTotalMeas+1
                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, "Total evaluated: " & dblTotalMeas
                Print #3, ""
            End If 'objCmd.gettext(LINE1_OUTTOL,1)<>""
           
            If objCmd.gettext(LINE2_OUTTOL,1)<>"" Then   'look In Line 2 For an OUTTOL
                dblTotalMeas=dblTotalMeas+1
                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, "Total evaluated: " & dblTotalMeas
                Print #3, ""
            End If 'objCmd.gettext(LINE2_OUTTOL,1)<>""

            If objCmd.gettext(LINE3_OUTTOL,1)<>"" Then   'look In Line 3 For an OUTTOL
                dblTotalMeas=dblTotalMeas+1
                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, "Total evaluated: " & dblTotalMeas
                Print #3, ""
            End If 'objCmd.gettext(LINE3_OUTTOL,1)<>""


        End If 'objCmd.Type=184

    End If 'left(objCmdIDName,2)="CD"
   
Next objCmd

Close #3

objOutTol.DoubleValue=dblOutTol
objPart.SetVariableValue "NUMBEROUTTOL",objOutTol
objTotalMeas.DoubleValue=dblTotalMeas
objPart.SetVariableValue "TOTALMEASURED",objTotalMeas

End Sub
'Jan