Visual Lisp and Menu's.
This tutorial was very kindly written by Stig
Madsen. and is published, here on AfraLisp, with permission.
Before starting on this tutorial, I presume
that you are familiar with AutoCAD menu's and that you have a bit of
experience in modifying menu's or creating your own partial menu's. It
will also make things a lot easier for you if you have a basic
understanding of AutoCAD's macro language.
If not, and you don't understand a word that I am talking about, I suggest
you pop along to this tutorial, Creating
Menu's, which should explain the basics to you.
Note : You can find the VBA version of this
tutorial by clicking here.
O.K. enough chirping from me, over to Stig....
This
code will do the following:
Create
an empty menu file, vbamenu.mns, if it doesn't already exist
Create
a new menugroup called "VbaMenu" if it doesn't already exist
Create
a new pulldown menu in the menugroup "VbaMenu"
Populate
the pulldown menu with items of our own choice
Load
and install the menugroup into AutoCAD
Save
the menufile as "VbaMenu.mns" and compile it to "VbaMenu.mnc"
Following
code has a nested DEFUN in it. This technique is used to avoid
passing around variables to different routines. Everything in the nested
subroutine CreateMenu gets executed if the pulldown menu we are
looking for doesn't exist. Of course, it could be placed within a lengthy PROGN
statement at the end of the test, but this way the code does a much more
obvious branching.
Notice
that our new menufile isn't actually loaded before we make sure that it
isn't already loaded. Because AutoCAD deals with standard Windows issues
when setting up menus, strange things can happen if we force a multiple
load of the same menu.
(defun
C:VBATOOLBARMENU (/ fn acadobj thisdoc menus flag currMenuGroup newMenu
newMenuItem openMacro
)
;; CreateMenu is a nested DEFUN that is
executed if our "VbaMenu"
;; pulldown menu doesn't exist. A test
for the presence of this
;; pulldown menu is done in the main
code
(defun createMenu ()
;; Add a new popUpMenu to currMenuGroup, i.e.
to "VbaMenu"
(setq newMenu (vla-add (vla-get-menus currMenuGroup) "V&BA
Menu"))
;;------------------------------------------------------------------
;; create the first pulldown item,
vbaload
(setq openMacro (strcat (chr 3) (chr 3) (chr 95) "vbaload"
(chr 32)))
(setq newMenuItem
(vla-addMenuItem
newMenu
(1+ (vla-get-count newMenu))
"VBA &Load"
openMacro
)
)
(vla-put-helpString newMenuItem "Load a VBA Application")
;;------------------------------------------------------------------
;; create the second pulldown item,
vbaide
(setq openMacro (strcat (chr 3) (chr 3) (chr 95) "vbaide"
(chr 32)))
(setq newMenuItem
(vla-addMenuItem
newMenu
(1+ (vla-get-count newMenu))
"VBA &Editor"
openMacro
)
)
(vla-put-helpString newMenuItem "Switch to the VBA
Editor")
;;------------------------------------------------------------------
;; create the third pulldown item,
vbarun
(setq openMacro (strcat (chr 3) (chr 3) (chr 95) "vbarun"
(chr 32)))
(setq newMenuItem
(vla-addMenuItem
newMenu
(1+ (vla-get-count newMenu))
"VBA &Macro"
openMacro
)
)
(vla-put-helpString newMenuItem "Run a VBA Macro")
;;------------------------------------------------------------------
;; create the fourth pulldown item,
vbaman
(setq openMacro (strcat (chr 3) (chr 3) (chr 95) "vbaman"
(chr 32)))
(setq newMenuItem
(vla-addMenuItem
newMenu
(1+ (vla-get-count newMenu))
"&VBA Manager"
openMacro
)
)
(vla-put-helpString newMenuItem "Display the VBA
Manager")
;;------------------------------------------------------------------
;; insert a separator after the fourth
menu item
(vla-AddSeparator newMenu 5)
;;------------------------------------------------------------------
;; create a simple menu macro
(setq
openMacro (strcat (chr 3) (chr 3) (chr 95) "zoom" (chr
32) "w" (chr 32))
)
(setq newMenuItem
(vla-addMenuItem
newMenu
(1+ (vla-get-count newMenu))
"&Zoom"
openMacro
)
)
(vla-put-helpString newMenuItem "Zoom Window")
;;------------------------------------------------------------------
;; create a menu item that loads and
runs an AutoLISP routine
(setq openMacro (strcat (chr 3)
(chr 3)
(chr 95)
"(if (not c:ddvpoint) (load \"ddvpoint\")"
(chr
32)
"ddvpoint"
)
)
(setq newMenuItem
(vla-addMenuItem
newMenu
(1+ (vla-get-count newMenu))
"View &Point"
openMacro
)
)
(vla-put-helpString newMenuItem "View Point")
;;------------------------------------------------------------------
;; create a menu item that calls an
Image menu
(setq openMacro (strcat (chr 3)
(chr 3)
(chr 95)
"$I=image_3dobjects $I=*"
)
)
(setq newMenuItem
(vla-addMenuItem
newMenu
(1+ (vla-get-count newMenu))
"&3D Objects"
openMacro
)
)
(vla-put-helpString newMenuItem "3D objects")
;;------------------------------------------------------------------
;; create a menu item with a hyperlink
(setq openMacro (strcat (chr 3)
(chr 3)
(chr 95)
"browser"
(chr 32)
"www.afralisp.com"
(chr 32)
)
)
(setq newMenuItem
(vla-addMenuItem
newMenu
(1+ (vla-get-count newMenu))
"&AfraLisp.com"
openMacro
)
)
(vla-put-helpString newMenuItem "Go visit this awesome place,
or else!")
;;------------------------------------------------------------------
;; insert the pulldown menu into the
menu bar, third from the end
(vla-insertInMenuBar
newMenu
(- (vla-get-count (vla-get-menuBar acadobj)) 2)
)
;; re-compile the VBAMENU menu -
VBAMENU.MNC
(vla-save currMenuGroup acMenuFileCompiled)
;; save it as a MNS file
(vla-save currMenuGroup acMenuFileSource)
)
;; First, check to see if our menu file
"VbaMenu.mns" already
;; exists. If it doesn't then simply
make an empty file that
;; we can later write our menu
definition to
(setq flag nil)
(if (not (findfile "VbaMenu.mns"))
(progn
(setq fn (open "VbaMenu.mns" "w"))
(close fn)
)
)
;; Get hold of the application object - we
will use it to
;; retrieve the menuGroups collection,
which is a child object
;; of the application
(setq acadobj (vlax-get-acad-object))
;; Get the active document - also a child of
the application
(setq thisdoc (vla-get-activeDocument acadobj))
;; Get all menugroups loaded into AutoCAD
(setq menus (vla-get-menuGroups acadobj))
;; Now we could use VLA-ITEM to test if
"VbaMenu" exists among
;; all loaded menugroups with (vla-item
menus "VbaMenu").
;; Instead, as a friendly service, we
want all loaded menus to
;; be printed to the screen and at the
same time we might as well
;; use it to set a flag if "VbaMenu"
is among the loaded menus
(princ "\nLoaded menus: ")
(vlax-for n menus
(if (= (vla-get-name n) "VbaMenu")
(setq flag T)
)
(terpri)
(princ (vla-get-name n))
)
;; If VbaMenu wasn't among the loaded menus
then load it
(if (null flag)
(vla-load menus "VbaMenu.mns")
)
(setq currMenuGroup (vla-item menus "VbaMenu"))
;; If no popUpMenus exist in VbaMenu then go
create one -
;; otherwise exit with grace. In this
example we merely check
;; if the number of popup menus in
"VbaMenu" is greater than 0.
;; A safer way to test for its
presence would be to set up a
;; test for its name, "V&BA
Menu":
;; (vla-item (vla-get-menus
currMenuGroup) "V&BA Menu")
(if (<= (vla-get-count (vla-get-menus currMenuGroup)) 0)
(createMenu)
(princ "\nThe menu is already loaded")
)
(princ)
)
Now navigate your way to VbaMenu.mns and open it. You
should see something like this :
//
// AutoCAD menu file - D:\drawings\VbaMenu.mns
//
***MENUGROUP=VbaMenu
***POP2
ID_mnuVBA Menu [V&BA Menu]
ID_VBA Load [VBA &Load]^C^C_vbaload
ID_VBA Editor [VBA &Editor]^C^C_vbaide
ID_VBA Macro [VBA &Macro]^C^C_vbarun
ID_VBA Manager [&VBA Manager]^C^C_vbaman
[--]
ID_Zoom [&Zoom]^C^C_zoom w
ID_View Point [View &Point]^C^C_(if (not c:ddvpoint) (load "ddvpoint")
ddvpoint
ID_3D Objects [&3D Objects]^C^C_$I=image_3dobjects $I=*
ID_AfraLisp.com [&AfraLisp.com]^C^C_browser www.afralisp.com
***TOOLBARS
***HELPSTRINGS
ID_VIEW POINT [View Point]
ID_AFRALISP.COM [Go visit this awesome place, or else!]
ID_VBA MANAGER [Display the VBA Manager]
ID_VBA LOAD [Load a VBA Application]
ID_ZOOM [Zoom Window]
ID_VBA MACRO [Run a VBA Macro]
ID_3D OBJECTS [3D objects]
ID_VBA EDITOR [Switch to the VBA Editor]
//
// End of AutoCAD menu file - D:\drawings\Vbamenu.mns
//
You should also find VbaMenu.mnc and VbaMenu.mnr in the same folder.
Even though the VbaMenu.mns didn't exist when we started, Visual Lisp has
created it as well as all the coding necessary and compiled the other menu
support files required for the menu to run.
On the next page, we'll have a look at creating Toolbar menu's.
|