Announcements
Attention for Customers without Multi-Factor Authentication or Single Sign-On - OTP Verification rolls out April 2025. Read all about it here.
37xitp4
447 Views, 4 Replies

Wrong tolerance value in VBA

Hi,

 

I have Issue to get the value of upper & lower tolerance when using "Limit Linear Tolerance"

  1. It show different value of upper/lower tolerance, even if we put same tolerance on different dimension
  2. 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

 



 

Tags (3)