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