Sub Example_GetCustomScale()
    ' Этот пример обратится к коллекции Layouts для текущего рисунка и
    ' перечислит основную информацию о выбранном масштабе для каждого
    ' Layout.
    ' Затем изменит выбранную информацию масштаба для пространства
    ' модели и восстановит изображение информации масштаба.

    Dim Layouts As AcadLayouts, Layout As ACADLayout
    Dim msg As String
    Dim Numerator As Double, Denominator As Double
    Dim Measurement As String
    
    ' Покажите текущий масштаб
    GoSub DISPLAY_SCALE_INFO
    
    ' Измените масштаб
    Numerator = 1
    Denominator = 1
    
    ThisDrawing.Layouts("Model").SetCustomScale Numerator, Denominator
    ThisDrawing.Regen acAllViewports
            
    ' Покажите новый масштаб
    GoSub DISPLAY_SCALE_INFO
        
    Exit Sub
    
DISPLAY_SCALE_INFO:
    ' Получите коллекцию листов от объекта документа
    Set Layouts = ThisDrawing.Layouts
    
    msg = vbCrLf & vbCrLf   ' Начало с пространством
    
    ' Получите масштаб каждого листа в этом рисунке
    For Each Layout In Layouts
        msg = msg & Layout.name & vbCrLf
        
        ' Получите информацию масштаба
        Layout.GetCustomScale Numerator, Denominator
        
        ' Дюймы или миллиметры
        Measurement = IIf(Layout.PaperUnits = acInches, " inch(es)", " millimeter(s)")
        
        ' Формат для отображения
        msg = msg & vbTab & "Содержит " & Numerator & Measurement & vbCrLf
        msg = msg & vbTab & "Содержит " & Denominator & " drawing units" & vbCrLf
        msg = msg & "_____________________" & vbCrLf
        
    Next
    
    ' Покажите выбранный масштаб
    MsgBox "Выбранная информация масштаба для текущего рисунка: " & msg
    
    Return
End Sub

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