CADXChange

Tutti i comandi LISP

CXDISTMisure e polilineeVersione 1.0.0Provato in AutoCAD

Misurare un percorso punto per punto

Clicca lungo un percorso e vedi per ogni tratto lunghezza, angolo e scostamenti, più il totale progressivo. Con Undo annulli l'ultimo punto.

Scarica cxdist.lspCondizioni LISP

Come si usa

  1. Digita CXDIST e clicca il primo punto.
  2. Clicca i punti successivi. Con Undo scarti l'ultimo.
  3. Premi Invio per finire e leggere la lunghezza del percorso e l'area che racchiuderebbe.

Da sapere

  • Non viene disegnato nulla, quindi si può usare senza rischi in qualsiasi disegno.

Caricarlo in AutoCAD

  1. Salva il file dove preferisci.
  2. Digita APPLOAD, scegli il file e premi Carica.
  3. Digita il nome del comando: CXDIST.

Per averlo a ogni avvio, aggiungilo alla Raccolta di avvio nella stessa finestra, oppure carica un'intera cartella in una volta con il caricatore facoltativo. Il caricatore facoltativo

Provato in AutoCAD (versione completa). Altri programmi che eseguono AutoLISP potrebbero funzionare, ma non sono stati provati.

Il codice

Testo semplice, niente di nascosto. Copialo in un file chiamato cxdist.lsp oppure scaricalo.

;;; ============================================================================
;;; 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)

Cronologia delle versioni

Versione 1.0.0 · 27 ottobre 2026

Prima versione.

Altri comandi: Misure e polilinee