Sub Example_TolerancePrecision()
   'Этот пример создает выровненное измерение в пространстве модели и использует TolerancePrecision, 
   'чтобы позволить пользователю изменять точность допуска измерения

    Dim dimObj As AcadDimAligned
    Dim point1(0 To 2) As Double, point2(0 To 2) As Double
    Dim location(0 To 2) As Double
    Dim oldTolerance As String, newTolerance As String
    
    'Определите измерение
    point1(0) = 0: point1(1) = 5: point1(2) = 0
    point2(0) = 5.12345678: point2(1) = 5: point2(2) = 0
    location(0) = 5: location(1) = 7: location(2) = 0
    
    'Создайте выровненный объект измерения в пространстве модели
    Set dimObj = ThisDrawing.ModelSpace.AddDimAligned(point1, point2, location)
    
    'Включите отображение допуска установки
    dimObj.ToleranceDisplay = acTolSymmetrical
    dimObj.ToleranceLowerLimit = -0.0001
    dimObj.ToleranceUpperLimit = 0.005
    
    ThisDrawing.Application.ZoomAll

    'Храните старое значение допуска как значение по умолчанию для блока диалога
    oldTolerance = dimObj.TolerancePrecision
    
    'Позвольте пользователю изменять точность для допуска измерения
    newTolerance = InputBox("Введите новую точность допуска для измерения. Значение должно быть от 0 до 8.", "Точность Допуска Измерения", oldTolerance)
    
    Select Case newTolerance
        Case 0: newTolerance = acDimPrecisionZero
        Case 1: newTolerance = acDimPrecisionOne
        Case 2: newTolerance = acDimPrecisionTwo
        Case 3: newTolerance = acDimPrecisionThree
        Case 4: newTolerance = acDimPrecisionFour
        Case 5: newTolerance = acDimPrecisionFive
        Case 6: newTolerance = acDimPrecisionSix
        Case 7: newTolerance = acDimPrecisionSeven
        Case 8: newTolerance = acDimPrecisionEight
        Case Else
            MsgBox "Точность допуска не была изменена."
            Exit Sub
    End Select
    
    dimObj.TolerancePrecision = newTolerance   ' Передайте изменению точность допуска
    
    ThisDrawing.Regen acAllViewports
    
    'Читайте и показывайте точность допуска измерения
    newTolerance = dimObj.TolerancePrecision
    MsgBox "Точность допуска " & newTolerance & " десятичных знаков"
End Sub