Visual Lisp - Tabela de distâncias e azimutes


Ando meio sem assunto ultimamente, hehehe,

achei aqui uma lisp que eu fiz para um amigo uma vez, Creio que vai ser útil para muita gente!!

Ela faz o seguinte:

Ela pede a seleção de uma polilinha e em seguida desenha uma tabela com os alinhamentos da mesma, com numeração, comprimento e azimute de todos os segmentos da mesma. Fica assim:



Download dela já compilada A lisp é esta:

(defun c:plh (/ ent ss p1 p2 n file pt str)
  (
tbn:error-init (list (list "cmdecho" 0) T))
  (
prompt "\nSelecione a polilinha")
  (
setq ss  (ssget ":S" '((0 . "LWPOLYLINE")))
    ent (ssname ss 0)
    pt  (getpoint "\nClique o ponto de inserção")
    str (getstring "\nQual o nome da área?" t)
    pts (get-points-polig ent)
        n   0
        p1  (car pts)
    table        (vla-addtable (vla-get-modelspace thisdrawing) (vlax-3d-point pt)
               (
 1+ (length pts))
               7
               1
               1
))

  (
vla-settext table 0 0 (strcat "TABELA-AZIMUTES/DISTÂNCIAS/COORDENADAS\\P" STR))

  (
foreach tit '("Vértice" "Para" "Rumo" "Azimute" "Distância" "Coord. Norte" "Coord. Leste")
    (
vla-settext table 1 n tit)
    (
setq n (1+ n))
    )

  (
Setq n 0)
  (
repeat (1- (length pts))
    (
setq p2  (nth (1+ n) pts))

    (
vla-settext table (+ n 2) 0 (iF (= N 0 ) "0=pp" (itoa n)))
    (
vla-settext table (+ n 2) 1 (IF (= (+ 2 N) (LENGTH PTS)) "0=pp" (itoa  (1+ n))))
    (
vla-settext table (+ n 2) 2 (format-ang2 (angle p1 p2) t "Rumo" 4))
    (
vla-settext table (+ n 2) 3 (format-ang2 (angle p1 p2) t "Azimute" 4))
    (
vla-settext table (+ n 2) 4 (fnum (dist-h p1 p2) 2))
    (
vla-settext table (+ n 2) 5 (fnum (caDr p1) 3))
    (
vla-settext table (+ n 2) 6 (fnum (car p1) 3))
    (
setq p1 p2
      n
  (1+ n)))



  (
tbn:error-restore))


(defun format-ang2 (ang spc formato precisao / i g m un angbase angdir str)
  (
setq un (getvar "unitmode")
    angbase  (getvar "ANGBASE")
    angdir   (getvar "angdir")
    precisao (if (= 'int (type precisao)) precisao (nth (vl-position precisao '("M") ) '(4)))
    )
  (
setvar "UNITMODE" 0)
  (
setvar "angbase" (/ pi 2))
  (
setvar "angdir" 1)
  (
setq    g   (if    spc  "° " "°" )
    m   (if    spc  (if (= 1 precisao) "'" "' ") "'" )
    str (vl-string-subst m  "'" (vl-string-subst g "d"
                      (angtos ang (if (OR (= formato "A") (= formato "Azimute")) 1 4)
                          precisao)))
    i   0  )
  (
setvar "UNITMODE" un)
  (
setvar "angbase" angbase)
  (
setvar "angdir" angdir)
  (
repeat 10
    (setq str (vl-string-subst
        (strcat g "0" (itoa i) "'")
        (
strcat g (itoa i) "'")
        str)
      str (vl-string-subst
        (strcat m "0" (itoa i) "\"")
        (
strcat m (itoa i) "\"")
        str )
      i   (1+ i)))
  (
if (= formato "Rumo")
    (
vl-string-subst "O" "W"  (if (/= 1 (strlen str))
                (
strcat    (substr str 3 (- (strlen str) 3))
                    (
substr str 1 1)
                    (
substr str (strlen str) 1))
                str))
    str)
  )

; dist-h (pt1 pt2): calcula a distancia no plano xy entre dois pontos
(defun dist-h (pt1 pt2 /)
  (
if (and pt1 pt2) (distance (3dto2d pt1) pt2)))



Link(s) da(s) subrotina(s) usada(s): tbn:error-init, 3dto2d, get-points-polig, thisdrawing, format-ang2, fnum, dist-h, tbn:error-restore

Gostou? Sugiro ler o artigo sobre programação em lisp que está aqui

7 comentários:

  1. As subrotinas format-ang2 e dist-h, não estão disponíveis!!! Onde encontramos elas?

    ResponderExcluir
  2. OLÁ AMIGO, VC TERIA UM TUTORIAL DE COMO USAR ROTINAS OU UM SITE Q POSSA INDICAR GOSTEI DESSA SUA TABELA E ACHO Q ELA SERÁ MAIS Q ÚTIL NOS MEUS TRABALHOS, MAS NÃO ENTENDO QUASE NADA DE ROTINAS LISP NO CAD.

    ResponderExcluir
  3. Olá amigo, gostei dessa sua tabela mas não entendo quase nada de rotinas e subrotinas no CAD, vc teria um tutorial explicando como coloca-las ou um bom site que explique? obrigado!

    ResponderExcluir
  4. Baixe ele já compilado aqui:
    http://tbn2net.appspot.com/showprog?progid=236005&ajuda=True

    ResponderExcluir
  5. como faço pra usar todas as funções dessa lisp

    ResponderExcluir
  6. comece copiando e salvando...
    depois carregue com appload

    ResponderExcluir