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

    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.ToleranceDisplay = acTolSymmetrical
    dimObj.ToleranceLowerLimit = -0.0001
    dimObj.ToleranceUpperLimit = 0.005
    
    ThisDrawing.Application.ZoomAll

    'Храните старое значение точности как значение по умолчанию для блока диалога
    oldPrecision = dimObj.PrimaryUnitsPrecision
    
    'Позвольте пользователю изменять точность для допуска измерения и измерения
    newPrecision = InputBox("Введите новую точность для измерения и допусков. Значение должно быть от 0 до 8.", "Change Precision", 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.TolerancePrecision = newPrecision
    dimObj.PrimaryUnitsPrecision = newPrecision
    
    ThisDrawing.Regen acAllViewports
    
    'Читайте и показывайте точность допуска измерения
    newPrecision = dimObj.PrimaryUnitsPrecision
    MsgBox "Точность " & newPrecision & " знаков"
End Sub