CXDIST量測與多段線版本 1.0.0已在 AutoCAD 中測試
逐點測量一條路徑
沿著路線一路點選,每一段的長度、角度、X/Y 增量和累計總長都會顯示,最後一點點錯了可以 Undo。
如何使用
- 輸入 CXDIST,點選第一個點。
- 依次點選後面的點;選 Undo 可以撤回最後一點。
- 按 Enter 結束,檢視路徑總長和閉合後的面積。
請注意
- 不會在圖中畫任何東西,任何圖紙上都可以放心使用。
在 AutoCAD 中載入
- 把檔案存在任意位置。
- 輸入 APPLOAD,選擇檔案,按「載入」。
- 輸入指令名稱:CXDIST。
想每次啟動都可用,在同一個對話方塊中加入「啟動套件」,或用選用的載入器一次載入整個資料夾。 關於選用的載入器
已在 AutoCAD(完整版)中測試。其他能執行 AutoLISP 的軟體也許可用,但未經測試。
程式碼
純文字,沒有任何隱藏內容。複製後存成名為 cxdist.lsp 的檔案,或直接下載。
;;; ============================================================================
;;; 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)
版本紀錄
版本 1.0.0 · 2026年10月27日
首個版本。