경로를 점 단위로 측정

숨겨진 부분이 없는 일반 텍스트입니다. 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)

다른 명령: 측정과 폴리선

• CXAREA닫힌 도형 안에 면적 쓰기
• CXLEN선·호·폴리선을 따라 길이 쓰기
• CXSUM도면층별 길이와 면적 합계
• CXCENTROID닫힌 도형의 중심 찾고 표시하기
• CXPLCLOSE끝이 거의 맞닿은 폴리선 닫기
• CXPLREV선과 폴리선의 방향 뒤집기
• CXPLCLEAN중복 점과 직선 위의 불필요한 점 제거
• CXPLWIDTH많은 폴리선의 폭을 하나로 맞추기
• CXJOIN선과 호를 틈이 있어도 폴리선으로 결합