Author Topic: Acad Toolbar and Buttons  (Read 4834 times)

0 Members and 1 Guest are viewing this topic.

1219

  • Guest
Acad Toolbar and Buttons
« on: June 09, 2009, 10:52:39 AM »
I am having a problem with a toolbar and buttons that i have created by using a database and VBA.  Every time I exit AutoCad the buttons on this toolbar are missing and the toolbar is turned off but the toolbar can still be found in the toolbar menu.  Basically when Acad closes it deletes the buttons but not the toolbar. So is there anyway to keep this from happening?       
Code: [Select]
Public Function CreateButton(ThisToolBar As AcadToolbar, strSettings As String) As Boolean
Dim ToolbarName As String
'Create new buttons
Dim newButton As AcadToolbarItem
Dim varSettings As Variant
Dim strName As String
Dim strDescription As String
Dim strMacro As String
Dim BitmapName  As String
Dim SmallBitmapName  As String

On Error GoTo Err_Control

 '0 = Name
 '1 = Description
 '2 = Macro
 '3 = Icon
 
 varSettings = Split(strSettings, "|")
 
 'Assign the macro string the VB equivalent of "ESC ESC _open "
 'openMacro = Chr(3) & Chr(3) & Chr(95) & "open" & Chr(32)
 strName = varSettings(0)
 strDescription = varSettings(1)
 strMacro = Chr(3) & Chr(3) & varSettings(2) & Chr(13)
 Set newButton = ThisToolBar.AddToolbarButton("", strName, strDescription, strMacro)
 'Assign Bitmap Image to Button
 SmallBitmapName = varSettings(3)
 newButton.SetBitmaps SmallBitmapName, SmallBitmapName
 'Display the toolbar
 ThisToolBar.Visible = True
     
Exit_Here:
 Exit Function
 
Err_Control:
 Select Case Err.Number
      Case -2147024809
           Resume Exit_Here
      Case Else
           Debug.Print "CreateButton(" & ThisToolBar.Name & "," & strSettings & ")" & vbCrLf & "Error # " & Err.Number, Err.Description
           Resume Exit_Here
 End Select

End Function

Public Function SetToolbar(sName As String) As AcadToolbar
Dim MyToolbar As AcadToolbar
Dim currMenuGroup As AcadMenuGroup
Dim intcnt As Integer
Dim blnFoundTB As Boolean
Dim intNextGroup As Integer

On Error GoTo Err_Control

 For intcnt = 0 To ThisDrawing.Application.MenuGroups.Count - 1
      If ThisDrawing.Application.MenuGroups.Item(intcnt).Name = "ACAD" Then
           Set currMenuGroup = ThisDrawing.Application.MenuGroups.Item(intcnt)
           Exit For
      End If
 Next
 'Create new toolbar
 Set MyToolbar = currMenuGroup.Toolbars.Add(sName)

Exit_Here:
 Set SetToolbar = MyToolbar
 Exit Function
 
 
Err_Control:
 Select Case Err.Number
      Case -2147024809 'Toolbar exist
Retry_Different_MenuGroup:
           Debug.Print currMenuGroup.Name
           For intcnt = 0 To currMenuGroup.Toolbars.Count - 1
                If currMenuGroup.Toolbars.Item(intcnt).Name = sName Then
                    Set MyToolbar = currMenuGroup.Toolbars.Item(sName)
                    blnFoundTB = True
                End If
           Next
           If blnFoundTB = False Then
                If intNextGroup < ThisDrawing.Application.MenuGroups.Count Then
                     'Set currMenuGroup to a different group
                     If ThisDrawing.Application.MenuGroups.Item(intNextGroup).Name <> "ACAD" Then
                          Set currMenuGroup = ThisDrawing.Application.MenuGroups.Item(intNextGroup)
                          intNextGroup = intNextGroup + 1
                          GoTo Retry_Different_MenuGroup
                     Else
                          intNextGroup = intNextGroup + 1
                          Set currMenuGroup = ThisDrawing.Application.MenuGroups.Item(intNextGroup)
                          GoTo Retry_Different_MenuGroup
                     End If
                End If
           End If
           Resume Next
      Case Else
           InputBox Err.Description, "Error", Err.Number
           Resume Exit_Here
 End Select

End Function
« Last Edit: June 09, 2009, 11:40:38 AM by 1219 »

Bob Wahr

  • Guest
Re: Acad Toolbar and Buttons
« Reply #1 on: June 09, 2009, 10:58:08 AM »
Just to clarify, what are you after/  Do you want the toolbar to stay, intact, or the toolbar to go away when the buttons do?

1219

  • Guest
Re: Acad Toolbar and Buttons
« Reply #2 on: June 09, 2009, 11:14:55 AM »
yes i need the toolbar to stay intact with the buttons after acad is reopened

1219

  • Guest
Re: Acad Toolbar and Buttons
« Reply #3 on: June 09, 2009, 04:36:54 PM »
the only problem is that when AutoCad is reopened the buttons are deleted from the toolbar and have to be added again by running the macro to create the toolbar. 

Matt__W

  • Seagull
  • Posts: 12955
  • I like my water diluted.
Re: Acad Toolbar and Buttons
« Reply #4 on: June 09, 2009, 04:58:53 PM »
It doesn't look like you're saving the changes to the menu file.

http://discussion.autodesk.com/forums/thread.jspa?messageID=3555168&#3555168
Autodesk Expert Elite
Revit Subject Matter Expert (SME)
Owner/FAA sUAS Pilot @ http://skyviz.io

1219

  • Guest
