[求助]请高手优化程序

TANER

以下程序为xyp版主的程序

;;; ==================================================================
;;; 选择(usel1 0 "arc" "圆弧")
;;; ==================================================================
(defun usel1 (number sname msg / mode s1)
  (setq sname (strcase sname))
  (while (/= mode sname)
    (while (not (setq s1 (entsel (strcat "\n选择" msg " : ")))))
    (setq mode (xyp-get-dxf number (car s1)))
  )
  s1
)

(defun xyp-get-dxf (code ename)
  (cdr (assoc code (entget ename)))
)

以下为明经上的程序

(defun Sel (_types msg / gr ent m ty)
  (prompt (strcat "\n选择" msg " : "))
  (setq m nil)
  (while (not m)
    (setq gr (grread 2 4 2))
    (cond
      ((= (car gr) 3)
       (setq ent (ssget (cadr gr)))
       (if (not (and ent (member (cdr (assoc 0 (entget (setq ent (ssname  ent 0))))) _types)))
 
  (setq ent nil)
 
       )
       (setq m t)
      )
      ((= (car gr) 25) (setq m t))
    )
  )
  (princ "\n")
  (if ent (list ent (cadr gr)) nil)
)

 usel1有防错功能，但是函数的参考多一DXF码，输入麻烦。

sel没防错功能（点错就退出）。但是输入参数少。输入方便。

哪位高手能优化一下，将USEL1的DXF码去掉，将SEL改为具有防错功能。谢谢！

没人理我，自已想了两天，搞定一半如下：

;;; ==================================================================
;;; 选择(usel2  "LINE" "圆弧")
;;; ==================================================================
(defun usel2 (sname msg / mode s1)
  (setq sname (strcase sname))
  (while (/= mode sname)
    (while (not (setq s1 (entsel (strcat "\n选择" msg " : ")))))
    (setq mode (thrassoc sname (entget (car s1))))
    (setq mode (xyp-get-dxf mode (car s1)))
  )
  s1
)
(defun thrassoc (id lst)
  (car (car (vl-remove-if-not '(lambda (x)
                                 (= (strcase id) (cdr x))
                               ) lst
            )
       )
  )
)
;;; ==================================================================