vlisp 能不能实现单字符关键字立刻响应？

不死猫

Lisp 其实还有很多可以扩展的功能:

增强型getpoint函数:保留原有getpoint系统自带捕捉和临时捕捉点修改功能

嵌入即使坐标点返回功能! 超越增强型带有自己写捕捉的grread函数.

xhq1954425

献花一朵对asdfxx的源码表示谢意，本人自学功底太浅，问两个不懂的问题：

1，这个函数怎么调用，按下面的方式不行呀？

(defun C:test( )
(vl-load-com)
(ko->entsel)  
(princ) 
)

2，关健字是在哪儿设定的？

xhq1954425

感谢asdfxx的回复　谢谢！

xhq1954425

请asdfxx再给指点一下，下面这个测试程序当输入X和H时确实立刻响应了，但是并没有执行(alert "等于字符串X你要执行的程序一")，不知是何原因？谢谢！

(defun c:tt()
  (setq xh t)
  (while xh
    (setq ent (ko->entsel "\n测试ko->entsel函数(X)/(H):" "X H" T '((0 . "*LINE,CIRCLE,ARC")) nil))
    (cond ((= ent "X") (alert "等于字符串X你要执行的程序一") ent)
          ((= ent "H") (alert "等于字符串H你要执行的程序二") ent)
          ((= (type ent) 'ENAME) (alert "这个功能是返回图元名") (setq xh nil) ent)
          ((numberp ent) (alert (strcat "此项功能是判断输入的是否是实数或整理,
                                       用于不用进入子选项而直接设置一个值" "\n"
                                       "请选择要拉伸的对象或[当前默认值(500)或直接输入值回车改变默认值]"))
            ent
          )
          ((= ent nil) (setq xh nil))
    )
 )
)

xhq1954425

加载下面程序：

(defun ko->entsel (msg keyword action filter_list errmsg / olderr firstss mode ns entsel-ena gr ga gb pt2 ws asc real kossgetstr lastend s keylst str x koerr)
 (defun koerr (s)
     (setq *error* olderr)
     (princ)
  )
  (setq olderr *error*)
  (setq *error* koerr)
  (setq mode t entsel-ena nil)
  (while mode
     (if msg (princ msg) (prompt "\n选择对象:"))
     (setvar "SHORTCUTMENU" 2)
     (setq gr (grread nil 12 2)
   ga (car gr)
   gb (cadr gr)
     )
     (cond   
       ((= ga 3);;控制鼠标点击动态事件
            (cond
                ((setq entsel-ena  (ko-entsel-subfunction gb filter_list));第一击时点中对象的判断及循环
                   (setq mode nil) 
                )
                ((not entsel-ena);第一击没点中对象或不符合过滤表要求时的提示，再次进入循环，直到空格退出
                     (if errmsg
                         (princ errmsg)
                         (princ (strcat "\n无效对象"))
                     )
                )
           )       
       )             
       ((and (or (member gr '((2 13)(2 32))) (= 25 ga))) ;;空格32或回车13或右键25下结束程序返回nil
   (setq mode nil)
       )
       ((and keyword (member (ascii (strcase (chr gb))) (vl-string->list keyword)));;关键字的动态输入控制
            (setq keylst (ko->str-symlst keyword " "))
            (if (not action)
              (progn
                  (setq ws (vlax-Create-Object "WScript.Shell"))
                  (setq str (getstring (car (list "" (vlax-invoke-method ws 'sendkeys (chr gb))))))
                  (if str (setq mode nil))
                  (setq kossgetstr (car (vl-remove-if '(lambda (x) (not (member (ascii (strcase str)) (vl-string->list x)))) keylst)))
              )
                  (progn
                    (setq mode nil)
                    (setq kossgetstr (car (vl-remove-if '(lambda (x) (not (member (ascii (strcase (chr gb))) (vl-string->list x)))) keylst)))
                  )
           )
       )
       ((and (= ga 2) (or (= gb 39) (and (>= gb 43) (<= gb 57)) (= gb 59) (= gb 61) (and (>= gb 91) (<= gb 93))));;数字输入的控制
                  (setq ws (vlax-Create-Object "WScript.Shell"))
                  (setq real (getreal (car (list "" (vlax-invoke-method ws 'sendkeys (chr gb))))))
                  (if real (setq mode nil))
                  (setq kossgetstr real)
       )
       (t (princ "*无效关键字*,请重新输入"))
     );end_cond

  );end_while 
     (setq *error* olderr)
      (cond
         (kossgetstr kossgetstr);;关键字或词的字符串或实数的返回
         (entsel-ena (list entsel-ena gb))
         (t nil)
     );end_cond
);ko_end

(defun ko-entsel-subfunction (pt filter_list /  mode  ns ent);第一击时，判断对象或过滤对象
  (setq mode t)
  (while mode
     (setq ent (nentselp pt))
     (cond
        ((and (listp ent) (/= ent nil));
    (if (/=  (type (car (last ent))) 'ENAME)
 ;+++++++++++++++++++++++++++++++++判断不是点中块++++++++++++++++++++++++++++++++++
             (if filter_list;不是块的情况，考虑有没有过滤要求
               (progn  ;;考虑有过滤要求
                 (if (= (dxf 0 (entget (car ent))) "VERTEX");;判断是二维多段线则提出组码330图元名
                     (setq ns (dxf 330 (entget (car ent))))
                     (setq ns (car ent))
                 )
                 (cmd0)
          (vl-cmdf "select" ns "")
                 (if (ssget "p" filter_list);;用过滤表来过滤对象
                     (progn
                        (setq mode nil)  
                         ns
                     )
                     (setq mode nil)
                 )
              )
       (progn  ;;考虑没有有过滤要求 
                  (setq mode nil) 
                   (car ent)
              )
           );end_if
           (progn
;++++++++++++++++++++++++++++++++++点击的是块情况++++++++++++++++++++++++++++++++++
       (setq mode nil)
              (setq bloena (last (last ent)));取出块的图元名
              (if filter_list  ;;考虑过滤表的情况
                  (progn
                    (vl-cmdf "select" bloena "")
                   (if (ssget "p" filter_list) bloena)
                  )
                  bloena
              )
           );end_progn
  );end_if
       )
       ((= ent nil) (setq mode nil)
       )
     );end_cond
  );end_while
);ko_end

(defun c:tt()
  (setq xh t)
  (while xh
    (setq ent (ko->entsel "\n测试ko->entsel函数(X)/(H):" "X H" T '((0 . "*LINE,CIRCLE,ARC")) nil))
    (cond ((= ent "X") (alert "等于字符串X你要执行的程序一") ent)
          ((= ent "H") (alert "等于字符串H你要执行的程序二") ent)
          ((= (type ent) 'ENAME) (alert "这个功能是返回图元名") (setq xh nil) ent)
          ((numberp ent) (alert (strcat "此项功能是判断输入的是否是实数或整理,
                                       用于不用进入子选项而直接设置一个值" "\n"
                                       "请选择要拉伸的对象或[当前默认值(500)或直接输入值回车改变默认值]"))
            ent
          )
          ((= ent nil) (setq xh nil))
    )
 )
)

xhq1954425

1先输入非关健字X、H有错误提示

2输入关健字就立刻结束了，没有消息框出现