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

5 comentários:

  1. É muito interessante o que vc fez, quando eu postei ali no chat estava justamente pensando em como iria emular exatamente o preview do osnap, pois a parte de usar o comando (osnap) para aplicá-lo nos pontos eu já tinha feito. Estou ciente que .net é muito mais flexível que vlisp, mas além de aprender um linguagem totalmente nova vou ter que modificar totalmente meus códigos, uso muito as funções mapcar, apply, foreach...

    PS.: Vc já trabalhou com ObjectARX?

    ResponderExcluir
  2. já, particularmente eu não gosto da aparencia dos codigos em c++... é muito "{}" , "->" e "**" pro meu gosto..

    tambem acho que so justifica usar ele quando precisa criar entidades personalizadas, no resto o .net resolve perfeitamente, já que tem praticamente tudo que tem no objectarx

    exemplo:

    void createLayer() {

    AcDbLayerTable *pLayerTbl = NULL;
    acdbHostApplicationServices()->workingDatabase()->getSymbolTable(pLayerTbl, AcDb::kForWrite);

    if (!pLayerTbl->has(_T("MYLAYER"))) {

    AcDbLayerTableRecord *pLayerTblRcd = new AcDbLayerTableRecord;
    pLayerTblRcd->setName(_T("MYLAYER"));

    AcCmColor color;
    color.setColorIndex(1); // red
    pLayerTblRcd->setColor(color);
    pLayerTbl->add(pLayerTblRcd);
    pLayerTblRcd->close();


    } else acutPrintf(_T("\nLayer already exists"));
    pLayerTbl->close();

    }

    isso cria um layer, funciona

    mas o problema é a aparecencia do codigo, na minha opiniao, claro

    ResponderExcluir
  3. e muito interesante eu adorei já quer gosto dele seu blog

    ResponderExcluir
  4. Obrigado!!! Quando quiser publicar algum artigo, pode mandar, publicarei com gosto

    ResponderExcluir
  5. Obrigado!!! Quando quiser publicar algum artigo, pode mandar, publicarei com gosto

    ResponderExcluir