[编程交流] 可用的新套索命令

(defun lasso ( / *error* lst n gr ss )
 (defun *error* ( m )
   (or (wcmatch (strcase m) "*BREAK,*CANCEL*,*EXIT*")
        (princ (strcat "\n** Error: " m" **"))
   ) (redraw) (princ)
 )
 (while (or (eq 5 (car (setq gr (grread t 5)))) (eq 3 (car gr)))
   (and (eq 3 (car gr))(setq lst (cons (cadr gr) lst)))
   (redraw)
   (and (< 1 (setq n (length lst)))
     (repeat n
       (grdraw (nth (setq n (1- n)) lst)
         (nth (if (minusp (1- n)) (1- (length lst)) (1- n)) lst)
         2
       )
     )
   )
 ) (redraw)(sssetfirst nil (setq ss (ssget "CP" lst))) ss
)

        (setq q (car lst))
        (mapcar '(lambda (p) (grdraw q p 2) (setq q p)) (cdr lst))