Visual Lisp, GRREAD e OSNAP

Alguém já conseguiu usar o osnap com a função grread? Não sei.. creio que nem dê... essa dúvida apareceu ali no chatbox, então resolvi mostrar uma solução que tinha criado uns tempos atrás para uma lisp que estava fazendo... em fim, ela faz o seguinte: ao ser chamada ela pede a seleção de coordenadas na tela e no final devolve a lista de pontos clicados. É como o comando WIPOUT. Na verdade esse código abaixo foi substituído por uma versão do comando wipeout mais tarde, então este já é obsoleto.
Veja uma imagem de como ele funciona:

Eis o código:

---

(defun get-user-polig  (/ pt circ quad tri qua int1 int2 mark show ins n pts tmp promp p os ad1l)
  (setq n     0
        circ  (repeat 20 (setq n (1+ n) circ (cons (polar '(0 0) (* n (/ pi 10)) 1) circ)))
        quad  '((1 1) (-1 1) (-1 -1) (1 -1))
        tri   (list (list (/ (expt 3 0.5) 2) -0.5) '(0 1) (list (/ (expt 3 0.5) -2) -0.5))
        qua   '((0 1) (-1 0) (0 -1) (1 0))
        int1  '((1 1) (-1 1))
        int2  '((-1 -1) (1 -1))
        ad1l  (lambda (l) (cdr (append l (list (car l)))))
        mark  (list ;cria as listas de coordenadas do blocos OSNAP
                (list quad (ad1l quad)) ;end
                (list tri (ad1l tri)) ;mid
                (list circ (ad1l circ)) ;cen
                (list (append circ int1)(append (ad1l circ) int2)) ;nod
                (list qua (ad1l qua)) ;quad
                (list int1 int2)        ;int
                '(((-1 0) (0 1) (-1 0) (-1 -1) (0 1) (1 0))
                  ((1 0) (0 -1) (-1 -1) (0 -1) (1 1) (1 1))) ;ins
                (list nil nil)          ;per
                (list (append circ '((-1 1)))(append (ad1l circ) '(1 0))) ;tan
                (list (append int1 '((-1 1) (-1 -1))) (append int2 '((1 1) (1 -1)))) ;nea
                (list nil nil);non
                (list (append quad int1) (append (ad1l quad) int2)) ;app
                (list nil nil);ext
                (list nil nil));parl
        show  (lambda (pt n) ;função que desenha o osnap na tela
                (mapcar
                  '(lambda (a b)
                     (grdraw (polar pt (angle '(0 0) a)(* (distance '(0 0) a) (/ (getvar "viewsize") 50.0)))
                             (polar pt (angle '(0 0) b)(* (distance '(0 0) b) (/ (getvar "viewsize") 50.0)))
                             2))
                  (car (nth n mark))
                  (cadr (nth n mark))))
        promp (lambda nil ;função que cria o prompt...
                (setq os  (getvar "osmode") n 0 str "" v "" p nil)
                (repeat 14 ;testa que OSNAP esta ligado
                  (if (= (expt 2 n) (logand os (expt 2 n)))
                    (setq str (strcat str v  "_"
                                      (nth n '("end"    "mid"    "cen" "nod"    "qua"    "int"
                                             "ins"    "per"    "tan" "nea"    "non"    "app"
                                             "ext"    "par")))
                          v   ","))
                  (setq n (1+ n)))
                (prompt (strcat "\nOsmode:" str "\nClique o ponto" (if pts " ou [Undo," "[")
                    "End,Mid,Cen,noD,Qua,Int,inS,Per,(Tan),Nea,nOn,App,(eXt),(parL)]:"))))
  (vl-catch-all-apply ;previne erros e o "ESC"
    '(lambda nil
       (promp);mostra o primeiro prompt
       (while (/= 12 (car (setq tmp (grread t 13))))
         (cond
           ((= 5 (car tmp)) ;mouse se movendo...
            (redraw)
            (setq pt (cadr tmp)) ;cordenada do mouse
            (cond ;testa cada OSNAP, pra ver qual foi pêgo
              ((= 1 (logand os 1)) (if (setq tmp (osnap pt "_end")) (show (setq pt tmp) 0)))
              ((= 2 (logand os 2)) (if (setq tmp (osnap pt "_mid")) (show (setq pt tmp) 1)))
              ((= 4 (logand os 4)) (if (setq tmp (osnap pt "_cen")) (show (setq pt tmp) 2)))
              ((= 8 (logand os 8)) (if (setq tmp (osnap pt "_nod")) (show (setq pt tmp) 3)))
              ((= 16 (logand os 16)) (if (setq tmp (osnap pt "_qua")) (show (setq pt tmp) 4)))
              ((= 32 (logand os 32)) (if (setq tmp (osnap pt "_int")) (show (setq pt tmp) 5)))
              ((= 64 (logand os 64)) (if (setq tmp (osnap pt "_ins")) (show (setq pt tmp) 6)))
              ;((= 128 (logand os 128)) (if (setq tmp (osnap pt "_per")) (show (setq pt tmp) 7)))
              ;((= 256 (logand os 256)) (if (setq tmp (osnap pt "_tan")) (show (setq pt tmp) 8)))
              ((= 512 (logand os 512)) (if (setq tmp (osnap pt "_nea")) (show (setq pt tmp) 9)))
              ((= 1024 (logand os 1024)) (if (setq tmp (osnap pt "_non")) (show (setq pt tmp) 10)))
              ((= 2048 (logand os 2048)) (if (setq tmp (osnap pt "_app")) (show (setq pt tmp) 11)))
              ;((= 4096 (logand os 4096)) (if (setq tmp (osnap pt "_ext")) (show (setq pt tmp) 12)))
              ((= 8192 (logand os 8192)) (if (setq tmp (osnap pt "_par")) (show (setq pt tmp) 13))))
            (if pts (grdraw pt (last pts) 1 1))
            (if pts (grdraw pt (car pts) 1 1))
            (if pts (grdraw (last pts) (car pts) 2 1)))
           ((= 3 (car tmp)) (setq pts (cons pt pts)))
           ((equal tmp '(2 117)) (setq pts (cdr pts)))
           ;uma tecla foi clicada, testa se é alguma dos OSNAP:
           ((setq p (vl-position (cadr tmp) '(101 109 99 100 113 105 115 112 116 110 111 97 120 108)))
            (setvar "osmode"
                    (if (= 10 p)
                      0
                      (if (= (expt 2 p) (logand os (expt 2 p))) (- os (expt 2 p)) (+ os (expt 2 p)))))
            (promp)))
         (mapcar '(lambda (a b) (grdraw a b 5 1)) (cdr pts) pts)
         )))
  (redraw)
  (mapcar '(lambda (x) (trans x 1 0)) pts))

---

Note que alguns códigos de osnap não funcionam bem, basicamente aqueles que dependem do last point....
Endpoint, Midpoint... estes funcionam bem...
É interessante o que a gambiarra faz, hehehe
Se você gosta do lisp e ainda não tinha usado o grread, osnap e o grdraw, essa é a sua chance!!!
No .NET tem algo que resolve isso muiiiito melhor, chama-se JIG, inclusive eu já postei um exemplo de como usar ele aqui