[教学]：Visual Lisp and Menu's.

eachy

1. 
   
2. <table border="1" cellpadding="0" cellspacing="0" style="border-collapse: collapse" bordercolor="#111111" width="700" id="AutoNumber1" height="498">
   
3.   <tr>
   
4.     <td width="100%" height="489">
   
5.       <iframe name="I1" width="100%" height="100%" src="http://www.afralisp.com/vl/vlmenu1.htm">
   
6. 浏览器不支持嵌入式框架或配置为不显示嵌入式框架
   
7.       </iframe>
   
8.     </td>
   
9.   </tr>
   
10. </table>
    

复制代码

2. 
   
3. (defun C:VBATOOLBARMENU        (/             fn                 acadobj
   
4.                          thisdoc     menus         flag
   
5.                          currMenuGroup                 newMenu
   
6.                          newMenuItem openMacro
   
7.                         )
   
8.   ;; CreateMenu is a nested DEFUN that is executed if our "VbaMenu"
   
9.   ;; pulldown menu doesn't exist. A test for the presence of this
   
10.   ;; pulldown menu is done in the main code
    
11.   (defun createMenu ()
    
12.     ;; Add a new popUpMenu to currMenuGroup, i.e. to "VbaMenu"
    
13.     (setq newMenu (vla-add (vla-get-menus currMenuGroup) "V&BA Menu"))
    
14.     ;;------------------------------------------------------------------
    
15.     ;; create the first pulldown item, vbaload
    
16.     (setq
    
17.       openMacro        (strcat (chr 3) (chr 3) (chr 95) "vbaload" (chr 32))
    
18.     )
    
19.     (setq newMenuItem
    
20.            (vla-addMenuItem
    
21.              newMenu
    
22.              (1+ (vla-get-count newMenu))
    
23.              "VBA &Load"
    
24.              openMacro
    
25.            )
    
26.     )
    
27.     (vla-put-helpString newMenuItem "Load a VBA Application")
    
28.     ;;------------------------------------------------------------------
    
29.     ;; create the second pulldown item, vbaide
    
30.     (setq openMacro (strcat (chr 3) (chr 3) (chr 95) "vbaide" (chr 32)))
    
31.     (setq newMenuItem
    
32.            (vla-addMenuItem
    
33.              newMenu
    
34.              (1+ (vla-get-count newMenu))
    
35.              "VBA &Editor"
    
36.              openMacro
    
37.            )
    
38.     )
    
39.     (vla-put-helpString newMenuItem "Switch to the VBA Editor")
    
40.     ;;------------------------------------------------------------------
    
41.     ;; create the third pulldown item, vbarun
    
42.     (setq openMacro (strcat (chr 3) (chr 3) (chr 95) "vbarun" (chr 32)))
    
43.     (setq newMenuItem
    
44.            (vla-addMenuItem
    
45.              newMenu
    
46.              (1+ (vla-get-count newMenu))
    
47.              "VBA &Macro"
    
48.              openMacro
    
49.            )
    
50.     )
    
51.     (vla-put-helpString newMenuItem "Run a VBA Macro")
    
52.     ;;------------------------------------------------------------------
    
53.     ;; create the fourth pulldown item, vbaman
    
54.     (setq openMacro (strcat (chr 3) (chr 3) (chr 95) "vbaman" (chr 32)))
    
55.     (setq newMenuItem
    
56.            (vla-addMenuItem
    
57.              newMenu
    
58.              (1+ (vla-get-count newMenu))
    
59.              "&VBA Manager"
    
60.              openMacro
    
61.            )
    
62.     )
    
63.     (vla-put-helpString newMenuItem "Display the VBA Manager")
    
64.     ;;------------------------------------------------------------------
    
65.     ;; insert a separator after the fourth menu item
    
66.     (vla-AddSeparator newMenu 5)
    
67.     ;;------------------------------------------------------------------
    
68.     ;; create a simple menu macro
    
69.     (setq
    
70.       openMacro        (strcat        (chr 3)
    
71.                         (chr 3)
    
72.                         (chr 95)
    
73.                         "zoom"
    
74.                         (chr 32)
    
75.                         "w"
    
76.                         (chr 32)
    
77.                 )
    
78. 
    
79.     )
    
80.     (setq newMenuItem
    
81.            (vla-addMenuItem
    
82.              newMenu
    
83.              (1+ (vla-get-count newMenu))
    
84.              "&Zoom"
    
85.              openMacro
    
86.            )
    
87.     )
    
88.     (vla-put-helpString newMenuItem "Zoom Window")
    
89.     ;;------------------------------------------------------------------
    
90.     ;; create a menu item that loads and runs an AutoLISP routine
    
91.     (setq openMacro (strcat (chr 3)
    
92.                             (chr 3)
    
93.                             (chr 95)
    
94.                             "(if (not c:ddvpoint) (load "ddvpoint")"
    
95.                             (chr 32)
    
96.                             "ddvpoint"
    
97.                     )
    
98.     )
    
99.     (setq newMenuItem
    
100.            (vla-addMenuItem
     
101.              newMenu
     
102.              (1+ (vla-get-count newMenu))
     
103.              "View &Point"
     
104.              openMacro
     
105.            )
     
106.     )
     
107.     (vla-put-helpString newMenuItem "View Point")
     
108.     ;;------------------------------------------------------------------
     
109.     ;; create a menu item that calls an Image menu
     
110.     (setq openMacro (strcat (chr 3)
     
111.                             (chr 3)
     
112.                             (chr 95)
     
113.                             "$I=image_3dobjects $I=*"
     
114.                     )
     
115.     )
     
116.     (setq newMenuItem
     
117.            (vla-addMenuItem
     
118.              newMenu
     
119.              (1+ (vla-get-count newMenu))
     
120.              "&3D Objects"
     
121.              openMacro
     
122.            )
     
123.     )
     
124.     (vla-put-helpString newMenuItem "3D objects")
     
125.     ;;------------------------------------------------------------------
     
126.     ;; create a menu item with a hyperlink
     
127.     (setq openMacro (strcat (chr 3)
     
128.                             (chr 3)
     
129.                             (chr 95)
     
130.                             "browser"
     
131.                             (chr 32)
     
132.                             "www.afralisp.com"
     
133.                             (chr 32)
     
134.                     )
     
135.     )
     
136.     (setq newMenuItem
     
137.            (vla-addMenuItem
     
138.              newMenu
     
139.              (1+ (vla-get-count newMenu))
     
140.              "&AfraLisp.com"
     
141.              openMacro
     
142.            )
     
143.     )
     
144.     (vla-put-helpString
     
145.       newMenuItem
     
146.       "Go visit this awesome place, or else!"
     
147.     )
     
148.     ;;------------------------------------------------------------------
     
149.     ;; insert the pulldown menu into the menu bar, third from the end
     
150.     (vla-insertInMenuBar
     
151.       newMenu
     
152.       (- (vla-get-count (vla-get-menuBar acadobj)) 2)
     
153.     )
     
154.     ;; re-compile the VBAMENU menu - VBAMENU.MNC
     
155.     (vla-save currMenuGroup acMenuFileCompiled)
     
156.     ;; save it as a MNS file
     
157.     (vla-save currMenuGroup acMenuFileSource)
     
158.   )
     
159.   ;; First, check to see if our menu file "VbaMenu.mns" already
     
160.   ;; exists. If it doesn't then simply make an empty file that
     
161.   ;; we can later write our menu definition to
     
162.   (setq flag nil)
     
163.   (if (not (findfile "VbaMenu.mns"))
     
164.     (progn
     
165.       (setq fn (open "VbaMenu.mns" "w"))
     
166.       (close fn)
     
167.     )
     
168.   )
     
169.   ;; Get hold of the application object - we will use it to
     
170.   ;; retrieve the menuGroups collection, which is a child object
     
171.   ;; of the application
     
172.   (setq acadobj (vlax-get-acad-object))
     
173.   ;; Get the active document - also a child of the application
     
174.   (setq thisdoc (vla-get-activeDocument acadobj))
     
175.   ;; Get all menugroups loaded into AutoCAD
     
176.   (setq menus (vla-get-menuGroups acadobj))
     
177.   ;; Now we could use VLA-ITEM to test if "VbaMenu" exists among
     
178.   ;; all loaded menugroups with (vla-item menus "VbaMenu").
     
179.   ;; Instead, as a friendly service, we want all loaded menus to
     
180.   ;; be printed to the screen and at the same time we might as well
     
181.   ;; use it to set a flag if "VbaMenu" is among the loaded menus
     
182.   (princ "\nLoaded menus: ")
     
183.   (vlax-for n menus
     
184.     (if        (= (vla-get-name n) "VbaMenu")
     
185.       (setq flag T)
     
186.     )
     
187.     (terpri)
     
188.     (princ (vla-get-name n))
     
189.   )
     
190.   ;; If VbaMenu wasn't among the loaded menus then load it
     
191.   (if (null flag)
     
192.     (vla-load menus "VbaMenu.mns")
     
193.   )
     
194.   (setq currMenuGroup (vla-item menus "VbaMenu"))
     
195.   ;; If no popUpMenus exist in VbaMenu then go create one -
     
196.   ;; otherwise exit with grace. In this example we merely check
     
197.   ;; if the number of popup menus in "VbaMenu" is greater than 0.
     
198.   ;; A safer way to test for its presence would be to set up a
     
199.   ;; test for its name, "V&BA Menu":
     
200.   ;; (vla-item (vla-get-menus currMenuGroup) "V&BA Menu")
     
201.   (if (<= (vla-get-count (vla-get-menus currMenuGroup)) 0)
     
202.     (createMenu)
     
203.     (princ "\nThe menu is already loaded")
     
204.   )
     
205.   (princ)
     
206. )
     
