닫힌 객체 면적 합계 리습 (AREASUM)

;;; AutoCATS 리습 자료실
;; 명령: AREASUM
;; 기능: 원·닫힌 경량 폴리선·영역의 면적을 도면 단위 제곱으로 합산합니다.
;; 출처: https://www.autocats.co.kr/lisp/area-sum
;; 버전: 1.0 (2026-10-23)
;; 라이선스: 자유 사용·수정, 재배포 시 출처(autocats.co.kr) 표기
;; 안전: 잠긴 레이어·외부참조 보호, 변경은 UNDO 그룹, 명령별 범위는 상세 가이드 참고

(vl-load-com)

(defun autocats-areasum-get (ent property / result)
  (setq result (vl-catch-all-apply
      '(lambda ()
        (if (= property 'Area)
          (progn (command "_.AREA" "_Object" ent) (getvar "AREA"))
          (vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent))))))
  (if (vl-catch-all-error-p result) nil result))

(defun autocats-areasum-area (ent / data value)
  (setq data (entget ent))
  (if (or (member (cdr (assoc 0 data)) '("CIRCLE" "REGION"))
      (and (= "LWPOLYLINE" (cdr (assoc 0 data))) (= 1 (logand 1 (cdr (assoc 70 data))))))
    (autocats-areasum-get ent 'Area)))
(defun autocats-areasum-data (ss / index count total value)
  (setq index 0 count 0 total 0.0)
  (repeat (sslength ss)
    (if (setq value (autocats-areasum-area (ssname ss index)))
      (setq count (1+ count) total (+ total value)))
    (setq index (1+ index)))
  (list count total))

(defun c:AREASUM (/ *error* undo-open result selection)
  (defun *error* (msg)
    (if undo-open (progn (command-s "_.UNDO" "_End") (setq undo-open nil)))
    (if (and msg (not (wcmatch (strcase msg) "*CANCEL*,*QUIT*,*EXIT*,*취소*")))
      (princ (strcat "\n[AREASUM] 중단: " msg)))
    (princ))

  (setq selection (ssget '((0 . "CIRCLE,LWPOLYLINE,REGION"))))
  (if selection (progn
      (setq result (autocats-areasum-data selection))
      (princ (strcat "\n유효 개수: " (itoa (car result)) " / 면적 합계 (도면 단위 제곱): " (rtos (cadr result) 2 4)))))

  (princ))

(princ "\n[AutoCATS] AREASUM 로드 완료")
(princ)