（XD::GetPoint）支持选点和数字关键字，一键回车的GetPoint

Lispboy

1. (defun XD::GetPoint (info keyword / pnt _iskey)
   
2.   (and (= (type keyword) 'str)
   
3.        (setq _iskey (not (xdrx-string-regexps "[^\\d ]" keyword)))
   
4.        (xdrx-initget keyword)
   
5.   )
   
6.   (while
   
7.     (and
   
8.       (progn
   
9.         (initget 128)
   
10.         (setq pnt (getpoint (xdrx-prompt info "<退出>:" t)))
    
11.       )
    
12.       (= 'str (type pnt))
    
13.       (not (and        _iskey
    
14.                 (distof pnt)
    
15.                 (xdrx-string-regexps pnt keyword)
    
16.            )
    
17.       )
    
18.     )
    
19.      (cond
    
20.        ((and (= (type keyword) 'str)
    
21.              (/= keyword ""))
    
22.         (or (and _iskey
    
23.                  (xdrx-prompt "\n>>请拾取点或者输入数字关键字.")
    
24.             )
    
25.             (xdrx-prompt "\n>>请拾取点或者输入数字.")
    
26.         )
    
27.        )
    
28.        (t
    
29.         (xdrx-prompt "\n>>请拾取点.")
    
30.        )
    
31.      )
    
32.   )
    
33.   pnt
    
34. )
    
35. 
    

(defun XD::GetPoint (info keyword / pnt _iskey)<br />   (and (= (type keyword) 'str)<br />        (setq _iskey (not (xdrx-string-regexps "[^\\d ]" keyword)))<br />        (xdrx-initget keyword)<br />   )<br />   (while<br />     (and<br />       (progn<br />         (initget 128)<br />         (setq pnt (getpoint (xdrx-prompt info "<退出>:" t)))<br />       )<br />       (= 'str (type pnt))<br />       (not (and        _iskey<br />                 (distof pnt)<br />                 (xdrx-string-regexps pnt keyword)<br />            )<br />       )<br />     )<br />      (cond<br />        ((and (= (type keyword) 'str)<br />              (/= keyword ""))<br />         (or (and _iskey<br />                  (xdrx-prompt "\n>>请拾取点或者输入数字关键字.")<br />             )<br />             (xdrx-prompt "\n>>请拾取点或者输入数字.")<br />         )<br />        )<br />        (t<br />         (xdrx-prompt "\n>>请拾取点.")<br />        )<br />      )<br />   )<br />   pnt<br /> )<br /> <br />