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

    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, " дюйм(ы)", " миллиметр(ы)")
        
        'Формат для отображения
        msg = msg & vbTab & "Содержит " & Numerator & Measurement & vbCrLf
        msg = msg & vbTab & "Содержит " & Denominator & " единиц рисунка" & vbCrLf
        msg = msg & "_____________________" & vbCrLf
        
    Next
    
    'Покажите выбранную информацию масштаба
    MsgBox "Выбранная информация масштаба для текущего рисунка: " & msg
    
    Return
End Sub

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