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
Well, then you would have to add in a fair bit of code....Maybe there is a simpler way, but: if a TP dimension is found to be out, it would then have to backtrack and erase the past entries that were in that dimension. (The ones for X,Y,etc, used in building the TP)
If you can understand the code you're using (which I wrote last year, after 2 or so months learning VB in excel) you should be able to add this in yourself. Just think about it hard enough.
Or wait until I can get to my newest stuff. And maybe it'll be an easier jumping-off point.
Well, then you would have to add in a fair bit of code....Maybe there is a simpler way, but: if a TP dimension is found to be out, it would then have to backtrack and erase the past entries that were in that dimension. (The ones for X,Y,etc, used in building the TP)
If you can understand the code you're using (which I wrote last year, after 2 or so months learning VB in excel) you should be able to add this in yourself. Just think about it hard enough.
Or wait until I can get to my newest stuff. And maybe it'll be an easier jumping-off point.