Sub Example_TabOrder()
    'Этот пример создает два новых Листа, заставляет TabOrder Листов 
    'находиться в алфавитном порядке и показывает список Листов в 
    'порядке, в котором они появляются во вкладках.
    
    Dim Layout1 As ACADLayout, Layout2 As ACADLayout
    Dim SortLayoutRight As ACADLayout, SortLayoutLeft As ACADLayout
    Dim SortIt As New Collection
    Dim TabCount As Long, SortCount As Long, TabOrder As Long
    Dim TabName As String, SortText As String, msg As String
    Dim tempLayout As ACADLayout
    Dim AddedTab As Boolean
        
    'Создайте новые Листы
    On Error Resume Next
    Set Layout1 = ThisDrawing.Layouts.Add("Z VIEW")
    Set Layout2 = ThisDrawing.Layouts.Add("A VIEW")
    On Error GoTo 0
    
    'Расположите в алфавитном порядке внутренне
    For TabCount = 0 To (ThisDrawing.Layouts.count - 1)
        AddedTab = False
        
        TabName = ThisDrawing.Layouts(TabCount).name
        
        If TabName = "Model" Then GoTo SKIP                 ' Пропустите modelspace
        
        If SortIt.count = 0 Then
            SortIt.Add TabName                              ' Добавьте к началу списка
        Else
            For SortCount = 1 To SortIt.count               ' Добавьте к списку строкой
                SortText = SortIt(SortCount)
                If StrComp(TabName, SortText, vbTextCompare) = -1 Then
                    If SortCount = 1 Then
                        SortIt.Add TabName                  ' Добавьте как первый элемент
                    Else
                        SortIt.Add TabName, , SortCount     ' Добавьте как предыдущий элемент
                    End If
                    AddedTab = True
                    Exit For
                End If
            Next
            
            If Not (AddedTab) Then SortIt.Add TabName, , , SortIt.count
        End If
SKIP:
    Next
    
    'Напишите новый порядок вкладки ACAD
    For SortCount = 1 To SortIt.count
        Set tempLayout = ThisDrawing.Layouts(SortIt(SortCount))
        tempLayout.TabOrder = SortCount
    Next
    
    '-------------------------------
    'Читайте и показывайте Новый Порядок Вкладки
    '-------------------------------
    msg = "Порядок вкладки - теперь: " & vbCrLf & vbCrLf
    For TabCount = 0 To (ThisDrawing.Layouts.count - 1)
        TabName = ThisDrawing.Layouts(TabCount).name
        If TabName = "Model" Then GoTo SKIP2                ' Не показывайте modelspace
        TabOrder = ThisDrawing.Layouts(TabCount).TabOrder
        msg = msg & "(" & TabOrder & ")" & vbTab & TabName & vbCrLf
SKIP2:
    Next
    
    MsgBox msg, vbInformation

End Sub

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