yang686526

中午写了一个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