Modifying the layers toolbar pulldown

Thanks norrin_radd

I've never taken the plunge into objectarx.
Looks like more work than I have time for.

I currently have a VBA userform with the descriptions in a listbox but it's "bulky" and screen drawing area is a premium.
I have a button on the form that reduces the userform size when not in use so that only the dropdown listbox and a "restore" button is visible.
However, even when reduced in size, the form has a big title bar and can't be docked like a real dropdown toolbar.

Too bad there's no way to make anything from VBA that is dockable.
------
You gave an idea though.
I'm going to play with toolbar button manipulations and see if I can make something workable.

Thanks
Haikle

<I'm going to play with toolbar button manipulations...>

you could use that method in billpowell's post about getting variables from a button to run the select case routine for example
to draw a hvac line on the right layer, hypothetic code ex:

HVAC Piping (Cold) button:

^C^C(setvar "USERI1" 1) -vbarun;acad.dvb!module.routine

module.routine:

Public Sub utilityline()


Dim utility As String
Dim CHANGELAY As AcadLayer
Dim ZERORLAY As AcadLayer
ThisDrawing.ActiveLinetype = ThisDrawing. _
Linetypes.Item("BYLAYER")

On Error Resume Next    ' trap any load errors
    ThisDrawing.Linetypes.Load "*", "linetype file"
       
utility = ThisDrawing.GetVariable("USERI1")


Select Case utility

Case 1
Set CHANGELAY = ThisDrawing.Layers.Add("M-HVAC-RSC")
CHANGELAY.Color = acMagenta
CHANGELAY.Linetype = "hvac"
ThisDrawing.ActiveLayer = CHANGELAY
ThisDrawing.SendCommand ("PL ")

case 2
etc..
****
thats part of some that I use modified to something you might could work with. just to share an idea with you.

note if the layer is already there the .add line doesnt come up with any errors, but it will change the properties of that layer.
I had that zerolay variable in there because I was thinking about setting 0 lay back as current after the routine was ran but never got around to figuring that out.

I've written some simple codes to add a 'Layers' pulldown menu. There are two routines: UpdateLyrsPulldown and UnloadLyrsPulldown. The UpdateLyrsPulldown routine creates a 'Layers' pulldown menu, then reads all the layers in the current drawing and populates the pulldown with the layer names and descriptions. The user can select a layer from the pulldown and that layer is made active. The top two menu items are *Refresh* and *Remove 'Layers' pulldown*. The *Refresh* item refreshes the list of layers. The *Remove 'Layers' pulldown* item does just that; removes the pulldown.

There are several ways to implement this. I chose to provide a button on an existing form. I have the UpdateLyrsPulldown routine assigned to a button on a layers utilities VBA form. You could also arrange to have the codes run upon acad startup.

This is the best alternative I could come up with for the time being.

norrin_radd:
I couldn't get buttons to do what I wanted but your suggestion did make me think of pulldown menus. Thanks.

Public Sub UpdateLyrsPulldown()
Dim currMenuGroup As AcadMenuGroup
Dim mbTS_Layers As AcadMenuBar
Dim LayersMenu As AcadPopupMenu
Dim ct As Integer
Dim i As Integer
Dim x As Integer
Dim strMacro As String
Dim MenuItemName As String
Dim ItemName As String

Set currMenuGroup = ThisDrawing.Application.MenuGroups.Item(0)
On Error GoTo errhandler

'Try to insert a menu item 'Layers'
    Set LayersMenu = ThisDrawing.Application.MenuBar.Item("Layers")
    LayersMenu.InsertInMenuBar (ThisDrawing.Application.MenuBar.count + 1)
   
'Delete all items from the 'Layers' menu
    ct = LayersMenu.count
    For i = ct - 1 To 0 Step -1
        LayersMenu.Item(i).Delete
    Next i

'Add 1st item to 'Layers' menu
LayersMenu.AddMenuItem 0, "*Refresh*", "-vbarun UpdateLyrsPulldown "

'Add 2nd item to 'Layers' menu
LayersMenu.AddMenuItem 1, "*Remove 'Layers' pulldown*", "-vbarun UnloadLyrsPulldown "

'Now add layer descriptions to 'Layers' menu
With ThisDrawing.Layers

    For i = 0 To .count
        ItemName = .Item(i).Name 'Get layer name
        'ignore if name has "|". It is a ref
        If InStr(1, ItemName, "|", vbTextCompare) = 0 Then
            'Format layer name and description
            MenuItemName = "[" & Format(ItemName, ">") & "]  " & .Item(i).Description
            'Define macro string
            strMacro = Chr(3) & Chr(3) & Chr(95) & "-layer s " & ItemName & "  "
            'Add item
            LayersMenu.AddMenuItem i + 2, MenuItemName, strMacro
        End If
    Next i
   
End With

Exit Sub
errhandler:
    If Err.Number = -2145320939 Then   'Layers menu not defined
        Set LayersMenu = currMenuGroup.Menus.Add("Layers")
        Err.Clear
        Resume Next
    ElseIf Err.Number = -2147024809 Then   'Layers menu already inserted
        Err.Clear
        Resume Next
    End If


End Sub

Public Sub UnloadLyrsPulldown()
Dim currMenuGroup As AcadMenuGroup
Dim mbTS_Layers As AcadMenuBar
Dim LayersMenu As AcadPopupMenu

Set currMenuGroup = ThisDrawing.Application.MenuGroups.Item(0)

Set LayersMenu = ThisDrawing.Application.MenuBar.Item("Layers")
LayersMenu.RemoveFromMenuBar


End Sub

haikle,
thats a pretty cool idea, I never even really thought about using layer descriptions before, I'll have to put it on my list of things to look into to.