해치 면적 합계 리습 (HAREA)

;;; ------------------------------------------------------------
;;; AutoCATS 리습 자료실
;; 명령: HAREA
;; 기능: 선택한 HATCH 객체의 면적 합계 계산 + 도면 기입(선택)
;; 출처: https://www.autocats.co.kr/lisp/hatch-area
;; 버전: 1.0 (2026-07-23)
;; 라이선스: 자유 사용·수정, 재배포 시 출처(autocats.co.kr) 표기
;; 안전: *error* 핸들러 + UNDO 그룹, 원본 해치 수정 없음
;;; ------------------------------------------------------------

(vl-load-com)

(defun autocats-harea-value (ent / result)
  (setq result
        (vl-catch-all-apply
          '(lambda ()
             (command "_.AREA" "_Object" ent)
             (getvar "AREA"))))
  (if (vl-catch-all-error-p result) nil result))

(defun autocats-harea-text (point value precision / wcs)
  (setq wcs (trans point 1 0))
  (entmakex
    (list
      (cons 0 "TEXT")
      (cons 10 wcs)
      (cons 40 (getvar "TEXTSIZE"))
      (cons 1 (rtos value 2 precision))
      (cons 7 (getvar "TEXTSTYLE")))))

(defun c:HAREA (/ *error* doc undo-open ss idx ent value total counted skipped precision answer point)
  (defun *error* (msg)
    (if undo-open
      (progn (vla-EndUndoMark doc) (setq undo-open nil)))
    (if (and msg (not (wcmatch (strcase msg) "*CANCEL*,*QUIT*,*EXIT*,*취소*")))
      (princ (strcat "\n[HAREA] 중단: " msg)))
    (princ))

  (princ "\n[HAREA] 면적을 합산할 HATCH 객체를 선택하세요.")
  (setq ss (ssget '((0 . "HATCH"))))
  (if ss
    (progn
      (setq total 0.0 counted 0 skipped 0 idx 0
            precision (getvar "DIMDEC"))
      (while (< idx (sslength ss))
        (setq ent (ssname ss idx)
              value (autocats-harea-value ent))
        (if value
          (setq total (+ total value) counted (1+ counted))
          (setq skipped (1+ skipped)))
        (setq idx (1+ idx)))
      (princ (strcat "\n[HAREA] 면적 합계: " (rtos total 2 precision)
                     "  (합산 " (itoa counted) "개 / 건너뜀 " (itoa skipped)
                     "개, 현재 도면 단위 기준)"))
      (if (> counted 0)
        (progn
          (initget "Y N")
          (setq answer
                (getkword "\n합계를 도면에 문자로 기입할까요? [예(Y)/아니오(N)] <N>: "))
          (if (= answer "Y")
            (progn
              (setq point (getpoint "\n문자 삽입 위치: "))
              (if point
                (progn
                  (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
                  (vla-StartUndoMark doc)
                  (setq undo-open T)
                  (autocats-harea-text point total precision)
                  (vla-EndUndoMark doc)
                  (setq undo-open nil))))))))
    (princ "\n[HAREA] 선택된 해치가 없습니다."))
  (princ))

(princ "\n[AutoCATS] HAREA 로드 완료 - 명령행에 HAREA 를 입력하세요.")
(princ)