AUTOLISP PARA COLOCAR O RUMO EM ALINHAMENTOS

Pessoal, há algum tempo eu postei uma rotina que colocava o rumo dos alinhamentos.
Para isso bastava clicar no ponto inicial da linha, e no ponto final.

Agora este Lisp foi melhorado, e para colocar os rumos nos alinhamentos, basta selecionar todas as linhas de uma vez que o programa faz o resto.

Observação: Funciona apenas com linhas (não serve para polilinhas).
Caso o sentido dos alinhamentos tenha que ser invertido, basta editar a polilinha antes (PE - Reverse) e depois explodir para transformar em linhas.

Segue rotina abaixo:

;;RODRIGO AUGUSTO DOURADO NEVES
;;SÃO JOSÉ DO RIO PRETO - SP
;;MAIO DE 2006
;;radneves@gmail.com



(defun c:qrumo ()
  (setvar "cmdecho" 0)
  (setvar "angdir" 0)
  (setq escala (getreal "Entre o fator de escala: "))
  (setq ttext (getdist "Entre com o tamanho do texto: "))
  (setq linhas (ssget))
  (setq nument (sslength linhas))
  (setq cont 0)

  (while (<= cont nument)

    (setq current1 (cdr (assoc 10 (entget (ssname linhas cont)))))
    (setq current2 (cdr (assoc 11 (entget (ssname linhas cont)))))
    (setq ds (* (distance current1 current2) escala))
    (setq an (angle current1 current2))
    (setq gr (/ (* an 360) (* 2 pi)))

    (if (< gr 90)
      (list (princ ds) (princ " ") (setq angulo (princ (- 90 gr))) (princ " ") (setq rumo (princ "NE")) (setq tang gr) )

      (if (and (< gr 180) (>= gr 90))
      (list (princ ds) (princ " ") (setq angulo (princ (- gr 90))) (princ " ") (setq rumo (princ "NW"))(setq tang (+ 180 gr)) )

(if (and (< gr 270) (>= gr 180))
      (list (princ ds) (princ " ") (setq angulo (princ (- 270 gr))) (princ " ") (setq rumo (princ "SW")) (setq tang (+ gr 180) ))

 (if (and (< gr 360) (>= gr 270))
      (list (princ ds) (princ " ") (setq angulo (princ (- gr 270))) (princ " ") (setq rumo (princ "SE")) (setq tang gr ))
 
  )
  )
  )
  )
   

    (setq ang1 (fix angulo))
    (setq fra_ang1 (- angulo ang1))
    (setq minuto1 (fix (* fra_ang1 60)))
    (setq fra_min (- (* fra_ang1 60) (fix minuto1)))
    (setq segundo1 (* 60 fra_min))
    (setq segundo2 (fix segundo1))
    (setq texto (strcat (rtos ds 2 2) "m - " (rtos ang1 2 0) "º " (rtos minuto1 2 0) "' " (rtos segundo2 2 0) "''" rumo ))
    (command "text" "j" "c" (list (/ (+ (car current1) (car current2)) 2) (/ (+ (cadr current1) (cadr current2)) 2) 0) ttext tang texto)
    (setq current1 current2)
    (setq cont (+ cont 1))
    )

   (setvar "cmdecho" 1)


  )