- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Wrong tolerance value in VBA
Hi,
I have Issue to get the value of upper & lower tolerance when using "Limit Linear Tolerance"
- It show different value of upper/lower tolerance, even if we put same tolerance on different dimension
- It show wrong value if we put the value of upper/lower tolerance same as the model value.
Public Sub InchInspectionTable()
'SET A REFERENCE TO THE ACTIVATE DRAWING
Dim oDrawDoc As DrawingDocument
Set oDrawDoc = ThisApplication.ActiveDocument
'SET REFERENCE TO THE ACTIVATE SHEET
Dim oSheet As Sheet
Set oSheet = oDrawDoc.ActiveSheet
'REMOVE EXISTING CUSTOM TABLE
If oSheet.CustomTables.Count > 0 Then
oSheet.CustomTables.Item(1).Delete
End If
'CREATE CUSTOM TABLE
Dim CustomTableTitle As String
CustomTableTitle = "INSPECTION DIMENSIONS" 'Set the Table title
Dim oTitles(1 To 4) As String 'set number of column
oTitles(1) = "INSPECTION LABEL" 'Set the table header 1
oTitles(2) = "DESIGNED DIMENSION" 'Set the table header 2
oTitles(3) = "UPPER TOLERANCE" 'Set the table header 3
oTitles(4) = "LOWER TOLERANCE" 'Set the table header 4
Dim InsP As Point2d
Set InsP = ThisApplication.TransientGeometry.CreatePoint2d(15, 15)
oDrawDoc.StylesManager.ActiveStandardStyle.ActiveObjectDefaults.TableStyle.HeadingGap = 0.125
oDrawDoc.StylesManager.ActiveStandardStyle.ActiveObjectDefaults.TableStyle.ColumnValueHorizontalJustification = kAlignTextCenter
Dim oGenDimCount As Integer
oGenDimCount = 0
Dim oDim As DrawingDimension
For Each oDim In oSheet.DrawingDimensions
If oDim.IsInspectionDimension Then
oGenDimCount = oGenDimCount + 1
End If
Next
Debug.Print "Inspection Dims Count = " + CStr(oGenDimCount)
Debug.Print "Drawing Dims Count = " + CStr(oSheet.DrawingDimensions.Count)
Dim oCustomTable As CustomTable
Set oInspDimTable = oSheet.CustomTables.Add(CustomTableTitle, InsP, 4, oGenDimCount, oTitles)
'SET THE VALUE OF THE TABLE
Dim oInspDimShape As InspectionDimensionShapeEnum
Dim oDesignedDimension As Variant
Dim oAngularDesignedDimension As Variant
Dim oInspDimNumber As String
Dim oInspDimRate As String
Dim i As Integer
Dim oCellInspDimNum As Cell
Dim oCellInspDim As Cell
Dim oCellInspUpTol As Cell
Dim oCellInspLowTol As Cell
Dim oColor As Color
Set oColor = ThisApplication.TransientObjects.CreateColor(255, 0, 0)
i = 1
For Each oDim In oSheet.DrawingDimensions
If oDim.IsInspectionDimension And oDim.Type = 117474560 Or oDim.IsInspectionDimension And oDim.Type = 117475072 Or oDim.IsInspectionDimension And oDim.Type = 117475328 Then 'Linier Dimension
oDim.GetInspectionDimensionData oInspDimShape, oInspDimNumber, oInspDimRate
oDesignedDimension = ThisApplication.UnitsOfMeasure.GetStringFromValue(oDim.ModelValue, 11272)
Debug.Print oInspDimNumber
Debug.Print oDesignedDimension
Debug.Print "Tolerance type = " + CStr(oDim.Tolerance.ToleranceType)
Debug.Print "Tolerance Upper = " + CStr(oDim.Tolerance.Upper)
Debug.Print "Tolerance Lower = " + CStr(oDim.Tolerance.Lower)
Debug.Print "Tolerance Precision = " + CStr(oDim.TolerancePrecision)
Debug.Print ""
Set oCellInspDimNum = oInspDimTable.Rows.Item(i).Item("INSPECTION LABEL")
oCellInspDimNum.Value = oInspDimNumber
Set oCellInspDim = oInspDimTable.Rows.Item(i).Item("DESIGNED DIMENSION")
oCellInspDim.Value = oDesignedDimension
Select Case oDim.Tolerance.ToleranceType
Case kDeviationTolerance 'Deviation Tolerance
Set oCellInspUpTol = oInspDimTable.Rows.Item(i).Item("UPPER TOLERANCE")
oCellInspUpTol.Value = oDim.Tolerance.Upper / 2.54
Set oCellInspLowTol = oInspDimTable.Rows.Item(i).Item("LOWER TOLERANCE")
oCellInspLowTol.Value = oDim.Tolerance.Lower / 2.54
Case kLimitLinearTolerance 'Limit Linear Tolerance
Set oCellInspUpTol = oInspDimTable.Rows.Item(i).Item("UPPER TOLERANCE")
oCellInspUpTol.Value = oDim.Tolerance.Upper
Set oCellInspLowTol = oInspDimTable.Rows.Item(i).Item("LOWER TOLERANCE")
oCellInspLowTol.Value = oDim.Tolerance.Lower
End Select
i = i + 1
End If
Next
oInspDimTable.Sort "INSPECTION LABEL", True
Dim oRow As Row
For Each oRow In oInspDimTable.Rows
If oCellInspDimNum.Value <> oInspDimNumber Then
oRow.Delete
End If
Next
End Sub
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
It looks like those values are in centimeters. If you wanted the the value to be exact you would set the tolerance to (1 * 2.54 = 2.54). Its a bit odd because you wouldn't use any values between 0-1 (* 2.54). Youll have to convert it to vba.
Dim oDrawingDoc As DrawingDocument = ThisApplication.ActiveDocument Dim oSheet As Sheet = oDrawingDoc.ActiveSheet Dim oDim As DrawingDimension = oSheet.DrawingDimensions.Item(1) 'MessageBox.Show(oDim.ModelValue) oDim.Tolerance.SetToLimits(ToleranceTypeEnum.kLimitLinearTolerance, 2 * 2.54, -0.4 * 2.54) MessageBox.Show(oDim.Tolerance.Lower / 2.54) 'MessageBox.Show(Round(oDim.Tolerance.Upper, 3)) If oDim.Tolerance.Lower > 0 And oDim.Tolerance.Lower < 2.54 oDim.Tolerance.SetToLimits(ToleranceTypeEnum.kLimitLinearTolerance, oDim.Tolerance.Upper, 1 * 2.54) End If
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Hi Dalton,
The code didn't work on my version (2019).
Even if it have default units in centimeter, it still show wrong value. I had put the deviation of tolerance from model value is 0.01", but it show different decimal value for each dimension
.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Your code with the addition of the unit conversion seems to be working for me.
It could be a style that's replacing the period with a comma for the decimal, see these links (Link1 , Link2 ).
Public Sub Test()
Dim oDrawDoc As DrawingDocument
Set oDrawDoc = ThisApplication.ActiveEditDocument
Dim oUOM As UnitsOfMeasure
Set oUOM = oDrawDoc.UnitsOfMeasure
Dim oSheet As Sheet
Set oSheet = oDrawDoc.ActiveSheet
Dim oDim As DrawingDimension
Dim oInspDimShape As InspectionDimensionShapeEnum
Dim oInspDimNumber As String
Dim oInspDimRate As String
Dim oInspDimTolUpper As Double
Dim oInspDimTolLower As Double
For Each oDim In oSheet.DrawingDimensions
If oDim.IsInspectionDimension Then
oDim.GetInspectionDimensionData oInspDimShape, oInspDimNumber, oInspDimRate
oInspDimTolUpper = oDim.Tolerance.Upper
oInspDimTolLower = oDim.Tolerance.Lower
oInspDimTolUpper = oUOM.ConvertUnits(oDim.Tolerance.Upper, UnitsTypeEnum.kDatabaseLengthUnits, UnitsTypeEnum.kInchLengthUnits)
oInspDimTolLower = oUOM.ConvertUnits(oDim.Tolerance.Lower, UnitsTypeEnum.kDatabaseLengthUnits, UnitsTypeEnum.kInchLengthUnits)
Debug.Print CStr(oInspDimShape)
Debug.Print oInspDimNumber
Debug.Print oInspDimRate
Debug.Print "Tol Type: " + CStr(oDim.Tolerance.ToleranceType)
Debug.Print "Tol Value: " + CStr(oDim.Text.Text)
Debug.Print "Tol Upper: " + CStr(oInspDimTolUpper)
Debug.Print "Tol Lower: " + CStr(oInspDimTolLower)
Debug.Print ""
End If
Next
End Sub
If this helped you, please click LIKE.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
It is odd when the upper tolerance value should be 0 it gives a very small negative value. You could account for this by adding an if statement:
If oCellInspUpTol.Value <= 1 And oCellInspUpTol.Value > -0.00001 Then oCellInspUpTol.Value = 0 End If
I couldn't re-create your problem where it gave a lower value as a value * E -2.
Like @tyler.warner it looks like like a styles problem. The dimension style wont update if you change the styles for the document, you either have to change the dimension with ilogic or delete and remake it.