Validating dimensions

What program are you using?  I'm also curious why you would want to do that.

In general, your drawing should show the dimensions with tolerances that your manufacturer can actually achieve.  '5.2189743' inches or centimeters is way beyond what anyone can manufacture or in most cases, even measure.  '5.21' inches or centimeters is accuracy that can be achieved.  Although, I would expect '5.2189743' to round up to '5.22'.

This is no program or particular drawing. I need a general tool scan the entire drawing to make sure that the dimensions are the same as what is shown. There are many instances where the cadman draws the dimensions without taking care of object snaps and ends up at such coordinates.

Yes, you are right that the rounding would be 5.22 instead of 5.21. I had casually typed out the numbers in the question.

Good question.  I've seen and understand that problem.  I had one drawing where the drafter had 'drawn' circles without snapping to the center point.  Objects wouldn't close because he had done that.

I don't know of an automated solution for it.  The problem is having a program know what it was supposed to be and that's a difficult question for the machine.  If you can make a list of points and endpoints, you could sort it and look for small unexpected differences.

"If you can make a list of points and endpoints...."

That too and also a way to get the as-displayed value of the dimension.

"also a way to get the as-displayed value of the dimension"

That may be more difficult.  That value won't be in the database because it is created by a display routine operating on the database info.

Please do not respond if you do not have a solution. I need to have my comment as the last comment.

Are you trying to do this within a specific program or from a scanned file (PDF)?

I know that within AutoCAD that is the dimensions are created by using the dimension objects the displayed text will be the measurement. You can also set the level of precision of this dimension to ensure that 5.21 is correctly displayed as 5.21234 or such.

I need a general tool which can pick up those dimensions which display a number different from what is measured. I want to scan the entire drawing so that I can correct all such dimensions so that they are modified to the intended points.

So your dimesnions are not exploded.
Do you want the ones with different numbers to be hilighted to make it easier to find them? I assume that there will be multiple dimensions.

Ok here is my example, it selects all dimension in the drawing and checks each on to see if there is an overriding dimension, if there is, it will highlight the dimension, otherwise it will ignor the dimesion.

If the dimensions are exploded this will NOT work.

Sub FindDimAndFix()
    Dim intCode(0) As Integer
    Dim varData(0) As Variant
    Dim DimTx As AcadDimension
    Set TxtSet = Aset("DimSet")
    intCode(0) = 0: varData(0) = "DIMENSION"
    TxtSet.Select acSelectionSetAll, , , intCode, varData
    For Each DimTx In TxtSet
        If DimTx.TextOverride <> "" Then DimTx.Highlight True
    Next
    TxtSet.Delete
End Sub

Public Function Aset(iSSetName As String) As AcadSelectionSet
    Dim ssetA As AcadSelectionSet
    On Error Resume Next
    Set ssetA = ThisDrawing.SelectionSets.Add(iSSetName)
    If Err.Number <> 0 Then
        Set ssetA = ThisDrawing.SelectionSets(iSSetName)
        ssetA.Delete
        Set ssetA = ThisDrawing.SelectionSets.Add(iSSetName)
        Err.Clear
    End If
    On Error GoTo 0
    Set Aset = ssetA
End Function

If you need more just let me know.

It appears that my question, along with my follow-ups are not good enough to describe my problem (at least that is what the mod feels). I am attaching a sample file to be more specific.

If you take a list of the two dimensions you can see the the difference between the y coordinates of both dimensions. One of them matches the displayed value exactly while the other does not.

Dragontooth, while I was writing I saw a solution from you.
This solution checks whether the dimension has an override or not. This is not what I am looking for. Please see the attached file.

The shorter dimension is good. The longer dimension is not good and needs to be highlighted.

Thanks

Saqib
Validating-dimensions.txt

Ah so after looking at this I see where you want to change the information that is displayed to the actual dimension that is there and not rounded as the dimensions have been setup. This is not what was asked for, you were indicating that the user has entered some dimension, but they haven't. Please correct me if I am incorrect.

There might be something wrong with my language but this is exactly what I had asked in the question.

I want to find the difference between the displayed value and the actual value.

If that value is not zero then I can identify that dimensions as not accurate.

the easiest way i could think of to do this would be to create a VBA macro that takes the measurement value from the dimension object and rounds it up based on the number of digits you want the precision to be and compares the new value to the old value, if they are different then highlight, ie:

precision = 3
value A = 1.54123
value B = roundup A = 1.54200
A does not equal B

i do not know enough about VBA to write the coding for this

