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
Slug, I don't need the xyz basics, i just want to count the total number of dimensions.
Chally, I'm not sure if your solution would work either. I would like locations x,y,z, to be counted as 3,
and True Position x,y,df and tp to be counted as 2. The existing code counts TP as 4, sounds like yours would count it as 1.
Slug, I don't need the xyz basics, i just want to count the total number of dimensions.
Chally, I'm not sure if your solution would work either. I would like locations x,y,z, to be counted as 3,
and True Position x,y,df and tp to be counted as 2. The existing code counts TP as 4, sounds like yours would count it as 1.