I am trying to capture the total number of dimensions in a part program. The problem I am having is with True Position Dimensions. This code will count "x,y,df and tp" instead of just "df and tp". So, this code will count 4 dimensions for each true position dimension instead of 2. Any suggestions?
'This *.bas is a simple, modified version of Craigs modified outtol.bas (whose original author nobody seems To know).
'Jan.
'Modified 9/23/09 DGG to include feature ID in the outtol comment.
'Works with anything up to 2 features, including reference features.
'TP callouts using more than 2 features will not show reference datums
'beyond the first one.
Sub CheckOOT()
Dim PCDApp, PCDPartPrograms, PCDPartProgram, PCDCommands, PCDCommand, PCDDimension
Set PCDApp = CreateObject("PCDLRN.Application")
Set PCDPartPrograms = PCDApp.PartPrograms
Set PCDPartProgram = PCDApp.ActivePartProgram
Set PCDCommands = PCDPartProgram.Commands
Dim cnt As Integer
Dim state As Integer
Dim ID As String
Dim Bad As Integer'String
Dim Total As Integer'String
State = 1 ' Set state To 'Normal'
Bad=0
Total=0
For cnt = 1 To PCDCommands.Count
Set PCDCommand = PCDCommands.Item(cnt)
If PCDCommand.IsDimension Then
Set PCDDimension = PCDCommand.DimensionCommand
Select Case State
Case 1 ' If it is a 'normal' dimension evaluation
ID = PCDDimension.ID
If (PCDCommand.Type = DIMENSION_TRUE_START_POSITION) Then
State = 2 ' If we reached a TP dimension, Set state To 'True Position' (2)
ElseIf (PCDCommand.Type = DIMENSION_START_LOCATION) Then
State = 3 ' If we reached a LOCation dimension, Set state To 'LOCation' (3)
End If
If (State = 1) Then ' If it is a 'normal' dimension And out of tol, Do stuff below
Total = Total + 1
If (Abs(PCDDimension.OutTol) > 0.00005) Then Bad = Bad + 1 'ID & Chr(10) ' Adds the ID To our message
End If
Case 2 ' If it is a TP dimension evaluation And out of tol, Do stuff below
Total = Total + 1
If (Abs(PCDDimension.OutTol) > 0.00005) Then Bad = Bad + 1'ID & Chr(10) ' Adds the ID To our message
Case 3 ' If it is a LOCation dimension evaluation And out of tol, Do stuff below
Total = Total + 1
If (Abs(PCDDimension.OutTol) > 0.00005) Then Bad = Bad + 1'ID & Chr(10) ' Adds the ID To our message
End Select
Set PCDDimension = Nothing ' Reset the PCDDimension Object
ElseIf (PCDCommand.Type = DIMENSION_TRUE_END_POSITION) Then
State = 1 ' Return state To 'Normal' As we have encountered the End of the TP dimension
ElseIf (PCDCommand.Type = DIMENSION_END_LOCATION) Then
State = 1 ' Return state To 'Normal' As we have encountered the End of the LOCation dimension
End If
Set PCDCommand = Nothing ' Reset the PCDCommand Object
Next cnt ' Move To the Next command
MsgBox Total & " Total Dimensions " & CrLf & Bad & " Features Out of Tolerance"' Display the ID's that are out of tolerance
End Sub[/SIZE][/SIZE]
