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

    Dim dimObj As AcadDimAligned
    Dim newText As AcadTextStyle
    Dim point1(0 To 2) As Double, point2(0 To 2) As Double
    Dim location(0 To 2) As Double
    Dim CurrentScale As Integer
    
    'Определите измерение
    point1(0) = 5: point1(1) = 5: point1(2) = 0
    point2(0) = 5.5: 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
    
    ThisDrawing.Application.ZoomAll
    
Increase:
    'Читайте и показывайте текущий масштаб высоты допуска для этого измерения
    If MsgBox("Масштаб высоты допуска в настоящее время: " & dimObj.ToleranceHeightScale & vbCrLf & _
               "Нажмите OK для увеличения или Отменить для выхода", vbOKCancel) = vbCancel Then
        
        Exit Sub
    End If
    
    'Увеличьте масштаб высоты допуска для этого измерения
    dimObj.ToleranceHeightScale = dimObj.ToleranceHeightScale + 1
    
    ThisDrawing.Regen acAllViewports
    
    GoTo Increase
End Sub

Сайт управляется системой uCoz