社区 › AutoLISP/Visual LISP 编程技术 › 发两个带过滤及亮显等功能的 entsel 函数

yxp 发表于 2013-6-29 20:01:30

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

本帖最后由 yxp 于 2013-6-29 20:19 编辑


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

;;================================================================
;;原创: 明经通道 yxpqq:9034598
;;功能：单选 + 提示信息 + 过滤 + 亮显 + 回车退出的仿 entsel 函数
;;      鼠标移动时，将亮显符合过滤项的图元，拾取后，返回对象图元
;;      当左键拾取对象为空时，将结束选择，返回 nil
;;语法: (xensel msg filter-list)
;;示例:
;;(setq ss (xensel "\n请选择文本,直线 或<退出>:" '("TEXT" "LINE")))
;;================================================================

(defun xensel (msg f / en ent own txt xen)
(if (and (= (type msg) 'STR) (listp f))(progn
(princ (strcat "\n" msg))
(while (or (= (car (setq mouse (grread t 5 2))) 5)(= (car mouse) 2))
(setq own (nentselp (trans (cadr mouse) 0 1))
         en (cons (car own) (car en)))
(if own (progn
            (setq ent (car own)
                  txt (cdr (assoc 0 (entget ent))))
            (if (apply 'or (mapcar '(lambda(x)(= txt x)) f))(progn
                (setq xen (car en))
                (redraw (car en) 3)
                (if (and (cdr en)(null (eq (car en)(cdr en))))
                  (redraw (cdr en) 4))
            )))
   (if (cdr en)(redraw (cdr en) 4))
))
(if (setq ent (car en)) (redraw ent 4))
(if (eq ent xen) xen)
)(progn
(princ "\n函数 xensel 参数类型错误")
(princ)))
)


;;========================================================
;;原创: 明经通道 yxpqq:9034598
;;功能：单选 + 提示信息 + 过滤 + 回车退出的仿 entsel 函数
;;      当拾取对象不符合过滤项图元时，将循环选择
;;      当左键拾取对象为空时，将结束选择，返回 nil
;;语法: (xensel2 msg filter-str)
;;示例:
;;(setq ss (xensel2 "\n请选择文本 或<退出>:" "TEXT"))
;;========================================================
(defun xensel2 (msg f)
(while (if (setq el (car (entsel msg)))
       (if (= (cdr (assoc 0 (entget el))) f) nil t)
nil)) el
)

dabingrain 发表于 2016-10-22 10:01:16

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

前生 发表于 2018-11-10 13:05:07

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

自贡黄明儒 发表于 2013-6-29 20:16:45

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

tianyi1230 发表于 2013-6-29 20:17:39

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

1993063 发表于 2013-6-29 20:21:52

发个我在用的:
;;;;        (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 发表于 2013-6-29 22:56:42

下载试用，谢谢楼主

清风明月名字 发表于 2013-8-22 17:44:59

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

llsheng_73 发表于 2014-3-30 01:06:18

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

清风明月名字 发表于 2014-3-30 11:58:48

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

434939575 发表于 2015-8-18 22:17:34

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

lostbalance 发表于 2015-8-18 22:57:57

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

查看完整版本: 发两个带过滤及亮显等功能的 entsel 函数