Sub Example_GetBitmaps()
    ' Этот пример использует MenuGroups, чтобы получить справочник к главному меню AutoCADа.
    ' Затем создает новую Панель инструментов (TestMenu) и вставляет ToolBarButton
    ' с выбранным значком. Меню автоматически показывают.
    '
    ' * ПРИМЕЧАНИЕ: пути значков для новой панели инструментов должны
    ' быть модифицированы перед выполнением этого примера.
        
    Dim currMenuGroup As acadMenuGroup
    Dim newToolBar As AcadToolbar, newToolBarButton As AcadToolbarItem
    Dim openMacro As String
    Dim SmallBitmapName  As String, LargeBitmapName  As String
    
    On Error GoTo ERRORTRAP
    
    ' Используйте свойство MenuGroups, чтобы получить справочник к основному меню AutoCAD
    Set currMenuGroup = ThisDrawing.Application.MenuGroups.Item("ACAD")
    
    ' Создайте новую Панель инструментов в этой группе
    Set newToolBar = currMenuGroup.Toolbars.Add("TestMenu")
    
    ' Добавьте элемент к новой Панели инструментов и назначите макрокоманду Open
    ' (VBA эквивалент: "ESC ESC _open ")
    openMacro = Chr(3) & Chr(3) & Chr(95) & "open" & Chr(32)
    Set newToolBarButton = newToolBar.AddToolbarButton(newToolBar.count + 1, "Open", "Open Macro", openMacro, False)
   
    ' Читайте пути значка для этой Кнопки панели
    GoSub READPATHS
    
    ' Измените заданный по умолчанию значок для новой кнопки панели
    SmallBitmapName = "c:\images\16x16.bmp"     ' Используйте 16x16 пиксел .BMP изображение
    LargeBitmapName = "c:\images\32x32.bmp"     ' Используйте 32x32 пиксел .BMP изображение
    newToolBarButton.SetBitmaps SmallBitmapName, LargeBitmapName
    
    ' Читайте пути значка для этой Кнопки панели
    GoSub READPATHS
    
    Exit Sub
    
READPATHS:
    ' Читайте пути значка для этой Кнопки панели
    newToolBarButton.GetBitmaps SmallBitmapName, LargeBitmapName
    MsgBox "Новая Панель инструментов использует следующие файлы значков: " & _
           vbCrLf & vbCrLf & "Маленький Точечный рисунок: " & SmallBitmapName & vbCrLf & _
           "Большой Точечный рисунок: " & LargeBitmapName

    Return

ERRORTRAP:
    MsgBox "Следующая ошибка произошла: " & Err.Description
End Sub

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