숫자 문자 반올림 리습 (TROUND)

;;; AutoCATS 리습 자료실
;; 명령: TROUND
;; 기능: 숫자로만 된 TEXT를 지정한 소수 자리로 반올림합니다.
;; 출처: https://www.autocats.co.kr/lisp/text-round
;; 버전: 1.0 (2026-10-23)
;; 라이선스: 자유 사용·수정, 재배포 시 출처(autocats.co.kr) 표기
;; 안전: 잠긴 레이어·외부참조 보호, 변경은 UNDO 그룹, 명령별 범위는 상세 가이드 참고

(vl-load-com)

(defun autocats-tround-safe-p (ent / data row block)
  (setq data (entget ent)
    row (tblsearch "LAYER" (cdr (assoc 8 data))))
  (and data row (= 0 (logand 4 (cdr (assoc 70 row))))
    (or (/= "INSERT" (cdr (assoc 0 data)))
      (and (setq block (tblsearch "BLOCK" (cdr (assoc 2 data))))
        (= 0 (logand 12 (cdr (assoc 70 block))))))))

(defun autocats-tround-replace-pair (code value data)
  (if (assoc code data) (subst (cons code value) (assoc code data) data)
    (append data (list (cons code value)))))

(defun autocats-tround-put (ent property value / data)
  (if (autocats-tround-safe-p ent)
    (progn
      (setq data (autocats-tround-replace-pair 1 value (entget ent)))
      (if (entmod data) (progn (entupd ent) T)))))

(defun autocats-tround-get (ent property)
  (cdr (assoc 1 (entget ent))))

(defun autocats-tround-batch (selection action / index changed skipped ent result)
  (setq index 0 changed 0 skipped 0)
  (if selection
    (repeat (sslength selection)
      (setq ent (ssname selection index)
        result (if (autocats-tround-safe-p ent) (vl-catch-all-apply action (list ent))))
      (if (and result (not (vl-catch-all-error-p result)))
        (setq changed (1+ changed))
        (setq skipped (1+ skipped)))
      (setq index (1+ index))))
  (princ (strcat "\n[TROUND] 완료: " (itoa changed) " / 건너뜀: " (itoa skipped)))
  (list changed skipped))

(defun autocats-tround-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-tround-number (value / clean idx char valid dots signs)
  (setq clean (autocats-tround-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-tround-round (value precision / factor scaled)
  (setq factor (expt 10.0 precision) scaled (* (abs value) factor))
  (* (if (< value 0.0) -1.0 1.0) (/ (- (+ scaled 0.5 0.000000001) (rem (+ scaled 0.5 0.000000001) 1.0)) factor)))
(defun autocats-tround-apply (ent precision / number)
  (and (= "TEXT" (cdr (assoc 0 (entget ent))))
    (setq number (autocats-tround-number (autocats-tround-get ent 'TextString)))
    (autocats-tround-put ent 'TextString (rtos (autocats-tround-round number precision) 2 precision))))

(defun c:TROUND (/ *error* undo-open precision 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[TROUND] 중단: " msg)))
    (princ))

  (initget 5) (setq precision (getint "\n소수 자릿수 0~8: "))
  (if (and precision (<= precision 8)) (progn
      (princ "\n대상 객체를 선택하세요: ")
      (setq selection (ssget '((0 . "TEXT"))))
      (if selection
        (progn
          (command "_.UNDO" "_Begin")

          (setq undo-open T)
          (autocats-tround-batch selection '(lambda (ent) (autocats-tround-apply ent precision)))
          (command "_.UNDO" "_End")
          (setq undo-open nil)))))
  (princ))

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