发两个带过滤及亮显等功能的 entsel 函数

yxp

不知有没有人写过这个功能，写过的话我就把原创去了。
注意，Lisp 原来的 entsel 函数是没有过滤和亮显功能的。

2. ;;================================================================
   
3. ;;原创: 明经通道 yxp  qq:9034598
   
4. ;;功能：单选 + 提示信息 + 过滤 + 亮显 + 回车退出的仿 entsel 函数
   
5. ;;      鼠标移动时，将亮显符合过滤项的图元，拾取后，返回对象图元
   
6. ;;      当左键拾取对象为空时，将结束选择，返回 nil
   
7. ;;语法: (xensel msg filter-list)
   
8. ;;示例:
   
9. ;;(setq ss (xensel "\n请选择文本,直线 或<退出>:" '("TEXT" "LINE")))
   
10. ;;================================================================
    
11. 
    
12. (defun xensel (msg f / en ent own txt xen)
    
13. (if (and (= (type msg) 'STR) (listp f))(progn
    
14. (princ (strcat "\n" msg))
    
15. (while (or (= (car (setq mouse (grread t 5 2))) 5)(= (car mouse) 2))
    
16.   (setq own (nentselp (trans (cadr mouse) 0 1))
    
17.            en (cons (car own) (car en)))
    
18.   (if own (progn
    
19.             (setq ent (car own)
    
20.                   txt (cdr (assoc 0 (entget ent))))
    
21.             (if (apply 'or (mapcar '(lambda(x)(= txt x)) f))(progn
    
22.                 (setq xen (car en))
    
23.                 (redraw (car en) 3)
    
24.                 (if (and (cdr en)(null (eq (car en)(cdr en))))
    
25.                     (redraw (cdr en) 4))
    
26.             )))
    
27.    (if (cdr en)(redraw (cdr en) 4))
    
28.   ))
    
29. (if (setq ent (car en)) (redraw ent 4))
    
30. (if (eq ent xen) xen)
    
31. )(progn
    
32. (princ "\n函数 xensel 参数类型错误")
    
33. (princ)))
    
34. )
    
35. 
    
36. 
    
37. ;;========================================================
    
38. ;;原创: 明经通道 yxp  qq:9034598
    
39. ;;功能：单选 + 提示信息 + 过滤 + 回车退出的仿 entsel 函数
    
40. ;;      当拾取对象不符合过滤项图元时，将循环选择
    
41. ;;      当左键拾取对象为空时，将结束选择，返回 nil
    
42. ;;语法: (xensel2 msg filter-str)
    
43. ;;示例:
    
44. ;;(setq ss (xensel2 "\n请选择文本 或<退出>:" "TEXT"))
    
45. ;;========================================================
    
46. (defun xensel2 (msg f)
    
47. (while (if (setq el (car (entsel msg)))
    
48.        (if (= (cdr (assoc 0 (entget el))) f) nil t)
    
49. nil)) el
    
50. )
    
51. 
    

;;================================================================<br /> ;;原创: 明经通道 yxp  qq:9034598<br /> ;;功能：单选 + 提示信息 + 过滤 + 亮显 + 回车退出的仿 entsel 函数<br /> ;;      鼠标移动时，将亮显符合过滤项的图元，拾取后，返回对象图元<br /> ;;      当左键拾取对象为空时，将结束选择，返回 nil<br /> ;;语法: (xensel msg filter-list)<br /> ;;示例:<br /> ;;(setq ss (xensel "\n请选择文本,直线 或<退出>:" '("TEXT" "LINE")))<br /> ;;================================================================<br /> <br /> (defun xensel (msg f / en ent own txt xen)<br /> (if (and (= (type msg) 'STR) (listp f))(progn<br /> (princ (strcat "\n" msg))<br /> (while (or (= (car (setq mouse (grread t 5 2))) 5)(= (car mouse) 2))<br />   (setq own (nentselp (trans (cadr mouse) 0 1))<br />            en (cons (car own) (car en)))<br />   (if own (progn <br />             (setq ent (car own)<br />                   txt (cdr (assoc 0 (entget ent))))<br />             (if (apply 'or (mapcar '(lambda(x)(= txt x)) f))(progn<br />                 (setq xen (car en))<br />                 (redraw (car en) 3)<br />                 (if (and (cdr en)(null (eq (car en)(cdr en))))<br />                     (redraw (cdr en) 4))<br />             )))<br />    (if (cdr en)(redraw (cdr en) 4))<br />   ))<br /> (if (setq ent (car en)) (redraw ent 4))<br /> (if (eq ent xen) xen)<br /> )(progn<br /> (princ "\n函数 xensel 参数类型错误")<br /> (princ)))<br /> )<br /> <br /> <br /> ;;========================================================<br /> ;;原创: 明经通道 yxp  qq:9034598<br /> ;;功能：单选 + 提示信息 + 过滤 + 回车退出的仿 entsel 函数<br /> ;;      当拾取对象不符合过滤项图元时，将循环选择<br /> ;;      当左键拾取对象为空时，将结束选择，返回 nil<br /> ;;语法: (xensel2 msg filter-str)<br /> ;;示例:<br /> ;;(setq ss (xensel2 "\n请选择文本 或<退出>:" "TEXT"))<br /> ;;========================================================<br /> (defun xensel2 (msg f)<br /> (while (if (setq el (car (entsel msg)))<br />        (if (= (cdr (assoc 0 (entget el))) f) nil t)<br /> nil)) el<br /> )<br /> <br />