Well this one will catch the hand entered overrides, I am also picking the dimensions and changing the precision to 8

ssaqibh, I am sorry I totally missed tha precision part.

Sub FindDimAndFix()
    Dim intCode(0) As Integer
    Dim varData(0) As Variant
    Dim DimTx As AcadDimension
    Dim txtset As AcadSelectionSet
    Set txtset = Aset("DimSet")
    intCode(0) = 0: varData(0) = "DIMENSION"
    txtset.Select acSelectionSetAll, , , intCode, varData
    For Each DimTx In txtset
        If DimTx.TextOverride <> "" Then
            DimTx.Highlight True
        End If
        DimTx.PrimaryUnitsPrecision = acDimPrecisionEight
    Next
    txtset.Delete
End Sub


Public Function Aset(iSSetName As String) As AcadSelectionSet
    Dim ssetA As AcadSelectionSet
    On Error Resume Next
    Set ssetA = ThisDrawing.SelectionSets.Add(iSSetName)
    If Err.Number <> 0 Then
        Set ssetA = ThisDrawing.SelectionSets(iSSetName)
        ssetA.Delete
        Set ssetA = ThisDrawing.SelectionSets.Add(iSSetName)
        Err.Clear
    End If
    On Error GoTo 0
    Set Aset = ssetA
End Function

Well I see silvercorn has a good idea that I flat zoomed by so a revision is in order. :)

This checks the measurement according to the rounded measurement if they are not equal it will adjust the precision to 8

@siverkorn good suggestion thanks

Sub FindDimAndFix()
    Dim intCode(0) As Integer
    Dim varData(0) As Variant
    Dim DimTx As AcadDimension
    Dim txtset As AcadSelectionSet
    Dim mTemp As Double
    Set txtset = Aset("DimSet")
    intCode(0) = 0: varData(0) = "DIMENSION"
    txtset.Select acSelectionSetAll, , , intCode, varData
    For Each DimTx In txtset
        If DimTx.TextOverride <> "" Then
            DimTx.Highlight True
        End If
        mTemp = Round(DimTx.Measurement, 2)
        If DimTx.Measurement > mTemp Then DimTx.PrimaryUnitsPrecision = acDimPrecisionEight
    Next
    txtset.Delete
End Sub

@dragontooth

the only other change that I would recommend would have the user input the level of precision for the check, this way the user can select the level of checking for each file they wish to run this macro

change:
mTemp = Round(DimTx.Measurement, 2)

to:
mTemp = Round(DimTx.Measurement, mTempPre)

@silverkorn

I was thinking about that but I was moving along the lines of :

Sub FindDimAndFix()
    Dim intCode(0) As Integer
    Dim varData(0) As Variant
    Dim DimTx As AcadDimension
    Dim txtset As AcadSelectionSet
    Dim mTemp As Double
    Set txtset = Aset("DimSet")
    intCode(0) = 0: varData(0) = "DIMENSION"
    txtset.Select acSelectionSetAll, , , intCode, varData
    For Each DimTx In txtset
        If DimTx.TextOverride <> "" Then
            DimTx.Highlight True
        End If
        mTemp = Round(DimTx.Measurement, 2)
        If DimTx.Measurement > mTemp Then
            Select Case Len(CStr(DimTx.Measurement)) - Len(CStr(mTemp))
            Case 1
                DimTx.PrimaryUnitsPrecision = acDimPrecisionThree
            Case 2
                DimTx.PrimaryUnitsPrecision = acDimPrecisionFour
            Case 3
                DimTx.PrimaryUnitsPrecision = acDimPrecisionFive
            Case 4
                DimTx.PrimaryUnitsPrecision = acDimPrecisionSix
            Case 5
                DimTx.PrimaryUnitsPrecision = acDimPrecisionSeven
            Case Else
                DimTx.PrimaryUnitsPrecision = acDimPrecisionEight
            End Select
        End If
    Next
    txtset.Delete
End Sub

Here is the one where you are asked how many decimal places you want after the decimal.

HA Since I didn't pay attention the first go round I am going to over kill it.

