AfraLisp Blog

The AutoLisp/Visual Lisp/VBA Resource Website

AfraLisp Blog

Home Newsletter Utter Rubbish Coding Tips AutoCAD Tips Contact Downloads WAUN

Home. Page I.

Visual Lisp and Menu's.

Using Stigs coding as a template, I've written the follow routine that creates a Toolbar menu. Please ensure that the toolbar bitmap files are within your AutoCAD support path before loading and running this application.
Oh, by the way, you can find the VBA version of this application here

(defun C:VBATOOLBARMENU (/ fn acadobj thisdoc menus flag currMenuGroup 
newToolbar newToolbarButton openMacro
SmallBitmapName LargeBitmapName)

(vl-load-com)

;;; CreateToolbar is called if the Toolbar in question doesn't exist
  (defun createToolbar ()
    (setq newToolbar (vla-add (vla-get-toolbars currMenuGroup) "VBA Menu"))
    ;;------------------------------------------------------------------
    ;; create the first Toolbar Button, VbaLoad
    (setq openMacro (strcat (chr 3) (chr 3) (chr 95) "vbaload" (chr 32)))
    (setq newToolbarButton (vla-addToolbarButton
             newToolbar
             (1+ (vla-get-count newToolbar))
             "VBA Load" "VBA Load" openMacro
           )
    )
    (setq SmallBitmapName "VbaLoad.bmp")
    (setq LargeBitmapName "VbaLoad.bmp")    
    (vla-setBitmaps newToolbarButton SmallBitmapName LargeBitmapName)

    (vla-put-helpString newToolbarButton "Load a VBA Application")
    ;;------------------------------------------------------------------
    ;; create the second Toolbar Button, Vbaide
    (setq openMacro (strcat (chr 3) (chr 3) (chr 95) "vbaide" (chr 32)))
    (setq newToolbarButton (vla-addToolbarButton
             newToolbar
             (1+ (vla-get-count newToolbar))
             "VBA Editor" "VBA Editor" openMacro
           )
    )
    (setq SmallBitmapName "Vbaide.bmp")
    (setq LargeBitmapName "Vbaide.bmp")    
    (vla-setBitmaps newToolbarButton SmallBitmapName LargeBitmapName)

    (vla-put-helpString newToolbarButton "Switch to the VBA Editor")
    ;;------------------------------------------------------------------
    ;; create the third Toolbar Button, Vbarun
    (setq openMacro (strcat (chr 3) (chr 3) (chr 95) "vbarun" (chr 32)))
    (setq newToolbarButton (vla-addToolbarButton
             newToolbar
             (1+ (vla-get-count newToolbar))
             "VBA Macro" "VBA Macro" openMacro
           )
    )
    (setq SmallBitmapName "Vbamacro.bmp")
    (setq LargeBitmapName "Vbamacro.bmp")    
    (vla-setBitmaps newToolbarButton SmallBitmapName LargeBitmapName)

    (vla-put-helpString newToolbarButton "Run a VBA Macro")
    ;;------------------------------------------------------------------
    ;; create the fourth Toolbar Button, Vbaman
    (setq openMacro (strcat (chr 3) (chr 3) (chr 95) "vbaman" (chr 32)))
    (setq newToolbarButton (vla-addToolbarButton
             newToolbar
             (1+ (vla-get-count newToolbar))
             "VBA Manager" "VBA Manager" openMacro
           )
    )
    (setq SmallBitmapName "Vbaman.bmp")
    (setq LargeBitmapName "Vbaman.bmp")    
    (vla-setBitmaps newToolbarButton SmallBitmapName LargeBitmapName)

    (vla-put-helpString newToolbarButton "Display the VBA Manager")
    ;;------------------------------------------------------------------

    ;; re-compile the VBATOOLBARMENU menu - VBATOOLBARMENU.MNC
    (vla-save currMenuGroup acMenuFileCompiled)
    ;; save it as a MNS file
    (vla-save currMenuGroup acMenuFileSource)
  )

  (setq flag nil)
  (if (not (findfile "VbaToolbarMenu.mns"))
    (progn
      (setq fn (open "VbaToolbarMenu.mns" "w"))
      (close fn)
    )
  )
  ;; get hold of the application object
  ;; we'll use it to reference the menuGroups collection
  (setq acadobj (vlax-get-acad-object))
  ;; .. and get the active document
  (setq thisdoc (vla-get-activeDocument acadobj))
  ;; get all menu groups loaded into AutoCAD
  (setq menus (vla-get-menuGroups acadobj))
  (princ "\nLoaded menus: ")
  (vlax-for n menus
    (if (= (vla-get-name n) "VbaToolbarMenu")
      (setq flag T)
    )
    (terpri)
    (princ (vla-get-name n))
  )
  ;; if VbaToolbarMenu wasn't among the loaded menus then load it
  (if (null flag)
    (vla-load menus "VbaToolbarMenu.mns")
  )
  (setq currMenuGroup (vla-item menus "VbaToolbarMenu"))
  ;; if no Toolbars exist in VbaToolbarMenu then go create one
  ;; otherwise exit with grace
  (if (<= (vla-get-count (vla-get-menus currMenuGroup)) 0)
    (createToolbar)
    (princ "\nThe Vba Toolbar Menu is already loaded")
  )
  (princ)
)

(princ)
      

Your "VbaToolbarMenu.mns", should look like this :

//
// AutoCAD menu file - D:\drawings\VbaToolbarMenu.mns
//

***MENUGROUP=VbaToolbarMenu

***TOOLBARS
**VBA_MENU
ID_VBA_Menu_0 [_Toolbar("VBA Menu", _Floating, _Show, 168, 152, 1)]
ID_VBA_Load_0 [_Button("VBA Load", "VbaLoad.bmp", "VbaLoad.bmp")]^C^C_vbaload
ID_VBA_Editor_0 [_Button("VBA Editor", "Vbaide.bmp", "Vbaide.bmp")]^C^C_vbaide
ID_VBA_Macro_0 [_Button("VBA Macro", "Vbamacro.bmp", "Vbamacro.bmp")]^C^C_vbarun
ID_VBA_Manager_0 [_Button("VBA Manager", "Vbaman.bmp", "Vbaman.bmp")]^C^C_vbaman


***HELPSTRINGS
ID_VBA_MANAGER_0 [Disply the VBA Manager]
ID_VBA_LOAD_0 [Load a VBA Application]
ID_VBA_MACRO_0 [Run a VBA Macro]
ID_VBA_EDITOR_0 [Switch to the VBA Editor]

//
// End of AutoCAD menu file - D:\drawings\VbaToolbarMenu.mns
//

Your Toolbar should look like this :

If you would like the source coding for both of these menu's, smile nicely at the screen and click here.

Home. Page I.
 
The AutoLisp/Visual Lisp/VBA Resource Website

Copyright © 1999-Perpetuity by AfraLisp

All rights reserved.
Information in this document is subject to change without notice.
Site created and maintained by Kenny Ramage

The AutoLisp/Visual Lisp/VBA Resource Website