![]() |
中午写了一个nentsel函数,请大伙和版主们帮我看看,谢谢
中午写了一个nentsel函数,请大伙和版主们帮我看看,谢谢
www.dimcax.com 中午写了一个nentsel函数,请大伙和版主们帮我看看,谢谢 ;---------------------------------------- ;| msg为提示选择信息,没有时为值""空字符串 filtlst为图元名的表,大写,没有时为值nil,'("text" "mtext" "attrib" "attdef") nomsg不符合选择要求的提示,没有时为值nil |; (defun ko->nentsel(msg filtlst nomsg / loo gr ga gb ne) (setq loo t) (while loo (if msg (princ msg)) (setq gr (grread nil 12 2) ga (car gr) gb (cadr gr) ) (cond ((= ga 3) (setq ne (nentselp msg gb)) (cond ((null ne) (if msg (princ msg))) (filtlst (cond ((member (cdr (assoc 0 (entget (car ne)))) filtlst) (setq loo nil) (car ne) ) ((and (/= ne nil) (not (member (cdr (assoc 0 (entget (car ne)))) filtlst))) (if nomsg (princ nomsg)) ) ) ) ((null filtlst) (setq loo nil) (car ne)) ) ) ((= gb 32) (setq loo nil)) ) ) ) 对于我上面的函数,大家有没有更好的来满足我的功能啊,谢谢 d ;;选择对象 entsel ssget等 函数扩展 ;; by caoyin @mjtd.com ;;____________________________________________________________________________________________________ ;; ▓ (lt:entsel msg fil lst) ;; [功能] 扩展 entsel,支持过滤选择,关键字 ;; [参数] msg---(str)提示信息。如果nil时则显示缺省为"\n选择对象: " ;; fil---(list)过滤条件列表,格式与 ssget 函数相同 ;; lst---(list)包含两个元素:(errmsg key) ;; errmsg---出错信息(str)。如果nil时则显示缺省为"无效的对象。" ;; keywd----关键字,格式与 initget 函数相同 ;; [返回] 本函数受变量 $lt-entsel$ 影响,若 $lt-entsel$ 为 nil,返回值与函数 entsel 相同,反之 ;; 则与函数 nentsel 相同。 ;| [测试] (lt:entsel "\n选择对象或 [类型(t)/点(o)]: " '((0 . "line") (8 . "0")) (list "对象必须是图层为 0 的直线。" "type point") ) |; (defun lt:entsel (msg fil lst / nom pif errmsg keywd fun e en ss) (setq nom (getvar "nomutt") pif (getvar "pickfirst") errmsg (car lst) keywd (cadr lst) ) (if $lt-entsel$ (setq fun 'nentsel) (setq fun 'entsel) ) (or msg (setq msg "")) (or errmsg (setq errmsg "无效对象。")) (setq keywd (cond (keywd (strcat keywd " ")) (t " "))) (setvar "pickfirst" 1) (while (not e) (initget keywd) (setq e (apply fun (list msg))) (cond ((= e "") (setq e t)) ((not e) (princ "未找到对象。")) ((and (vl-consp e) (not $lt-entsel$)) (setq ss (ssadd) en (car e)) (ssadd en ss) (sssetfirst nil ss) (setvar "nomutt" 1) (ssget) (setq ss (ssget "_p" fil)) (setvar "nomutt" nom) (if (not (and ss (ssmemb en ss))) (progn (princ errmsg) (setq e nil)) ) ) ) ) (setvar "pickfirst" pif) (if (/= e t) e) ) caoyin老大,你的这个程序不能满足我的要求呢,俺以为改一下你的就可以去判断块中的对象啦,后来我自己写了上面的那个ko->nentsel,但过滤不是ssget的格式呢,有的美中不足,唉。。。。 d |
所有的时间均为北京时间。 现在的时间是 06:03 PM. |