请教如何关闭modeless dialog

13808843088 · 发表于 2014-11-13 18:05:34

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

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

×

本帖最后由 13808843088 于 2014-11-14 17:05 编辑

请教各位，我建立了一个modeless dialog，程序的设想是这样的，当OnMouseMovedOff我按下右键、ESC、空格键关闭modeless dialog，程序结束。我的实现过程如下，但是不对，请各位帮忙看下错在哪里，应如何修改，谢谢。还有当modeless dialog在dcl_Form_Show 的时候，鼠标的状态是OnMouseEntered还是OnMouseMovedOff。

;;;by gu_xl http://gyh060707.blog.sohu.com/(defun gxl-AutoLoadODclArx (/ loaded fn v fnn)
(if (not dcl_getversionex)
(VL-CATCH-ALL-APPLY 'vl-cmdf (list "opendcl"))
)
(if (not dcl_getversionex)
(cond
((= "16" (setq v (itoa (atoi (getvar 'acadver)))))
(if
(setq fnn (findfile (setq fn (strcat "opendcl." v ".arx"))))
(setq loaded (arxload fnn "1"))
(setq loaded "2")
)
)
((or (= "17" v) (= "18" v) (= "19" v))
(if (= "x86" (getenv "PROCESSOR_ARCHITECTURE"))
(if (setq fnn
(findfile (setq fn (strcat "opendcl." v ".arx")))
)
(setq loaded (arxload fnn "1"))
(setq loaded "2")
)
(if (setq fnn
(findfile (setq fn (strcat "opendcl." v "x64.arx")))
)
(setq loaded
(arxload fnn
"1"
)
)
(setq loaded "2")
)
)
)
(t (Setq loaded "2"))
)
(setq loaded "3") ;_ 已加载
)
(if (= "1" loaded)
(progn
(princ (strcat fn "加载失败！程序将退出！"))
(exit)
)
(if (= "2" loaded)
(progn
(princ
(strcat "未找到对应的\"" fn "\"文件！程序将退出！")
)
(exit)
)
)
)
loaded
)
;;;by gu_xl http://gyh060707.blog.sohu.com/
(defun gxl-Load_ODCL_Project
(projname reload password alias / bytes rtype Projects)
(cond
((null dcl_project_import)
(princ "需OpenDCL 5.0 以上版本支持.\n")
nil
)
((and
(setq bytes (vl-get-resource projname))
(eq 'str (setq rtype (type bytes)))
(not (eq "" bytes))
)
(if reload
(dcl_project_import bytes password alias)
(if (or
(not (setq Projects (dcl_GetProjects)))
(not (member (strcase (vl-filename-base projname))
(mapcar 'strcase Projects)
)
)
)
(dcl_project_import bytes password alias)
)
)
)
((dcl_project_load (findfile projname) reload alias))
)
)
(defun c:tt (/)
(gxl-AutoLoadODclArx)
(gxl-Load_ODCL_Project "xty_offset.odcl" t nil nil)
(dcl_Form_Show xty_offset_Form1)
(princ)
)
(defun c:xty_offset/Form1#OnInitialize (/ la lst)
(vlax-for la (VLA-GET-LAYERS
(vla-get-ActiveDocument (vlax-get-acad-object))
)
(setq lst (cons (vla-get-name la) lst))
)
(dcl-Control-SetList
xty_offset/Form1/ComboBox1
lst
)
(dcl-Control-SetText
xty_offset/Form1/ComboBox1
(getvar "clayer")
)
(dcl-Control-SetText
xty_offset/Form1/TextBox1
(rtos (getvar "OFFSETDIST") 2 2)
)
)
(defun c:xty_offset/Form1/CheckBox3#OnClicked (Value /)
(if (= Value 1)
(dcl-Control-SetVisible xty_offset/Form1/ComboBox1 t)
(dcl-Control-SetVisible xty_offset/Form1/ComboBox1 nil)
)
)
(defun c:xty_offset/Form1#OnMouseMovedOff (/ code gr1 gr2)
(while
(progn (setq code (grread t 15 2)
gr2 (cadr code)
gr1 (car code)
)
(cond
((or (equal code '(2 27))
(equal code '(2 32))
(equal code '(2 13))
(= gr1 11)
(= gr1 25)
)
(dcl_Form_close xty_offset_Form1)
)
)
)
)
)

;;;by gu_xl <a href=\"http://gyh060707.blog.sohu.com/\" target=\"_blank\">http://gyh060707.blog.sohu.com/</a>(defun gxl-AutoLoadODclArx (/ loaded fn v fnn) 
  (if (not dcl_getversionex) 
    (VL-CATCH-ALL-APPLY 'vl-cmdf (list "opendcl")) 
  ) 
  (if (not dcl_getversionex) 
    (cond 
      ((= "16" (setq v (itoa (atoi (getvar 'acadver))))) 
       (if 
         (setq fnn (findfile (setq fn (strcat "opendcl." v ".arx")))) 
          (setq loaded (arxload fnn "1")) 
          (setq loaded "2") 
       ) 
      ) 
      ((or (= "17" v) (= "18" v) (= "19" v)) 
       (if (= "x86" (getenv "PROCESSOR_ARCHITECTURE")) 
         (if (setq fnn 
                    (findfile (setq fn (strcat "opendcl." v ".arx"))) 
             ) 
           (setq loaded (arxload fnn "1")) 
           (setq loaded "2") 
         ) 
         (if (setq fnn 
                    (findfile (setq fn (strcat "opendcl." v "x64.arx"))) 
             ) 
           (setq loaded 
                  (arxload fnn 
                           "1" 
                  ) 
           ) 
           (setq loaded "2") 
         ) 
       ) 
      ) 
      (t (Setq loaded "2")) 
    ) 
    (setq loaded "3") ;_ 已加载 
  ) 
  (if (= "1" loaded) 
    (progn 
      (princ (strcat fn "加载失败！程序将退出！")) 
      (exit) 
    ) 
    (if        (= "2" loaded) 
      (progn 
        (princ 
          (strcat "未找到对应的\"" fn "\"文件！程序将退出！") 
        ) 
        (exit) 
      ) 
    ) 
  ) 
  loaded 
) 
;;;by gu_xl <a href=\"http://gyh060707.blog.sohu.com/\" target=\"_blank\">http://gyh060707.blog.sohu.com/</a> 
(defun gxl-Load_ODCL_Project 
       (projname reload password alias / bytes rtype Projects) 
  (cond 
    ((null dcl_project_import) 
     (princ "需OpenDCL 5.0 以上版本支持.\n") 
     nil 
    ) 
    ((and 
       (setq bytes (vl-get-resource projname)) 
       (eq 'str (setq rtype (type bytes))) 
       (not (eq "" bytes)) 
     ) 
     (if reload 
       (dcl_project_import bytes password alias) 
       (if (or 
             (not (setq Projects (dcl_GetProjects))) 
             (not (member (strcase (vl-filename-base projname)) 
                          (mapcar 'strcase Projects) 
                  ) 
             ) 
           ) 
         (dcl_project_import bytes password alias) 
       ) 
     ) 
 
    ) 
    ((dcl_project_load (findfile projname) reload alias)) 
  ) 
) 
(defun c:tt (/) 
  (gxl-AutoLoadODclArx) 
  (gxl-Load_ODCL_Project "xty_offset.odcl" t nil nil) 
  (dcl_Form_Show xty_offset_Form1) 
  (princ) 
) 
(defun c:xty_offset/Form1#OnInitialize (/ la lst) 
  (vlax-for la (VLA-GET-LAYERS 
                 (vla-get-ActiveDocument (vlax-get-acad-object)) 
               ) 
    (setq lst (cons (vla-get-name la) lst)) 
  ) 
  (dcl-Control-SetList 
    xty_offset/Form1/ComboBox1 
    lst 
  ) 
  (dcl-Control-SetText 
    xty_offset/Form1/ComboBox1 
    (getvar "clayer") 
  ) 
  (dcl-Control-SetText 
    xty_offset/Form1/TextBox1 
    (rtos (getvar "OFFSETDIST") 2 2) 
  ) 
) 
(defun c:xty_offset/Form1/CheckBox3#OnClicked (Value /) 
  (if (= Value 1) 
    (dcl-Control-SetVisible xty_offset/Form1/ComboBox1 t) 
    (dcl-Control-SetVisible xty_offset/Form1/ComboBox1 nil) 
  ) 
) 
(defun c:xty_offset/Form1#OnMouseMovedOff (/ code gr1 gr2) 
  (while 
    (progn (setq code (grread t 15 2) 
                 gr2 (cadr code) 
                 gr1 (car code) 
           ) 
           (cond 
             ((or (equal code '(2 27)) 
                  (equal code '(2 32)) 
                  (equal code '(2 13)) 
                  (= gr1 11) 
                  (= gr1 25) 
              ) 
              (dcl_Form_close xty_offset_Form1) 
             ) 
           ) 
    ) 
  ) 
)

请点击此处下载

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

您的用户组是：游客

文件名称:xty_offset.odcl
下载次数:4 文件大小:1.04 KB
下载权限: 不限以上 [免费赚D豆]

以下为坛友指导下完成后的有bug版本
在各位的指导下基本完成，但是还是有bug，刚开始执行的时候鼠标非要到窗体上晃一圈，有时候对话框退不出来，命令行提示“无法重复进入 LISP”。哪位大侠有时间帮忙看看，非常感谢！这只是学习opendcl的一个习作，由于英文水平很差，程序结构又是空白，学得比较痛苦，拣拣丢丢反复很多年了，最近有时间又捡了起来，论坛中对各个窗体及控件应用的讲解很少，程序本身提供的范例也只是泛泛的示范了一下窗体及控件的用法，都不是很详细。希望本版块慢慢的热起来，有更多优秀的示例。

请点击此处下载

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

您的用户组是：游客

文件名称:xty_offset.odcl
下载次数:8 文件大小:1.05 KB
下载权限: 不限以上 [免费赚D豆]

请点击此处下载

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

您的用户组是：游客

文件名称:lx2.LSP
下载次数:10 文件大小:3.97 KB
下载权限: 不限以上 [免费赚D豆]

;;;by gu_xl http://gyh060707.blog.sohu.com/
(defun gxl-AutoLoadODclArx (/ loaded fn v fnn)
(if (not dcl_getversionex)
(VL-CATCH-ALL-APPLY 'vl-cmdf (list "opendcl"))
)
(if (not dcl_getversionex)
(cond
((= "16" (setq v (itoa (atoi (getvar 'acadver)))))
(if
(setq fnn (findfile (setq fn (strcat "opendcl." v ".arx"))))
(setq loaded (arxload fnn "1"))
(setq loaded "2")
)
)
((or (= "17" v) (= "18" v) (= "19" v))
(if (= "x86" (getenv "PROCESSOR_ARCHITECTURE"))
(if (setq fnn
(findfile (setq fn (strcat "opendcl." v ".arx")))
)
(setq loaded (arxload fnn "1"))
(setq loaded "2")
)
(if (setq fnn
(findfile (setq fn (strcat "opendcl." v "x64.arx")))
)
(setq loaded
(arxload fnn
"1"
)
)
(setq loaded "2")
)
)
)
(t (Setq loaded "2"))
)
(setq loaded "3") ;_ 已加载
)
(if (= "1" loaded)
(progn
(princ (strcat fn "加载失败！程序将退出！"))
(exit)
)
(if (= "2" loaded)
(progn
(princ
(strcat "未找到对应的"" fn ""文件！程序将退出！")
)
(exit)
)
)
)
loaded
)
;;;by gu_xl http://gyh060707.blog.sohu.com/
(defun gxl-Load_ODCL_Project
(projname reload password alias / bytes rtype Projects)
(cond
((null dcl_project_import)
(princ "需OpenDCL 5.0 以上版本支持.\n")
nil
)
((and
(setq bytes (vl-get-resource projname))
(eq 'str (setq rtype (type bytes)))
(not (eq "" bytes))
)
(if reload
(dcl_project_import bytes password alias)
(if (or
(not (setq Projects (dcl_GetProjects)))
(not (member (strcase (vl-filename-base projname))
(mapcar 'strcase Projects)
)
)
)
(dcl_project_import bytes password alias)
)
)
)
((dcl_project_load (findfile projname) reload alias))
)
)
(defun xty_ssn (ss o / n lst)
(repeat (setq N (sslength ss))
(setq LST (cons (ssname SS (setq N (1- N))) LST))
)
(if o
(mapcar 'vlax-ename->vla-object lst)
lst
)
)
(vl-load-com)
(defun c:tt (/)
(gxl-AutoLoadODclArx)
(gxl-Load_ODCL_Project "xty_offset.odcl" t nil nil)
(dcl_Form_Show xty_offset_Form1)
(princ)
)
(defun c:xty_offset/Form1#OnInitialize (/ la lst)
(vlax-for la (VLA-GET-LAYERS
(vla-get-ActiveDocument (vlax-get-acad-object))
)
(setq lst (cons (vla-get-name la) lst))
)
(dcl-Control-SetList
xty_offset/Form1/ComboBox1
lst
)
(dcl-Control-SetText
xty_offset/Form1/ComboBox1
(getvar "clayer")
)
(dcl-Control-SetText
xty_offset/Form1/TextBox1
(rtos (getvar "OFFSETDIST") 2 2)
)
(princ)
)
(defun c:xty_offset/Form1/CheckBox3#OnClicked (Value /)
(if (= Value 1)
(dcl-Control-SetVisible xty_offset/Form1/ComboBox1 t)
(dcl-Control-SetVisible xty_offset/Form1/ComboBox1 nil)
)
(princ)
)
(defun c:xty_offset/Form1#OnMouseMovedOff (/)
(dcl_sendstring "(rrt)\n")
(princ)
)
(defun rrt (/ ch db de dis lay obj1 obj2 ss)
(if
(while
(setq
ss (ssget '((0 . "line,SPLINE,*POLYLINE,circle,arc,ELLIPSE")))
)
(setq dis (atof (dcl-Control-GetText xty_offset/Form1/TextBox1))
db (dcl-Control-GetValue xty_offset/Form1/CheckBox1)
de (dcl-Control-GetValue xty_offset/Form1/CheckBox2)
ch (dcl-Control-GetValue xty_offset/Form1/CheckBox3)
lay (dcl-Control-Gettext xty_offset/Form1/ComboBox1)
)
(foreach n (xty_ssn ss t)
(setq obj1 (vlax-safearray->list
(vlax-variant-value (vla-offset n dis))
)
obj2 nil
)
(if (= 1 db)
(setq obj2 (vlax-safearray->list
(vlax-variant-value (vla-offset n (- dis)))
)
)
)
(if (= 1 de)
(vla-delete n)
)
(if (= 1 ch)
(mapcar '(lambda (x) (vla-put-layer x lay))
(append obj1 obj2)
)
)
)
)
(dcl_Form_close xty_offset_Form1)
)
(princ)
)

;;;by gu_xl http://gyh060707.blog.sohu.com/ 
(defun gxl-AutoLoadODclArx (/ loaded fn v fnn) 
  (if (not dcl_getversionex) 
    (VL-CATCH-ALL-APPLY 'vl-cmdf (list "opendcl")) 
  ) 
  (if (not dcl_getversionex) 
    (cond 
      ((= "16" (setq v (itoa (atoi (getvar 'acadver))))) 
       (if 
   (setq fnn (findfile (setq fn (strcat "opendcl." v ".arx")))) 
    (setq loaded (arxload fnn "1")) 
    (setq loaded "2") 
       ) 
      ) 
      ((or (= "17" v) (= "18" v) (= "19" v)) 
       (if (= "x86" (getenv "PROCESSOR_ARCHITECTURE")) 
   (if (setq fnn 
        (findfile (setq fn (strcat "opendcl." v ".arx"))) 
       ) 
     (setq loaded (arxload fnn "1")) 
     (setq loaded "2") 
   ) 
   (if (setq fnn 
        (findfile (setq fn (strcat "opendcl." v "x64.arx"))) 
       ) 
     (setq loaded 
      (arxload fnn 
         "1" 
      ) 
     ) 
     (setq loaded "2") 
   ) 
       ) 
      ) 
      (t (Setq loaded "2")) 
    ) 
    (setq loaded "3") ;_ 已加载 
  ) 
  (if (= "1" loaded) 
    (progn 
      (princ (strcat fn "加载失败！程序将退出！")) 
      (exit) 
    ) 
    (if  (= "2" loaded) 
      (progn 
  (princ 
    (strcat "未找到对应的"" fn ""文件！程序将退出！") 
  ) 
  (exit) 
      ) 
    ) 
  ) 
  loaded 
) 
;;;by gu_xl http://gyh060707.blog.sohu.com/ 
(defun gxl-Load_ODCL_Project 
       (projname reload password alias / bytes rtype Projects) 
  (cond 
    ((null dcl_project_import) 
     (princ "需OpenDCL 5.0 以上版本支持.\n") 
     nil 
    ) 
    ((and 
       (setq bytes (vl-get-resource projname)) 
       (eq 'str (setq rtype (type bytes))) 
       (not (eq "" bytes)) 
     ) 
     (if reload 
       (dcl_project_import bytes password alias) 
       (if (or 
       (not (setq Projects (dcl_GetProjects))) 
       (not (member (strcase (vl-filename-base projname)) 
        (mapcar 'strcase Projects) 
      ) 
       ) 
     ) 
   (dcl_project_import bytes password alias) 
       ) 
     ) 
    ) 
    ((dcl_project_load (findfile projname) reload alias)) 
  ) 
) 
(defun xty_ssn (ss o / n lst) 
  (repeat (setq N (sslength ss)) 
    (setq LST (cons (ssname SS (setq N (1- N))) LST)) 
  ) 
  (if o 
    (mapcar 'vlax-ename->vla-object lst) 
    lst 
  ) 
) 
(vl-load-com) 
(defun c:tt (/) 
  (gxl-AutoLoadODclArx) 
  (gxl-Load_ODCL_Project "xty_offset.odcl" t nil nil) 
  (dcl_Form_Show xty_offset_Form1) 
  (princ) 
) 
(defun c:xty_offset/Form1#OnInitialize (/ la lst) 
  (vlax-for la (VLA-GET-LAYERS 
     (vla-get-ActiveDocument (vlax-get-acad-object)) 
         ) 
    (setq lst (cons (vla-get-name la) lst)) 
  ) 
  (dcl-Control-SetList 
    xty_offset/Form1/ComboBox1 
    lst 
  ) 
  (dcl-Control-SetText 
    xty_offset/Form1/ComboBox1 
    (getvar "clayer") 
  ) 
  (dcl-Control-SetText 
    xty_offset/Form1/TextBox1 
    (rtos (getvar "OFFSETDIST") 2 2) 
  ) 
  (princ) 
) 
(defun c:xty_offset/Form1/CheckBox3#OnClicked (Value /) 
  (if (= Value 1) 
    (dcl-Control-SetVisible xty_offset/Form1/ComboBox1 t) 
    (dcl-Control-SetVisible xty_offset/Form1/ComboBox1 nil) 
  ) 
  (princ) 
) 
(defun c:xty_offset/Form1#OnMouseMovedOff (/) 
  (dcl_sendstring "(rrt)\n") 
  (princ) 
) 
(defun rrt (/ ch db de dis lay obj1 obj2 ss) 
  (if 
    (while 
      (setq 
  ss (ssget '((0 . "line,SPLINE,*POLYLINE,circle,arc,ELLIPSE"))) 
      ) 
       (setq dis (atof (dcl-Control-GetText xty_offset/Form1/TextBox1)) 
       db   (dcl-Control-GetValue xty_offset/Form1/CheckBox1) 
       de   (dcl-Control-GetValue xty_offset/Form1/CheckBox2) 
       ch   (dcl-Control-GetValue xty_offset/Form1/CheckBox3) 
       lay (dcl-Control-Gettext xty_offset/Form1/ComboBox1) 
       ) 
       (foreach  n (xty_ssn ss t) 
   (setq obj1 (vlax-safearray->list 
          (vlax-variant-value (vla-offset n dis)) 
        ) 
         obj2 nil 
   ) 
   (if (= 1 db) 
     (setq obj2 (vlax-safearray->list 
      (vlax-variant-value (vla-offset n (- dis))) 
          ) 
     ) 
   ) 
   (if (= 1 de) 
     (vla-delete n) 
   ) 
   (if (= 1 ch) 
     (mapcar '(lambda (x) (vla-put-layer x lay)) 
       (append obj1 obj2) 
     ) 
   ) 
       ) 
    ) 
     (dcl_Form_close xty_offset_Form1) 
  ) 
  (princ) 
)

st788796 · 发表于 2014-11-13 18:29:25

可以定义 Cancel 事件关闭 Modeless（当鼠标在ODCL界面时），鼠标离开后自己随便定义了

form show 以后，一个是保持焦点，这样鼠标是在界面区，另外可以用 dcl_GetMouseCoords 获取鼠标坐标后和界面位置比较判断鼠标在不在

13808843088 · 发表于 2014-11-13 18:36:02

st788796 发表于 2014-11-13 18:29
可以定义 Cancel 事件关闭 Modeless（当鼠标在ODCL界面时），鼠标离开后自己随便定义了

form show 以后 ...

谢谢您的指导，我在鼠标离开时，是通过grread函数返回值判断我键盘鼠标的输入，然后dcl_Form_close，但是关不掉啊

13808843088 · 发表于 2014-11-13 18:51:21

修改了一下，除了ESC不能关闭外，其它能关闭，但是还有个问题，第一次执行的时候，我的鼠标必须到对话框上去晃一下，再将鼠标移出对话框时，才能执行MouseMovedOff，这是为何呢？谢谢

;;;by gu_xl http://gyh060707.blog.sohu.com/
(defun gxl-AutoLoadODclArx (/ loaded fn v fnn)
(if (not dcl_getversionex)
(VL-CATCH-ALL-APPLY 'vl-cmdf (list "opendcl"))
)
(if (not dcl_getversionex)
(cond
((= "16" (setq v (itoa (atoi (getvar 'acadver)))))
(if
(setq fnn (findfile (setq fn (strcat "opendcl." v ".arx"))))
(setq loaded (arxload fnn "1"))
(setq loaded "2")
)
)
((or (= "17" v) (= "18" v) (= "19" v))
(if (= "x86" (getenv "PROCESSOR_ARCHITECTURE"))
(if (setq fnn
(findfile (setq fn (strcat "opendcl." v ".arx")))
)
(setq loaded (arxload fnn "1"))
(setq loaded "2")
)
(if (setq fnn
(findfile (setq fn (strcat "opendcl." v "x64.arx")))
)
(setq loaded
(arxload fnn
"1"
)
)
(setq loaded "2")
)
)
)
(t (Setq loaded "2"))
)
(setq loaded "3") ;_ 已加载
)
(if (= "1" loaded)
(progn
(princ (strcat fn "加载失败！程序将退出！"))
(exit)
)
(if (= "2" loaded)
(progn
(princ
(strcat "未找到对应的"" fn ""文件！程序将退出！")
)
(exit)
)
)
)
loaded
)
;;;by gu_xl http://gyh060707.blog.sohu.com/
(defun gxl-Load_ODCL_Project
(projname reload password alias / bytes rtype Projects)
(cond
((null dcl_project_import)
(princ "需OpenDCL 5.0 以上版本支持.\n")
nil
)
((and
(setq bytes (vl-get-resource projname))
(eq 'str (setq rtype (type bytes)))
(not (eq "" bytes))
)
(if reload
(dcl_project_import bytes password alias)
(if (or
(not (setq Projects (dcl_GetProjects)))
(not (member (strcase (vl-filename-base projname))
(mapcar 'strcase Projects)
)
)
)
(dcl_project_import bytes password alias)
)
)
)
((dcl_project_load (findfile projname) reload alias))
)
)
(defun c:tt (/)
(gxl-AutoLoadODclArx)
(gxl-Load_ODCL_Project "xty_offset.odcl" t nil nil)
(dcl_Form_Show xty_offset_Form1)
(princ)
)
(defun c:xty_offset/Form1#OnInitialize (/ la lst)
(vlax-for la (VLA-GET-LAYERS
(vla-get-ActiveDocument (vlax-get-acad-object))
)
(setq lst (cons (vla-get-name la) lst))
)
(dcl-Control-SetList
xty_offset/Form1/ComboBox1
lst
)
(dcl-Control-SetText
xty_offset/Form1/ComboBox1
(getvar "clayer")
)
(dcl-Control-SetText
xty_offset/Form1/TextBox1
(rtos (getvar "OFFSETDIST") 2 2)
)
)
(defun c:xty_offset/Form1/CheckBox3#OnClicked (Value /)
(if (= Value 1)
(dcl-Control-SetVisible xty_offset/Form1/ComboBox1 t)
(dcl-Control-SetVisible xty_offset/Form1/ComboBox1 nil)
)
)
(defun c:xty_offset/Form1#OnMouseMovedOff (/ code gr1 gr2)
(while
(progn (setq code (grread t 15 2)
gr2 (cadr code)
gr1 (car code)
)
(cond
((or (equal code '(2 27))
(equal code '(2 32))
(equal code '(2 13))
(= gr1 11)
(= gr1 25)
)
(dcl_Form_close xty_offset_Form1)
nil
)
(t)
)
)
)
)

;;;by gu_xl http://gyh060707.blog.sohu.com/ 
(defun gxl-AutoLoadODclArx (/ loaded fn v fnn) 
  (if (not dcl_getversionex) 
    (VL-CATCH-ALL-APPLY 'vl-cmdf (list "opendcl")) 
  ) 
  (if (not dcl_getversionex) 
    (cond 
      ((= "16" (setq v (itoa (atoi (getvar 'acadver))))) 
       (if 
         (setq fnn (findfile (setq fn (strcat "opendcl." v ".arx")))) 
          (setq loaded (arxload fnn "1")) 
          (setq loaded "2") 
       ) 
      ) 
      ((or (= "17" v) (= "18" v) (= "19" v)) 
       (if (= "x86" (getenv "PROCESSOR_ARCHITECTURE")) 
         (if (setq fnn 
                    (findfile (setq fn (strcat "opendcl." v ".arx"))) 
             ) 
           (setq loaded (arxload fnn "1")) 
           (setq loaded "2") 
         ) 
         (if (setq fnn 
                    (findfile (setq fn (strcat "opendcl." v "x64.arx"))) 
             ) 
           (setq loaded 
                  (arxload fnn 
                           "1" 
                  ) 
           ) 
           (setq loaded "2") 
         ) 
       ) 
      ) 
      (t (Setq loaded "2")) 
    ) 
    (setq loaded "3") ;_ 已加载 
  ) 
  (if (= "1" loaded) 
    (progn 
      (princ (strcat fn "加载失败！程序将退出！")) 
      (exit) 
    ) 
    (if        (= "2" loaded) 
      (progn 
        (princ 
          (strcat "未找到对应的"" fn ""文件！程序将退出！") 
        ) 
        (exit) 
      ) 
    ) 
  ) 
  loaded 
) 
;;;by gu_xl http://gyh060707.blog.sohu.com/ 
(defun gxl-Load_ODCL_Project 
       (projname reload password alias / bytes rtype Projects) 
  (cond 
    ((null dcl_project_import) 
     (princ "需OpenDCL 5.0 以上版本支持.\n") 
     nil 
    ) 
    ((and 
       (setq bytes (vl-get-resource projname)) 
       (eq 'str (setq rtype (type bytes))) 
       (not (eq "" bytes)) 
     ) 
     (if reload 
       (dcl_project_import bytes password alias) 
       (if (or 
             (not (setq Projects (dcl_GetProjects))) 
             (not (member (strcase (vl-filename-base projname)) 
                          (mapcar 'strcase Projects) 
                  ) 
             ) 
           ) 
         (dcl_project_import bytes password alias) 
       ) 
     ) 
 
    ) 
    ((dcl_project_load (findfile projname) reload alias)) 
  ) 
) 
(defun c:tt (/) 
  (gxl-AutoLoadODclArx) 
  (gxl-Load_ODCL_Project "xty_offset.odcl" t nil nil) 
  (dcl_Form_Show xty_offset_Form1) 
  (princ) 
) 
(defun c:xty_offset/Form1#OnInitialize (/ la lst) 
  (vlax-for la (VLA-GET-LAYERS 
                 (vla-get-ActiveDocument (vlax-get-acad-object)) 
               ) 
    (setq lst (cons (vla-get-name la) lst)) 
  ) 
  (dcl-Control-SetList 
    xty_offset/Form1/ComboBox1 
    lst 
  ) 
  (dcl-Control-SetText 
    xty_offset/Form1/ComboBox1 
    (getvar "clayer") 
  ) 
  (dcl-Control-SetText 
    xty_offset/Form1/TextBox1 
    (rtos (getvar "OFFSETDIST") 2 2) 
  ) 
) 
(defun c:xty_offset/Form1/CheckBox3#OnClicked (Value /) 
  (if (= Value 1) 
    (dcl-Control-SetVisible xty_offset/Form1/ComboBox1 t) 
    (dcl-Control-SetVisible xty_offset/Form1/ComboBox1 nil) 
  ) 
) 
(defun c:xty_offset/Form1#OnMouseMovedOff (/ code gr1 gr2) 
  (while 
    (progn (setq code (grread t 15 2) 
                 gr2 (cadr code) 
                 gr1 (car code) 
           ) 
           (cond 
             ((or (equal code '(2 27)) 
                  (equal code '(2 32)) 
                  (equal code '(2 13)) 
                  (= gr1 11) 
                  (= gr1 25) 
              ) 
              (dcl_Form_close xty_offset_Form1) 
              nil 
             ) 
             (t) 
           ) 
    ) 
  ) 
)

XDSoft · 发表于 2014-11-13 19:02:21

13808843088 发表于 2014-11-13 18:51
修改了一下，除了ESC不能关闭外，其它能关闭，但是还有个问题，第一次执行的时候，我的鼠标必须到对话框上 ...

在回调函数里面，多记得用 dcl_sendstring 函数去执行你的函数，不要单独去执行你的函数。

13808843088 · 发表于 2014-11-13 19:04:04

XDSoft 发表于 2014-11-13 19:02
在回调函数里面，多记得用 dcl_sendstring 函数去执行你的函数，不要单独去执行你的函数。

谢谢坛主，我试试先，还没概念

XDSoft · 发表于 2014-11-13 19:04:31

也就是说你在回调函数里面尽可能写的简单些，你想做的事都写个函数在外面定义，在回调函数里面用 (dcl_sendstring your_func) 去调用。

13808843088 · 发表于 2014-11-13 19:14:44

XDSoft 发表于 2014-11-13 19:04
也就是说你在回调函数里面尽可能写的简单些，你想做的事都写个函数在外面定义，在回调函数里面用 (dcl_send ...

谢谢坛主，我将代码尾部改为如下所示，命令行返回命令: tt命令:
命令: 未知命令“XTY_OFFSET”。按 F1 查看帮助。

(defun c:xty_offset/Form1#OnMouseMovedOff (/)
(dcl_sendstring "xty_offset\n")
)
(defun xty_offset(/ code gr1 gr2 obj)
(while
(progn (setq code (grread t 15 2)
gr2 (cadr code)
gr1 (car code)
)
(cond
((or (equal code '(2 27))
(equal code '(2 32))
(equal code '(2 13))
(= gr1 11)
(= gr1 25)
)
(dcl_Form_close xty_offset_Form1)
nil
)
((= gr1 5)
(setq obj (vlax-ename->vla-object (car (entsel))))
(vla-offset
obj
(atof(dcl-Control-GetText xty_offset/Form1/TextBox1))
)
)
(t)
)
)
)
)

XDSoft · 发表于 2014-11-13 19:19:56

13808843088 发表于 2014-11-13 19:14
谢谢坛主，我将代码尾部改为如下所示，命令行返回命令: tt命令:
命令: 未知命令“XTY_OFFSET”。按 F1 ...

你自己在命令行执行你的函数要怎么做？

得带括号吧？

dcl_sendstring就是把你要在命令行上执行的字符串发送到命令行去执行，你不给括号那不就是当命令了，没有当然报错了，所以...

XDSoft · 发表于 2014-11-13 19:21:08

13808843088 发表于 2014-11-13 19:14
谢谢坛主，我将代码尾部改为如下所示，命令行返回命令: tt命令:
命令: 未知命令“XTY_OFFSET”。按 F1 ...

另外，回调函数最后最好加上一个 (princ)

13808843088 · 发表于 2014-11-13 19:22:04

XDSoft 发表于 2014-11-13 19:19
你自己在命令行执行你的函数要怎么做？

得带括号吧？

刚刚在论坛上搜索了一下，大概明白了用法，我急躁了，谢谢您的指导，我再潜心研究一下

13808843088 · 发表于 2014-11-13 21:13:00

XDSoft 发表于 2014-11-13 19:21
另外，回调函数最后最好加上一个 (princ)

坛主，解决不了啊，如果您方便能否提供思路一简易示例，非常感谢
非模态对话框，鼠标离开，执行命令，当键盘输入空格、ESC、回车或鼠标右键单击时关闭对话框，退出命令。
我将程序尾部改为如下所示，还是不行，还没有前面不用dcl_sendstring 的效果好。
[code=lisp](defun c:xty_offset/Form1#OnMouseMovedOff (/)
  (dcl_sendstring "(rrt)\n")
  (princ)
)
(defun rrt (/ code gr1 gr2 obj)
  (while
(progn (setq code (grread t 15 2)
gr2  (cadr code)
gr1  (car code)
)
(cond
   ((or (equal code '(2 27))
(equal code '(2 32))
(equal code '(2 13))
(= gr1 11)
(= gr1 25)
   )
   (dcl_Form_close xty_offset_Form1)
   nil
   )
   ((= gr1 5)
   (setq obj (vlax-ename->vla-object (car (entsel))))
   (vla-offset
  obj
  (atof (dcl-Control-GetText xty_offset/Form1/TextBox1))
   )
   )
   (t)
)
)
  )
)[code=lisp]

XDSoft · 发表于 2014-11-13 21:28:19

13808843088 发表于 2014-11-13 21:13
坛主，解决不了啊，如果您方便能否提供思路一简易示例，非常感谢
非模态对话框，鼠标离开，执行命令，当 ...

设计对话框里面，别保持交点。
事件激发那地方改成1，试试。

QQ截图20141113212746.png

13808843088 · 发表于 2014-11-13 22:10:55

XDSoft 发表于 2014-11-13 21:28
设计对话框里面，别保持交点。
事件激发那地方改成1，试试。

不行，grread根本就不返回键盘的输入，但将grread放入回调函数MouseMovedOff又可以有grread的返回值

XDSoft · 发表于 2014-11-13 22:30:04

13808843088 发表于 2014-11-13 22:10
不行，grread根本就不返回键盘的输入，但将grread放入回调函数MouseMovedOff又可以有grread的返回值

你程序想做什么？为什么要用GRREAD？

另外，再贴ODCL代码，把你的ODCL文件也一起传上来，方便看。

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

[求助] 请教如何关闭modeless dialog

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

相关帖子

点评

点评

点评

点评

点评

点评

点评

点评

点评

点评

点评