dabingrain

2. ;;功能：带提示、关键字、过滤表、选择错误时的提示并且会亮显所选对像的entsel
   
3. ;;用法：(entselEx  提示信息 过滤表)
   
4. ;;举例：(entselEx  "\r请选择一个圆：" '((0 . "circle")) )
   
5. (defun entselEx (msg fil / el ss)
   
6.         (while (and (setvar "errno" 0)
   
7.                                          (not (and (setq el  (entsel msg))
   
8.                                                                         (if (= (type el) 'str)
   
9.                                                                                 el
   
10.                                                                                 (if (setq ss (ssget (cadr el) fil))
    
11.                                                                                         ss
    
12.                                                                                         (progn (princ ermsg) (setq ss nil))
    
13.                                                                                 );if
    
14.                                                                         );if
    
15.                                                                 );and
    
16.                                          );not
    
17.                                          (/= (getvar "errno") 52)
    
18.                                  );and
    
19.   );while
    
20.   (if (= (type el) 'list) (redraw (car el) 3));亮显选中的对像
    
21.   el
    
22. )

;;功能：带提示、关键字、过滤表、选择错误时的提示并且会亮显所选对像的entsel<br /> ;;用法：(entselEx  提示信息 过滤表)<br /> ;;举例：(entselEx  "\r请选择一个圆：" '((0 . "circle")) )<br /> (defun entselEx (msg fil / el ss)<br />         (while (and (setvar "errno" 0) <br />                                          (not (and (setq el  (entsel msg)) <br />                                                                         (if (= (type el) 'str)<br />                                                                                 el<br />                                                                                 (if (setq ss (ssget (cadr el) fil))<br />                                                                                         ss<br />                                                                                         (progn (princ ermsg) (setq ss nil))<br />                                                                                 );if<br />                                                                         );if<br />                                                                 );and<br />                                          );not<br />                                          (/= (getvar "errno") 52)<br />                                  );and<br />   );while<br />   (if (= (type el) 'list) (redraw (car el) 3));亮显选中的对像<br />   el<br /> )

前生

这个好。刚想自己写个，在这个搜了一下。不错赞一个。

自贡黄明儒

过虑的很多人写过，亮显的没听过，怎么亮显法？等电脑上网寸下载来看看，支持。

tianyi1230

又是沙发，顶一个，楼主最近高产啊，

1993063

发个我在用的:
;;;;        (sel "物体")
(defun sel (msg / ent)
  (while (not ent)
    (cond
      ((setq ent (entsel (strcat "\r选择" msg ":"))))
      ((= (getvar "ErrNo") 7)(princ))
      ((= (getvar "ErrNo") 52)(t (setq *Error* Strcat)))
    )
  )
  ent
)

yaokui25

下载试用，谢谢楼主

清风明月名字

谢谢楼主的分享！太好用了！收藏备用。

llsheng_73

过滤功能还不够强，亮显很特别也实用,空了好好学习下

清风明月名字

谢谢楼主的分享！很有用啊！

434939575

谢谢分享！这个很特别，学习了！

lostbalance

lz这个亮显比较特别，不过好像不支持左键选择时选空后自动重复。个人感觉cad里面，单选文字特别容易选空