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

    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 oldPrecision As String, newPrecision 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.AltUnits = True
    
    ThisDrawing.Application.ZoomAll

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