OpenDCL带菜单修改版
opendcl对LISP编程者来说是一个非常强大的扩展，而最大的遗憾就是不能定制菜单，为了弥补这一遗憾，研究了一段时间OPENDCL的源码，终于完成了动态菜单的加载，但由于本人水平非常有限，对OPENDCL的源码了解不深，现在只能做到菜单的加载，但不能修改，如需修改只能再加载一次才能达到修改效果。; 菜单定义说明
;(dcl_form_loadmenu form list)
;定义右键弹出式菜单
;(dcl_form_loadpoputmenu form list)
;
;参数：
; form: 窗体
; list: 列表，列表里每一个括号里代表一个菜单，除了标志值为16的弹出式菜单可以不用定义回调函数外，
;其它样式菜单必须包含三个参数，第一个为标志值，第二个为显示在菜单上的字符串
;第三个为回调函数字符串，列表可以镶套。
;返回值
; 成功返回T，否则返回NIL
;说明
; 列表支持树状结构，如想改变菜单某项值可以重新加载。
;标志值说明
;MF_POPUP 16 指定该菜单命令有一个关联的弹出式菜单
;MF_CHECKED 8命令旁显示默认复选标志
;MF_UNCHECKED 0清除命令旁的复选标志
;MF_DISABLED 2禁止此菜单命令，但是不变灰显示
;MF_ENABLED 0允许此菜单命令，恢复到正常状态
;MF_GRAYED 1禁止此菜单命令，变灰显示
;MF_MENUBARBREAK32对于静态菜单，放到新行；对于弹出菜单，放到新栏 中，栏间有分隔线
;MF_MENUBREAK 64对于静态菜单，放到新行；对于弹出菜单，放到新栏，栏间无分隔线
;MF_OWNERDRAW 256指定该命令是自画式菜单命令
;MF_SEPARATOR 2048画一条水平分隔线，只用于弹出式菜单
;MF_STRING 0 指定此菜单命令是一个字符串
;显示右键菜单
;(dcl_Form_TrackPopupMenu Form Flags x y)
;
;参数
; Form: DCL窗体
; nFlags: 标志值，确定函数如何放置快捷菜单
; x: 指定相对于屏幕右上角X坐标
; Y: 指定相对于屏幕右上角Y坐标
;标志值说明
;确定函数如何水平放置快捷菜单
;TPM_CENTERALIGN： 4若设置此标志，函数将按参数x指定的坐标水平居中放置快捷菜单
;TPM_LEFTALIGN： 0 若设置此标志，函数使快捷菜单的左边界与由参数X指定的坐标对齐。
;TPM_RIGHTALIGN： 8 若设置此标志，函数使快捷菜单的右边界与由参数X指定的坐标对齐
;确定函数如何垂直放置快捷菜单
;TPM_BOTTOMALIGN： 32 若设置此标志，函数使快捷菜单的下边界与由参数y指定的坐标对齐。
;TPM_TOPALIGN：0 若设置此标志，函数使快捷菜单的上边界与由参数y指定的坐标对齐。
;TPM_VCENTERALIGN； 16 若设置此标志，函数将按参数y指定的坐标垂直居中放置快捷菜单
;用下列标志位之一来确定在快捷菜单跟踪哪一个鼠标键：
;TPM_LEFTBUTTON: 0 若设置此标志，用户只能用鼠标左键选择菜单项。
;TPM_RIGHTBUTTON： 2 若设置此标志，用户能用鼠标左、右键选择菜单项。
(DEFUN C:MenuTest (/)
;;--------加载菜单子函数------------
(defun c:loadmenu (/)
(or new (setq new 0))
(or clo (setq clo 0))
(or window
(setq window '(16 "窗口(&W)" (8 "BOOK1" "C:BOOK1")))
)
(SETQ menulist (list (list 16 "文件(&F)" (list new "新建(&N)" "C:NEW") '(0 "打开(&O)" "c:open") (list clo "关闭(&C)" "C:CCLOSE") '(0 "退出(&X)" "C:CLOSEDCL"))
'( 16 "编辑(&E)" (0 "剪切(&T)" "C:Cut")(0 "复制(&C)" "C:Copy")(0 "粘贴(&P)" "C:Stick"))
window
)
)
(dcl_form_loadmenu Menu_Form1 menulist)
)
(defun c:loadpoputMENU (/)
(SETQ menulist '( (16 "右键菜单" (0 "菜单一" "")(2048 "" "")(2 "菜单二" ""))
(0 "插入(&I)" "c:Insert")
(0 "删除(&D)" "c:Delete")
(0 "剪切(&T)" "C:Cut")
(0 "复制(&C)" "c:Copy")
(0 "粘贴(&P)" "c:Stick")
))
(dcl_form_loadPOPUTmenu Menu_Form1 menulist)
)
(defun C:NEW()
(dcl_messagebox "选择了新建" "")
)
(defun c:open()
(dcl_messagebox "选择了打开" "")
)
(defun c:CCLOSE()
(dcl_messagebox "选择了关闭" "")
)
(defun c:Copy()
(dcl_messagebox "选择了复制" "")
)
(defun c:Delete()
(dcl_messagebox "选择了删除" "")
)
(defun C:Stick()
(dcl_messagebox "选择了粘贴" "")
)
(defun C:CUT()
(dcl_messagebox "选择了剪切" "")
)
(defun c:Insert()
(dcl_messagebox "选择了插入" "")
)
(defun C:CLOSEDCL()
(dcl_Form_Close Menu_Form1 2)
)
(defun c:Menu_Form1_tree_OnRightClick (/)
(setq pt(dcl_GetMouseCoords))
(dcl_Form_TrackPopupMenu Menu_Form1 0 (car pt)(cadr pt))
(GC)
)
;;----------初始化----------------
(defun c:Menu_Form1_OnInitialize (/)
(c:loadmenu)
(c:loadpoputMENU)
)
;;;-----------主程序--------------
(if (not (setq dclfilepath (findfile "Menu.lsp")))
(progn
(dcl_messagebox "找不到DCL文件\r\n请确保DCL文件在CAD搜索路径里" "提示" 2 1 )
(vl-exit-with-error "")
)
)
(dcl_Project_Load dclfilepath)
(setq ref (dcl_Form_Show Menu_Form1))
)
楼主给力，这个ODCL加载后提示是7.0.1，没有最新的7.0.12的源代码吗？ 另外，能不能让在最新的ODCL上也能运行？ XDSoft 发表于 2013-10-20 14:03
楼主给力，这个ODCL加载后提示是7.0.1，没有最新的7.0.12的源代码吗？ 另外，能不能让在最新的ODCL上也能运 ...
没有最新版的源码，OPENDCL一直以来好像都没怎么更新了，更新只是升级了对cad的版本，功能好像都没什么变化，新版的DCL文件应该都是一样的吧，我没测试过。
学习！！！！！！！！！！
學習.................................. 非常给力，赞一个。 花了50豆买了，没有权利下载？楼主怎么回事？ OpenDCL.part01.rar (1000 KB, 下载次数: 3) 这个不能下，别的可以。 duotu007 发表于 2013-11-12 11:42
花了50豆买了，没有权利下载？楼主怎么回事？
需要，可是没豆，楼主传我一个好吗
QQ，307227591 本帖最后由 kcad2010 于 2013-11-30 21:36 编辑
; error: no function definition: DCL_FORM_LOADMENU
; error: no function definition: DCL_FORM_TRACKPOPUPMENU怎么没有这二个函数
kcad2010 发表于 2013-11-30 21:34
; error: no function definition: DCL_FORM_LOADMENU
; error: no function definition: DCL_FORM_TRACKP ...
请确保你是否加载了对应的ARX程序，还有请确定你是否已加载了原版的OPDCL程序？如果已加载请先卸载了再加载我修改的，如果还不成请把你的CAD版本告诉我，我在04、05、08版本下调试过都是可以的。
支持源码，，，，， 50D.................... 感觉高大上啊
页:
[1]
2