TheSwamp
Code Red => VB(A) => Topic started by: 1219 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?
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
-
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?
-
yes i need the toolbar to stay intact with the buttons after acad is reopened
-
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.
-
It doesn't look like you're saving the changes to the menu file.
http://discussion.autodesk.com/forums/thread.jspa?messageID=3555168�
-
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.
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
-
...but for some reason the buttons are not staying after acad is restarted...
Toolbars aren't in the current workspace? :?
-
? ??
-
What version are you using?
-
AutoCAD 2004 vanilla
-
Nevermind... workspaces weren't around back then.
-
Does anyone know what would fix this?
It has just come back to the top of the pile here.