Sub FindDimAndFix()
    Dim intCode(0) As Integer
    Dim varData(0) As Variant
    Dim DimTx As AcadDimension
    Dim txtset As AcadSelectionSet
    Dim mTemp As Double
    Dim HowManyDecimals As Integer
    HowManyDecimals = InputBox("Please enter the number of decimals after the decimal point.")
    HowManyDecimals = HowManyDecimals - 2
    Set txtset = Aset("DimSet")
    intCode(0) = 0: varData(0) = "DIMENSION"
    txtset.Select acSelectionSetAll, , , intCode, varData
    For Each DimTx In txtset
        If DimTx.TextOverride <> "" Then
            DimTx.Highlight True
        End If
        mTemp = Round(DimTx.Measurement, 2)
        If DimTx.Measurement > mTemp Then
            Select Case HowManyDecimals
            'Select Case Len(CStr(DimTx.Measurement)) - Len(CStr(mTemp))
            Case 1
                DimTx.PrimaryUnitsPrecision = acDimPrecisionThree
            Case 2
                DimTx.PrimaryUnitsPrecision = acDimPrecisionFour
            Case 3
                DimTx.PrimaryUnitsPrecision = acDimPrecisionFive
            Case 4
                DimTx.PrimaryUnitsPrecision = acDimPrecisionSix
            Case 5
                DimTx.PrimaryUnitsPrecision = acDimPrecisionSeven
            Case Else
                DimTx.PrimaryUnitsPrecision = acDimPrecisionEight
            End Select
        End If
    Next
    txtset.Delete
End Sub


Public Function Aset(iSSetName As String) As AcadSelectionSet
    Dim ssetA As AcadSelectionSet
    On Error Resume Next
    Set ssetA = ThisDrawing.SelectionSets.Add(iSSetName)
    If Err.Number <> 0 Then
        Set ssetA = ThisDrawing.SelectionSets(iSSetName)
        ssetA.Delete
        Set ssetA = ThisDrawing.SelectionSets.Add(iSSetName)
        Err.Clear
    End If
    On Error GoTo 0
    Set Aset = ssetA
End Function

There are two things which I need to compare

- The distance which the dimension is spanning
- The value displayed by the dimension

So far I am unable to find out any one of them and unless that is done I would not be able to achieve what I want.

The code provided gives the actual dimension through DimTx.Measurement but it does not tell me what length is being displayed. Unless I know both I cannot compare them.

PS: loads of apologies for the delayed response.

Priorities can change on the next phone call :)

I am kinda fuzzy on the distance the dimension is spanning, can you explain (If I don't get it below)?

What I can do is cycle through each dimension and show you what the actual dimension is (DimTx.Measument), show what the actual text is (in DimTx.PrimaryUnitsPrecision) and let you select what precision you want to apply to that particular one or just accept as it is.

This is what I think you want.

I am sorry, but I have been out of pocket for the last few days and will not be able to update the code until tomorrow. Please let me know if I am getting what you need.

This is a printout of the two dimensions in the sample file

                  DIMENSION  Layer: "0"
                            Space: Model space
                   Handle = 177
associative: no
type: vertical
1st extension  defining point: X= 43.11305  Y= 19.92451  Z=  0.00000
2nd extension  defining point: X= 48.05055  Y= 27.72451  Z=  0.00000
dimension line defining point: X= 45.47735  Y= 27.72451  Z=  0.00000
default text position: X= 45.47735  Y= 23.82451  Z=  0.00000
default text
dimension style: "Standard"
Annotative: No


                  DIMENSION  Layer: "0"
                            Space: Model space
                   Handle = 14a
associative: no
type: vertical
1st extension  defining point: X= 36.57742  Y= 31.17564  Z=  0.00000
2nd extension  defining point: X= 35.83031  Y= 17.42170  Z=  0.00000
dimension line defining point: X= 40.56203  Y= 17.42170  Z=  0.00000
default text position: X= 40.56203  Y= 24.29867  Z=  0.00000
default text
dimension style: "Standard"
Annotative: No

Select allOpen in new window

The dimension for the first line is 27.72451 -  19.92451 = 7.8
and the dimension displayed is 7.8

The dimension for the Second line is 31.17564 - 17.4217 = 13.75394
and the dimension displayed is 13.75

So the first line displays what is measured but the second line does not.
I need to select the second line and all similar dimensions.

mTemp = Round(DimTx.Measurement, 2) '<- this is what is displayed
If DimTx.Measurement > mTemp Then '<- this is where I check to see if the measurement is larger than the "displayed" dimension

Using the DimTx.Measurement keeps me from having to determine which is hor, vert, and aligned dimensions, this would be what I would need to know to find the correct number. So with that said I have captured the information that you require now I can highlite the dimensions that are not right but what do you want to do then? I can make a form where you can look at each dim and decide if you want to fix the dimension to a different number, instead of what the code does now which is I change it to what the measurement is and force it to display correctly.

At long last.....Thanks

Thanks for the points and the grade.

To be honest I am not used to finding the issue and then not doing anything with it. :)