숫자 문자 사칙연산 리습 (TCALC)

;;; ------------------------------------------------------------
;;; AutoCATS 리습 자료실
;; 명령: TCALC
;; 기능: 숫자로만 구성된 TEXT/MTEXT/ATTRIB에 사칙연산 일괄 적용
;; 출처: https://www.autocats.co.kr/lisp/text-calculate
;; 버전: 1.0 (2026-07-23)
;; 라이선스: 자유 사용·수정, 재배포 시 출처(autocats.co.kr) 표기
;; 안전: *error* 핸들러 + UNDO 그룹, 0 나누기 차단, 잠긴 레이어 건너뜀
;;; ------------------------------------------------------------

(vl-load-com)

(defun autocats-tcalc-clean (value / result idx char)
  (setq result "" idx 1)
  (while (<= idx (strlen value))
    (setq char (substr value idx 1))
    (if (not (member char '("," " ")))
      (setq result (strcat result char)))
    (setq idx (1+ idx)))
  result)

(defun autocats-tcalc-number (value / clean idx char valid dots signs)
  (setq clean (autocats-tcalc-clean value)
        idx 1 valid (/= clean "") dots 0 signs 0)
  (while (and valid (<= idx (strlen clean)))
    (setq char (substr clean idx 1))
    (cond
      ((wcmatch char "#"))
      ((= char ".") (setq dots (1+ dots)) (if (> dots 1) (setq valid nil)))
      ((member char '("+" "-"))
       (setq signs (1+ signs))
       (if (or (> signs 1) (/= idx 1)) (setq valid nil)))
      (T (setq valid nil)))
    (setq idx (1+ idx)))
  (if (and valid (not (member clean '("+" "-" "." "+." "-."))))
    (distof clean 2)
    nil))

(defun autocats-tcalc-calculate (value operation operand)
  (cond
    ((= operation "Add") (+ value operand))
    ((= operation "Subtract") (- value operand))
    ((= operation "Multiply") (* value operand))
    ((and (= operation "Divide") (/= operand 0.0)) (/ value operand))
    (T nil)))

(defun autocats-tcalc-locked-p (ent / data row)
  (setq data (entget ent)
        row (tblsearch "LAYER" (cdr (assoc 8 data))))
  (and row (= 4 (logand 4 (cdr (assoc 70 row))))))

(defun autocats-tcalc-apply (ent operation operand precision / data target old number result updated)
  (setq data (entget ent)
        target (assoc 1 data)
        old (if target (cdr target) "")
        number (autocats-tcalc-number old))
  (if number
    (progn
      (setq result (autocats-tcalc-calculate number operation operand))
      (if result
        (progn
          (setq updated
                (entmod
                  (subst (cons 1 (rtos result 2 precision)) target data)))
          (if updated (progn (entupd ent) T) nil))
        nil))
    nil))

(defun c:TCALC (/ *error* doc undo-open operation operand precision ss idx ent changed skipped apply-result)
  (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[TCALC] 중단: " msg)))
    (princ))

  (initget "Add Subtract Multiply Divide")
  (setq operation
        (getkword
          "\n[TCALC] 연산 선택 [더하기(Add)/빼기(Subtract)/곱하기(Multiply)/나누기(Divide)] <Add>: "))
  (if (null operation) (setq operation "Add"))
  (setq operand (getreal "\n연산할 숫자: "))
  (if (null operand)
    (princ "\n[TCALC] 연산할 숫자를 입력하지 않아 종료합니다.")
    (if (and (= operation "Divide") (= operand 0.0))
      (princ "\n[TCALC] 0으로 나눌 수 없습니다.")
    (progn
      (setq precision (getint (strcat "\n소수 자릿수 <" (itoa (getvar "DIMDEC")) ">: ")))
      (if (or (null precision) (< precision 0) (> precision 8))
        (setq precision (getvar "DIMDEC")))
      (princ "\n[TCALC] 숫자 문자를 선택하세요.")
      (setq ss (ssget '((0 . "TEXT,MTEXT,ATTRIB"))))
      (if ss
        (progn
          (setq doc (vla-get-ActiveDocument (vlax-get-acad-object))
                changed 0 skipped 0 idx 0)
          (vla-StartUndoMark doc)
          (setq undo-open T)
          (while (< idx (sslength ss))
            (setq ent (ssname ss idx))
            (if (autocats-tcalc-locked-p ent)
              (setq skipped (1+ skipped))
              (progn
                (setq apply-result
                      (vl-catch-all-apply
                        'autocats-tcalc-apply
                        (list ent operation operand precision)))
                (if (or (vl-catch-all-error-p apply-result) (null apply-result))
                  (setq skipped (1+ skipped))
                  (setq changed (1+ changed)))))
            (setq idx (1+ idx)))
          (vla-EndUndoMark doc)
          (setq undo-open nil)
          (princ (strcat "\n[TCALC] 완료: " (itoa changed)
                         "개 수정 / " (itoa skipped) "개 건너뜀")))
        (princ "\n[TCALC] 선택된 문자가 없습니다.")))))
  (princ))

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