Re: Acad Toolbar and Buttons
« Reply #5 on: June 24, 2009, 12:22:02 PM »
Ok! So i have decided to change my approach!  I have created my on .mnu file with the Toolbar and buttons included.  The menu saves just fine and the toolbar does too, but for some reason the buttons are not staying after acad is restarted just like before. 

Code: [Select]
Option Explicit
Private Declare Function GetUserName Lib "advapi32.dll" Alias _
"GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long

Public Function User_Name()
Dim sBuffer As String
Dim lSize As Long
'Get User Name
 sBuffer = Space$(255)
 lSize = Len(sBuffer)

 Call GetUserName(sBuffer, lSize)

 If lSize > 0 Then
      User_Name = Left$(sBuffer, lSize)
 Else
      User_Name = vbNullString
 End If

End Function


'//*** "C:\Documents and Settings\" & Replace(User_Name, Chr(0), "") & "\Application Data\Autodesk\AutoCAD 2004\R16.0\enu\Support\My_NewCustom_Menu.mnu"
Public Function SaveT(sFiletxt As String, sFilePath As String)
On Error Resume Next

Open sFilePath For Output As #1
Print #1, sFiletxt

Close #1

End Function

Public Function CreateMenu() As Boolean

Dim strFiletxt As String
Dim strTBName As String
Dim varSettings As Variant
Dim intcnt As Integer
Dim strRet As String
Dim strMenuPath As String

strTBName = frmCreateTB.TextBox1.Text
 
strFiletxt = "***MENUGROUP=VBAAPPS" & vbCrLf & vbCrLf
strFiletxt = strFiletxt & "***TOOLBARS" & vbCrLf
strFiletxt = strFiletxt & "**" & strTBName & vbCrLf
'& "ID_" & strTBName & "_0" & vbTab
strFiletxt = strFiletxt & "[_Toolbar(""" & strTBName & """, _Top, _Show, 0, 0, 1)]" & vbCrLf
For intcnt = 0 To frmCreateTB.ListBox2.ListCount - 1
    If FindRecord(frmCreateTB.ListBox2.List(intcnt), strRet) = True Then
            'If objToolbar Is Not Nothing Then
                'CreateButton objToolbar, strRet
            'End If
         '0 = Name
         '1 = Description
         '2 = Macro
         '3 = Icon
         varSettings = Split(strRet, "|")
         '& "ID_" & Replace(varSettings(0), " ", "") & "_0" & vbTab
         strFiletxt = strFiletxt & "[_Button(""" & varSettings(0) & """, """ & varSettings(3) & """, """ & varSettings(3) & """)]" & "_" & varSettings(2) & vbCrLf
   End If
Next

strFiletxt = strFiletxt & vbCrLf
strFiletxt = strFiletxt & "***HELPSTRINGS" & vbCrLf

For intcnt = 0 To frmCreateTB.ListBox2.ListCount - 1
    If FindRecord(frmCreateTB.ListBox2.List(intcnt), strRet) = True Then
         varSettings = Split(strRet, "|")
         strFiletxt = strFiletxt & "ID_" & Replace(varSettings(0), " ", "") & "_0" & vbTab & "[" & varSettings(1) & "]" & vbCrLf
    End If
       
Next
strMenuPath = "C:\Documents and Settings\" & Replace(User_Name, Chr(0), "") & "\Application Data\Autodesk\AutoCAD 2004\R16.0\enu\Support\My_NewCustom_Menu.mnu"
SaveT strFiletxt, strMenuPath
   
    If IsMenuLoaded(strMenuPath) = False Then
        MsgBox "Error Loading Menu"
    End If
   

End Function
Public Function IsMenuLoaded(sPath As String) As Boolean
On Error Resume Next

    ThisDrawing.Application.MenuGroups.Load sPath
   
    If Err.Number <> 0 Then
           IsMenuLoaded = True
           Err.Clear
           'ThisDrawing.Application.MenuGroups.Item.MenuFileName
           
    Else
           IsMenuLoaded = True
    End If
   
   
End Function

Matt__W

  • Seagull
  • Posts: 12955
  • I like my water diluted.
Re: Acad Toolbar and Buttons
« Reply #6 on: June 24, 2009, 01:10:28 PM »
...but for some reason the buttons are not staying after acad is restarted...

Toolbars aren't in the current workspace?   :?
Autodesk Expert Elite
Revit Subject Matter Expert (SME)
Owner/FAA sUAS Pilot @ http://skyviz.io

1219

  • Guest
Re: Acad Toolbar and Buttons
« Reply #7 on: June 24, 2009, 02:07:23 PM »
? ??

Matt__W

  • Seagull
  • Posts: 12955
  • I like my water diluted.
Re: Acad Toolbar and Buttons
« Reply #8 on: June 24, 2009, 03:16:25 PM »
What version are you using?
Autodesk Expert Elite
Revit Subject Matter Expert (SME)
Owner/FAA sUAS Pilot @ http://skyviz.io

1219

  • Guest
Re: Acad Toolbar and Buttons
« Reply #9 on: June 24, 2009, 04:32:24 PM »
AutoCAD 2004 vanilla
« Last Edit: June 24, 2009, 05:39:03 PM by 1219 »

Matt__W

  • Seagull
  • Posts: 12955
  • I like my water diluted.
Re: Acad Toolbar and Buttons
« Reply #10 on: June 25, 2009, 08:18:09 AM »
Nevermind... workspaces weren't around back then.
Autodesk Expert Elite
Revit Subject Matter Expert (SME)
Owner/FAA sUAS Pilot @ http://skyviz.io

ChuckHardin

  • Guest
Re: Acad Toolbar and Buttons
« Reply #11 on: March 24, 2011, 08:44:08 AM »
Does anyone know what would fix this?
It has just come back to the top of the pile here.