OpenDCL带菜单修改版

Gdlprfcu · 发表于 2013-10-20 13:32:13

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

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_MENUBARBREAK 32 对于静态菜单，放到新行；对于弹出菜单，放到新栏中，栏间有分隔线
;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))
)

;    菜单定义说明         
;(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_MENUBARBREAK  32  对于静态菜单，放到新行；对于弹出菜单，放到新栏 中，栏间有分隔线   
;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)) 
)

[sell=50]

请点击此处下载

查看状态：需购买或无权限

您的用户组是：游客

文件名称:OpenDCL.part04.rar
下载次数:93 文件大小:423.58 KB
下载权限: 不限以上 [免费赚D豆]

请点击此处下载

查看状态：需购买或无权限

您的用户组是：游客

文件名称:OpenDCL.part03.rar
下载次数:114 文件大小:1000 KB
下载权限: 不限以上 [免费赚D豆]

请点击此处下载

查看状态：需购买或无权限

您的用户组是：游客

文件名称:OpenDCL.part02.rar
下载次数:102 文件大小:1000 KB
下载权限: 不限以上 [免费赚D豆]

请点击此处下载

查看状态：需购买或无权限

您的用户组是：游客

文件名称:OpenDCL.part01.rar
下载次数:46 文件大小:1000 KB
下载权限: 技术员以上 [免费赚D豆]

[/sell]

XDSoft · 发表于 2013-10-20 14:03:46

楼主给力，这个ODCL加载后提示是7.0.1，没有最新的7.0.12的源代码吗？另外，能不能让在最新的ODCL上也能运行？

Gdlprfcu · 发表于 2013-10-20 14:39:49

XDSoft 发表于 2013-10-20 14:03
楼主给力，这个ODCL加载后提示是7.0.1，没有最新的7.0.12的源代码吗？另外，能不能让在最新的ODCL上也能运 ...

没有最新版的源码，OPENDCL一直以来好像都没怎么更新了，更新只是升级了对cad的版本，功能好像都没什么变化，新版的DCL文件应该都是一样的吧，我没测试过。

spp_wall · 发表于 2013-10-20 17:56:37

学习！！！！！！！！！！

A82613035571210 · 发表于 2013-10-21 07:16:46

學習..................................

wxytiger · 发表于 2013-10-21 13:36:41

非常给力，赞一个。

duotu007 · 发表于 2013-11-12 11:42:22

花了50豆买了，没有权利下载？楼主怎么回事？

duotu007 · 发表于 2013-11-12 11:43:36

OpenDCL.part01.rar (1000 KB, 下载次数: 3) 这个不能下，别的可以。

Gdlprfcu · 发表于 2013-11-30 12:05:50

duotu007 发表于 2013-11-12 11:42
花了50豆买了，没有权利下载？楼主怎么回事？

请点击此处下载

查看状态：需购买或无权限

您的用户组是：游客

文件名称:OpenDCL.part01.rar
下载次数:133 文件大小:1000 KB
下载权限: 不限以上 [免费赚D豆]

qyming1996 · 发表于 2013-11-30 19:40:15

需要，可是没豆，楼主传我一个好吗
QQ，307227591

kcad2010 · 发表于 2013-11-30 21:34:02

本帖最后由 kcad2010 于 2013-11-30 21:36 编辑

; error: no function definition: DCL_FORM_LOADMENU
; error: no function definition: DCL_FORM_TRACKPOPUPMENU怎么没有这二个函数

Gdlprfcu · 发表于 2013-12-3 18:22:20

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版本下调试过都是可以的。

qyming1996 · 发表于 2013-12-3 21:42:17

支持源码，，，，，

ld_117 · 发表于 2015-1-21 17:21:20

50D....................

海盗曹 · 发表于 2015-1-23 15:06:03

感觉高大上啊

账号		自动登录	找回密码
密码			立即注册

[分享] OpenDCL带菜单修改版

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

评分

点评

点评