CADXChange

Todos los comandos LISP

CXDISTMedición y polilíneasVersión 1.0.0Probado en AutoCAD

Medir un recorrido punto a punto

Haz clic a lo largo de una ruta y verás, para cada tramo, longitud, ángulo y desplazamientos, además del total acumulado. Con Undo descartas el último punto.

Descargar cxdist.lspCondiciones LISP

Cómo se usa

  1. Escribe CXDIST y haz clic en el primer punto.
  2. Haz clic en cada punto siguiente. Con Undo descartas el último.
  3. Pulsa Intro para terminar y leer la longitud del recorrido y el área que encerraría.

Conviene saber

  • No se dibuja nada, así que es seguro usarlo en cualquier dibujo.

Cargarlo en AutoCAD

  1. Guarda el archivo donde quieras.
  2. Escribe APPLOAD, elige el archivo y pulsa Cargar.
  3. Escribe el nombre del comando: CXDIST.

Para tenerlo en cada inicio, agrégalo al Contenido de inicio en el mismo cuadro de diálogo, o carga una carpeta entera de una vez con el cargador opcional. Sobre el cargador opcional

Probado en AutoCAD (versión completa). Otros programas que ejecutan AutoLISP pueden funcionar, pero no se han probado.

El código

Texto sin más, nada oculto. Cópialo en un archivo llamado cxdist.lsp o descárgalo.

;;; ============================================================================
;;; CXDIST - Measure a path point by point
;;; Version 1.0.0
;;; CADXChange LISP tools - https://cadxchange.net/resources/lisp/cxdist
;;; Tested in: AutoCAD (full version). Other programs that run AutoLISP may work but are not tested.
;;; Copyright (c) CADXChange. Free for personal and commercial use; do not resell or
;;; republish it as a collection. Terms: https://cadxchange.net/legal/lisp-terms
;;; ============================================================================

;; The length of the path through PTS and, when the path is closed back to its start, the area it encloses: (length area).
(defun cx:dist-stats (pts / total i n sum)
  (setq total 0.0 sum 0.0 i 0 n (length pts))
  (repeat (1- n)
    (setq total (+ total (distance (nth i pts) (nth (1+ i) pts))) i (1+ i)))
  (setq i 0)
  (repeat n
    (setq sum (+ sum (- (* (car (nth i pts)) (cadr (nth (rem (1+ i) n) pts)))
                        (* (car (nth (rem (1+ i) n) pts)) (cadr (nth i pts)))))
          i   (1+ i)))
  (list total (abs (/ sum 2.0))))

(defun c:CXDIST ( / *error* cx:sv pts p r prec leg total)
  (setq *error* cx:err)
  (setq prec (getvar "LUPREC")
        pts  nil
        total 0.0)
  (setq p (getpoint "\nFirst point: "))
  (while p
    (if pts
      (progn
        (setq leg   (distance (car pts) p)
              total (+ total leg))
        (princ (strcat "\nLeg " (cx:num leg prec)
                       "   angle " (cx:num (* 180.0 (/ (angle (car pts) p) pi)) 2)
                       "   dx " (cx:num (- (car p) (car (car pts))) prec)
                       "   dy " (cx:num (- (cadr p) (cadr (car pts))) prec)
                       "   total " (cx:num total prec)))))
    (setq pts (cons p pts))
    (initget "Undo")
    (setq r (if (cdr pts)
              (getpoint p "\nNext point or [Undo] (Enter to finish): ")
              (getpoint p "\nNext point (Enter to finish): ")))
    (cond
      ((= r "Undo")
       (setq pts (cdr pts))
       (if (cdr pts) (setq total (- total (distance (car pts) (cadr pts)))) (setq total 0.0))
       (setq p (car pts)
             pts (cdr pts)))
      (T (setq p r))))
  (if (cdr pts)
    (progn
      (setq r (cx:dist-stats (reverse pts)))
      (princ (strcat "\nPath length " (cx:num (car r) prec)
                     ". Area enclosed if closed back to the start: " (cx:num (cadr r) prec) ".")))
    (princ "\nNeed at least two points."))
  (princ))


;;; ---- Shared helpers (used by the command above; identical in every CADXChange tool) ----

;; Close the undo step and put the system variables back.
(defun cx:end ()
  (foreach v cx:sv (setvar (car v) (cdr v)))
  (command "_.UNDO" "_End")
  (setq cx:sv nil)
  (princ))

;; Error handler: restores everything, stays quiet on Esc.
(defun cx:err (msg)
  (if (> (getvar "CMDACTIVE") 0) (command))
  (cx:end)
  (if (and msg (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")))
    (princ (strcat "\nError: " msg)))
  (princ))

;; Real X as text with at most PREC decimals and no trailing zeros ("2.50" -> "2.5", "3.00" -> "3").
(defun cx:num (x prec / s)
  (setq s (rtos x 2 prec))
  (if (wcmatch s "*.*")
    (progn
      (while (= (substr s (strlen s)) "0") (setq s (substr s 1 (1- (strlen s)))))
      (if (= (substr s (strlen s)) ".") (setq s (substr s 1 (1- (strlen s)))))))
  (if (or (= s "-0") (= s "")) "0" s))

(princ "\nCXDIST loaded. Type CXDIST to start.")
(princ)

Historial de versiones

Versión 1.0.0 · 27 de octubre de 2026

Primera versión.

Más comandos: Medición y polilíneas