AltTolerancePrecision Пример

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

    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.AltUnits = True
    dimObj.ToleranceDisplay = acTolLimits
    
    ThisDrawing.Application.ZoomAll

    ' Сохраните старое значение допуска как значение по умолчанию для блока диалога
    oldTolerance = dimObj.AltTolerancePrecision
    
    ' Позвольте пользователю изменять точность для дополнительного допуска измерения
    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.AltTolerancePrecision = newTolerance   ' Передайте изменения точности допуска
    
    ThisDrawing.Regen acAllViewports
    
    ' Показывайте дополнительную точность допуска измерения
    newTolerance = dimObj.AltTolerancePrecision
    MsgBox "Точность допуска была установлена в " & newTolerance & " десятичный(ых) знак(а, ов)"
End Sub
Сайт управляется системой uCoz