207. 
     

<br /> (defun C:VBATOOLBARMENU        (/             fn                 acadobj<br />                          thisdoc     menus         flag<br />                          currMenuGroup                 newMenu<br />                          newMenuItem openMacro<br />                         )<br />   ;; CreateMenu is a nested DEFUN that is executed if our "VbaMenu" <br />   ;; pulldown menu doesn't exist. A test for the presence of this <br />   ;; pulldown menu is done in the main code <br />   (defun createMenu ()<br />     ;; Add a new popUpMenu to currMenuGroup, i.e. to "VbaMenu" <br />     (setq newMenu (vla-add (vla-get-menus currMenuGroup) "V&BA Menu"))<br />     ;;------------------------------------------------------------------ <br />     ;; create the first pulldown item, vbaload <br />     (setq<br />       openMacro        (strcat (chr 3) (chr 3) (chr 95) "vbaload" (chr 32))<br />     )<br />     (setq newMenuItem<br />            (vla-addMenuItem<br />              newMenu<br />              (1+ (vla-get-count newMenu))<br />              "VBA &Load"<br />              openMacro<br />            )<br />     )<br />     (vla-put-helpString newMenuItem "Load a VBA Application")<br />     ;;------------------------------------------------------------------ <br />     ;; create the second pulldown item, vbaide <br />     (setq openMacro (strcat (chr 3) (chr 3) (chr 95) "vbaide" (chr 32)))<br />     (setq newMenuItem<br />            (vla-addMenuItem<br />              newMenu<br />              (1+ (vla-get-count newMenu))<br />              "VBA &Editor"<br />              openMacro<br />            )<br />     )<br />     (vla-put-helpString newMenuItem "Switch to the VBA Editor")<br />     ;;------------------------------------------------------------------ <br />     ;; create the third pulldown item, vbarun <br />     (setq openMacro (strcat (chr 3) (chr 3) (chr 95) "vbarun" (chr 32)))<br />     (setq newMenuItem<br />            (vla-addMenuItem<br />              newMenu<br />              (1+ (vla-get-count newMenu))<br />              "VBA &Macro"<br />              openMacro<br />            )<br />     )<br />     (vla-put-helpString newMenuItem "Run a VBA Macro")<br />     ;;------------------------------------------------------------------ <br />     ;; create the fourth pulldown item, vbaman <br />     (setq openMacro (strcat (chr 3) (chr 3) (chr 95) "vbaman" (chr 32)))<br />     (setq newMenuItem<br />            (vla-addMenuItem<br />              newMenu<br />              (1+ (vla-get-count newMenu))<br />              "&VBA Manager"<br />              openMacro<br />            )<br />     )<br />     (vla-put-helpString newMenuItem "Display the VBA Manager")<br />     ;;------------------------------------------------------------------ <br />     ;; insert a separator after the fourth menu item <br />     (vla-AddSeparator newMenu 5)<br />     ;;------------------------------------------------------------------ <br />     ;; create a simple menu macro <br />     (setq<br />       openMacro        (strcat        (chr 3)<br />                         (chr 3)<br />                         (chr 95)<br />                         "zoom"<br />                         (chr 32)<br />                         "w"<br />                         (chr 32)<br />                 )<br /> <br />     )<br />     (setq newMenuItem<br />            (vla-addMenuItem<br />              newMenu<br />              (1+ (vla-get-count newMenu))<br />              "&Zoom"<br />              openMacro<br />            )<br />     )<br />     (vla-put-helpString newMenuItem "Zoom Window")<br />     ;;------------------------------------------------------------------ <br />     ;; create a menu item that loads and runs an AutoLISP routine <br />     (setq openMacro (strcat (chr 3)<br />                             (chr 3)<br />                             (chr 95)<br />                             "(if (not c:ddvpoint) (load "ddvpoint")"<br />                             (chr 32)<br />                             "ddvpoint"<br />                     )<br />     )<br />     (setq newMenuItem<br />            (vla-addMenuItem<br />              newMenu<br />              (1+ (vla-get-count newMenu))<br />              "View &Point"<br />              openMacro<br />            )<br />     )<br />     (vla-put-helpString newMenuItem "View Point")<br />     ;;------------------------------------------------------------------ <br />     ;; create a menu item that calls an Image menu <br />     (setq openMacro (strcat (chr 3)<br />                             (chr 3)<br />                             (chr 95)<br />                             "$I=image_3dobjects $I=*"<br />                     )<br />     )<br />     (setq newMenuItem<br />            (vla-addMenuItem<br />              newMenu<br />              (1+ (vla-get-count newMenu))<br />              "&3D Objects"<br />              openMacro<br />            )<br />     )<br />     (vla-put-helpString newMenuItem "3D objects")<br />     ;;------------------------------------------------------------------ <br />     ;; create a menu item with a hyperlink <br />     (setq openMacro (strcat (chr 3)<br />                             (chr 3)<br />                             (chr 95)<br />                             "browser"<br />                             (chr 32)<br />                             "www.afralisp.com"<br />                             (chr 32)<br />                     )<br />     )<br />     (setq newMenuItem<br />            (vla-addMenuItem<br />              newMenu<br />              (1+ (vla-get-count newMenu))<br />              "&AfraLisp.com"<br />              openMacro<br />            )<br />     )<br />     (vla-put-helpString<br />       newMenuItem<br />       "Go visit this awesome place, or else!"<br />     )<br />     ;;------------------------------------------------------------------ <br />     ;; insert the pulldown menu into the menu bar, third from the end <br />     (vla-insertInMenuBar<br />       newMenu<br />       (- (vla-get-count (vla-get-menuBar acadobj)) 2)<br />     )<br />     ;; re-compile the VBAMENU menu - VBAMENU.MNC <br />     (vla-save currMenuGroup acMenuFileCompiled)<br />     ;; save it as a MNS file <br />     (vla-save currMenuGroup acMenuFileSource)<br />   )<br />   ;; First, check to see if our menu file "VbaMenu.mns" already <br />   ;; exists. If it doesn't then simply make an empty file that <br />   ;; we can later write our menu definition to <br />   (setq flag nil)<br />   (if (not (findfile "VbaMenu.mns"))<br />     (progn<br />       (setq fn (open "VbaMenu.mns" "w"))<br />       (close fn)<br />     )<br />   )<br />   ;; Get hold of the application object - we will use it to <br />   ;; retrieve the menuGroups collection, which is a child object <br />   ;; of the application <br />   (setq acadobj (vlax-get-acad-object))<br />   ;; Get the active document - also a child of the application <br />   (setq thisdoc (vla-get-activeDocument acadobj))<br />   ;; Get all menugroups loaded into AutoCAD <br />   (setq menus (vla-get-menuGroups acadobj))<br />   ;; Now we could use VLA-ITEM to test if "VbaMenu" exists among <br />   ;; all loaded menugroups with (vla-item menus "VbaMenu"). <br />   ;; Instead, as a friendly service, we want all loaded menus to <br />   ;; be printed to the screen and at the same time we might as well <br />   ;; use it to set a flag if "VbaMenu" is among the loaded menus <br />   (princ "\nLoaded menus: ")<br />   (vlax-for n menus<br />     (if        (= (vla-get-name n) "VbaMenu")<br />       (setq flag T)<br />     )<br />     (terpri)<br />     (princ (vla-get-name n))<br />   )<br />   ;; If VbaMenu wasn't among the loaded menus then load it <br />   (if (null flag)<br />     (vla-load menus "VbaMenu.mns")<br />   )<br />   (setq currMenuGroup (vla-item menus "VbaMenu"))<br />   ;; If no popUpMenus exist in VbaMenu then go create one - <br />   ;; otherwise exit with grace. In this example we merely check <br />   ;; if the number of popup menus in "VbaMenu" is greater than 0. <br />   ;; A safer way to test for its presence would be to set up a <br />   ;; test for its name, "V&BA Menu": <br />   ;; (vla-item (vla-get-menus currMenuGroup) "V&BA Menu") <br />   (if (<= (vla-get-count (vla-get-menus currMenuGroup)) 0)<br />     (createMenu)<br />     (princ "\nThe menu is already loaded")<br />   )<br />   (princ)<br /> )<br /> <br />