Visual Lisp - Ainda não morreu!!!!

Mais um dia, mais um serviço pro estagiário....

Dessa vez, imagine o seguinte:

Você tem um eixo, que digitalizou no Google Earth, por exemplo. Ele tem, digamos 800 km

Suponha, que você tenha clicado um vértice a cada 50 metros.

Agora, imagine que em cada 1000 metros, tem um marco de quilometragem, que você digitalizou com aqueles "pinos" do Google Earth.



Agora, suponha que queira desenhar isso tudo no AutoCAD.

Obviamente, você pode usar o READKML2, para importar:


Bom, mas não satisfeito com isso, você resolve que precisa inserir no AutoCAD, um texto em cada vértice da polilinha, com o seu KM em relação aos marcos de quilometragem.

Faz as contas, 800 km, um a cada 50 m..... 16 mil textos.

Aí, claro, tem de calcular a interpolação dos pontos.

Bom, Vamos, lá programar isso, porque fazer na mão.... esquece!!!


;lista todos os blocos com o texto do nome da estação e km
(setq ss (ssget "X" '((0 . "INSERT") (2 . "MARCO_KM"))))

;seleciona o eixo de referencia
(SETQ EIXO (CAR (ENTSEL)))

;cria uma lista com '((distancia "codigo_estacao" km_estação) .... )
(SETQ LST
  (MAPCAR '(LAMBDA (ENT)

      ;se está no formato "CODIGO - KM", adiciona à lista
      (IF (/= "ZTO'" (GET-TAG-PROP ENT "NOME"))
        ;se o bloco está ate 30 metro do eixo, é uma estação válida, então adiciona
        (IF (< (DISTANCE (DXF 10 ENT)
    ;projeção do ponto no eixo
    (SETQ PTPROX (VLAX-CURVE-GETCLOSESTPOINTTO EIXO (DXF 10 ENT)))
    )

        30)
      


   ;cria uma lista neste formato: (distancia "codigo_estacao" km_estação)
   (APPEND
                 (LIST (VLAX-CURVE-GETDISTATPOINT EIXO PTPROX))
   (
READ (STRCAT "(\"" (VL-STRING-SUBST "." ","
           (VL-STRING-SUBST "\"" " - "
      (GET-TAG-PROP ENT "NOME"))) ")"))))))
 (
DXF -1 SS)))

;remove o lixo e ordena pela primeira coluna (distancia)
(SETQ LST (VL-SORT (VL-REMOVE 'NIL LST) '(LAMBDA (A B) (< (CAR A) (CAR B)))))

;lista todos os vértices do eixo, sem duplicatas
(SETQ PTS (RMPDUP (GET-POINTS-POLIG EIXO)))

;processa todos os pontos do eixo
(FOREACH PT PTS
  ;calcula a distância até o início sobre o eixo
  (SETQ DIST (VLAX-CURVE-GETDISTATPOINT EIXO PT))

  ;acha a estação posterior ao ponto em questão
  (SETQ DEPOIS (CAR (VL-REMOVE 'NIL (MAPCAR '(LAMBDA (A) (IF (> (CAR A) DIST)  A)) LST))))

  ;acha a estação anterior ao ponto em questão
  (SETQ ANTES  (LAST (VL-REMOVE 'NIL (MAPCAR '(LAMBDA (A) (IF (< (CAR A) DIST)  A)) LST))))

  ;se tem as duas, interpola
  (IF (AND ANTES DEPOIS)
    ;se são a mesma, desenha
    (IF (EQ ANTES DEPOIS)
      (
DRAW-TEXT  (RTOS (CADDR ANTES) 2 0)  pt "KM" 0 5 "ARIAL" "TR"  )

      ;se a distância interpolada "D" em KM da estação anterior é menor que 2200,
      ;pois tem uma estação faltando, desenha, senão marca com círculo
      (IF (< (SETQ D ( * (- DIST (CAR ANTES))
    (
/ (- (CAR DEPOIS) (CAR ANTES))
       (
- (CADDR DEPOIS) (CADDR ANTES)))))
      2200)
 (
DRAW-TEXT  (RTOS (+ (CADDR ANTES) D ) 2 0)  pt "KM" 0 5 "ARIAL" "TR"  )
 (
ENTMAKE (LIST (CONS 0 "CIRCLE") (CONS 10 PT) (CONS 40 4) (CONS 8 "ERRO")))))

    ;se só tem a estação posterior
    (IF DEPOIS
      ;se a distância da estação posterior é menor que 2200, desenha, senão marca com círculo
      (IF (< (- (CAR DEPOIS) DIST) 2200)
         (
DRAW-TEXT (RTOS (- (CADDR DEPOIS) (- (CAR DEPOIS) DIST)) 2 0)  pt "KM" 0 5 "ARIAL" "TR"  )
         (
ENTMAKE (LIST (CONS 0 "CIRCLE") (CONS 10 PT) (CONS 40 4) (CONS 8 "ERRO"))))

      ;se só tem a estação anterior
      (IF ANTES
 ;se a distância da estação anterior é menor que 2200, desenha, senão marca com círculo
 (IF (< (- DIST (CAR ANTES) ) 2200)
   (
DRAW-TEXT (RTOS (+ (CADDR ANTES) (- DIST (CAR ANTES) )) 2 0) pt "KM" 0 5 "ARIAL" "TR")
   (
ENTMAKE (LIST (CONS 0 "CIRCLE") (CONS 10 PT) (CONS 40 4) (CONS 8 "ERRO"))))
      ))))



Ah, DXF, GET-TAG-PROP, RMPDUP, GET-POINTS-POLIG, DRAW-TEXT, são subrotinas que estão aqui na página. Divirta-se procurando elas!!!!

Olha o resultado:


Difícil?

O programinha tem 74 linhas, gastei uns 20 minutos para escrever, depurar e rodar.

Agora, faz as contas de quanto aquele seu estagiário precisaria para fazer o mesmo trabalho ??

Sim, me pediram mesmo pra fazer esse trabalho... hehehe

Bucaneiros - A luta continua

Uns tempos atrás, fiz uma postagem sobre os bucaneiros, que tentam burlar as proteções que coloco nos meus plugins.


Bem, parece que os programas realmente estão fazendo sucesso!!!

Essa semana estava fazendo uma "limpeza" na minha base de dados e tirei centenas de usuários com emails temporários.

É lastimável que eu tenha de fazer isso, mas de certa forma é mais uma prova de que estou indo na direção certa com esses programas!!!!

Já tem gente se esforçando pra quebrar as proteções!!!

Uma dica, dá menos trabalho comprar uma licença de um dia, do que fazer um email temporário. O preço chega a ser simbólico!!! Me paga uma cerveja, parceiro!!!