Sub Example_GetPaperMargins()
    ' Этот пример обратится к коллекции Layouts для текущего рисунка и
    ' перечислит графический размер из свойства GetPaperMargins для
    ' каждого Листа кроме пространства модели.
    Dim Layouts As AcadLayouts, Layout As ACADLayout
    Dim msg As String
    Dim Measurement As String
    Dim MarginLowerLeft As Variant, MarginUpperRight As Variant

    Dim PaperHeight As Double, PaperWidth As Double
    Dim PlotHeight As Double, PlotWidth As Double
    
    ' Получите коллекцию листов от объекта документа
    Set Layouts = ThisDrawing.Layouts
    
    msg = vbCrLf & vbCrLf   ' Start with a space
    
    ' Получите информацию края каждого листа в этом рисунке

    For Each Layout In Layouts
        ' Пространство модели пропустить
        If Layout.name = "Model" Then GoTo NEXT_LAYOUT
        ThisDrawing.ActiveLayout = Layout
        
        msg = msg & Layout.name & vbCrLf
        
        ' Получите информацию края и размер бумаги
        Layout.GetPaperMargins MarginLowerLeft, MarginUpperRight
        Layout.GetPaperSize PaperWidth, PaperHeight
        
        ' Вычислить область печати

        PlotWidth = PaperWidth - (MarginUpperRight(0) - MarginLowerLeft(0))
        PlotHeight = PaperHeight - (MarginUpperRight(1) - MarginLowerLeft(1))
        
        ' Дюймы или миллиметры
        Measurement = " миллиметр(а, ов) "
        
        ' Формат для отображения
        msg = msg & vbTab & "Размер бумаги для этого листа

        msg = msg & vbTab & "Края бумаги: " & vbCrLf & _
                            vbTab & vbTab & "Left" & vbTab & "(" & MarginLowerLeft(0) & ")" & Measurement & vbCrLf & _
                            vbTab & vbTab & "Right" & vbTab & "(" & MarginUpperRight(0) & ")" & Measurement & vbCrLf & _
                            vbTab & vbTab & "Top" & vbTab & "(" & MarginUpperRight(1) & ")" & Measurement & vbCrLf & _
                            vbTab & vbTab & "Bottom" & vbTab & "(" & MarginLowerLeft(1) & ")" & Measurement & vbCrLf & vbCrLf
        msg = msg & vbTab & "Бумажная графическая область для этого листа: " & PlotWidth & " X " & PlotHeight & Measurement & vbCrLf

        msg = msg & "_____________________" & vbCrLf
        
NEXT_LAYOUT:
    Next
    
    ' Размер бумаги отображения и информация края
    MsgBox "Бумажная графическая информация для текущего рисунка: " & msg
End Sub

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