빈 레이어 확인 후 삭제 리습 (LAYPURGE)

;;; ------------------------------------------------------------
;;; AutoCATS 리습 자료실
;; 명령: LAYPURGE
;; 기능: 보호 및 참조 레이어를 제외한 빈 레이어 미리보기 후 삭제
;; 출처: https://www.autocats.co.kr/lisp/empty-layer-clean
;; 버전: 1.0 (2026-07-27)
;; 라이선스: 자유 사용·수정, 재배포 시 출처(autocats.co.kr) 표기
;; 안전: *error* 핸들러 + UNDO 그룹, 기본값은 삭제 취소
;;; ------------------------------------------------------------

(vl-load-com)

(defun autocats-lpurge-seed (/ row rows)
  (setq row (tblnext "LAYER" T) rows nil)
  (while row
    (setq rows (cons (cons (cdr (assoc 2 row)) 0) rows)
          row (tblnext "LAYER")))
  rows)

(defun autocats-lpurge-add (name rows / found)
  (if (setq found (assoc name rows))
    (subst (cons name (1+ (cdr found))) found rows)
    (cons (cons name 1) rows)))

(defun autocats-lpurge-counts (/ ss idx block-row block-name block-ent ent data layer rows)
  (setq rows (autocats-lpurge-seed)
        ss (ssget "_X")
        idx 0)
  (if ss
    (while (< idx (sslength ss))
      (setq data (entget (ssname ss idx))
            layer (cdr (assoc 8 data)))
      (if layer (setq rows (autocats-lpurge-add layer rows)))
      (setq idx (1+ idx))))
  (setq block-row (tblnext "BLOCK" T))
  (while block-row
    (setq block-name (cdr (assoc 2 block-row)))
    (if (and (null (vl-string-search "*MODEL_SPACE" (strcase block-name)))
             (null (vl-string-search "*PAPER_SPACE" (strcase block-name))))
      (progn
        (setq block-ent (tblobjname "BLOCK" block-name)
              ent (if block-ent (entnext block-ent) nil))
        (while (and ent (/= "ENDBLK" (cdr (assoc 0 (entget ent)))))
          (setq data (entget ent)
                layer (cdr (assoc 8 data)))
          (if layer (setq rows (autocats-lpurge-add layer rows)))
          (setq ent (entnext ent)))))
    (setq block-row (tblnext "BLOCK")))
  rows)

(defun autocats-lpurge-protected-p (name)
  (or (= (strcase name) "0")
      (= (strcase name) "DEFPOINTS")
      (= (strcase name) (strcase (getvar "CLAYER")))
      (vl-string-search "|" name)))

(defun autocats-lpurge-candidates (/ rows result)
  (setq rows (autocats-lpurge-counts)
        result nil)
  (foreach row rows
    (if (and (= 0 (cdr row))
             (not (autocats-lpurge-protected-p (car row))))
      (setq result (cons (car row) result))))
  (vl-sort result
    '(lambda (left right)
       (< (strcase left) (strcase right)))))

(defun autocats-lpurge-delete (names / name result deleted skipped)
  (setq deleted 0 skipped 0)
  (foreach name names
    (setq result
          (vl-catch-all-apply
            '(lambda ()
               (command "_.-PURGE" "_Layers" name "_No")
               T)))
    (if (or (vl-catch-all-error-p result) (tblsearch "LAYER" name))
      (setq skipped (1+ skipped))
      (setq deleted (1+ deleted))))
  (cons deleted skipped))

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

  (setq names (autocats-lpurge-candidates))
  (if (null names)
    (princ "\n[LAYPURGE] 삭제 가능한 빈 레이어가 없습니다.")
    (progn
      (princ (strcat "\n[LAYPURGE] 삭제 후보 " (itoa (length names)) "개"))
      (foreach name names (princ (strcat "\n  " name)))
      (initget "Yes No")
      (setq answer (getkword "\n[LAYPURGE] 위 빈 레이어를 삭제할까요? [Yes/No] <No>: "))
      (if (= answer "Yes")
        (progn
          (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
          (vla-StartUndoMark doc)
          (setq undo-open T
                result (autocats-lpurge-delete names))
          (vla-EndUndoMark doc)
          (setq undo-open nil)
          (princ (strcat "\n[LAYPURGE] 완료: " (itoa (car result))
                         "개 삭제 / " (itoa (cdr result)) "개 보호 또는 참조로 유지")))
        (princ "\n[LAYPURGE] 취소했습니다. 도면은 변경되지 않았습니다."))))
  (princ))

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