폴리선 중복 정점 정리 리습 (PLCLEAN)

;;; ------------------------------------------------------------
;;; AutoCATS 리습 자료실
;; 명령: PLCLEAN
;; 기능: 2D LWPOLYLINE의 중복 및 일직선 정점 정리
;; 출처: https://www.autocats.co.kr/lisp/polyline-clean
;; 버전: 1.0 (2026-07-27)
;; 라이선스: 자유 사용·수정, 재배포 시 출처(autocats.co.kr) 표기
;; 안전: *error* 핸들러 + UNDO 그룹, 호 및 가변 폭 폴리선 보호
;;; ------------------------------------------------------------

(vl-load-com)

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

(defun autocats-plclean-protected-geometry-p (ent / data protected)
  (setq data (entget ent) protected nil)
  (foreach pair data
    (if (or (and (= (car pair) 42) (> (abs (cdr pair)) 0.000000000001))
            (and (member (car pair) '(40 41)) (> (abs (cdr pair)) 0.000000000001)))
      (setq protected T)))
  protected)

(defun autocats-plclean-points (ent / result)
  (setq result nil)
  (foreach pair (entget ent)
    (if (= (car pair) 10)
      (setq result (cons (cdr pair) result))))
  (reverse result))

(defun autocats-plclean-remove-nth (index values / idx result)
  (setq idx 0 result nil)
  (foreach value values
    (if (/= idx index) (setq result (cons value result)))
    (setq idx (1+ idx)))
  (reverse result))

(defun autocats-plclean-duplicates (points closed tolerance / result point)
  (setq result nil)
  (foreach point points
    (if (or (null result) (> (distance point (car result)) tolerance))
      (setq result (cons point result))))
  (setq result (reverse result))
  (if (and closed (> (length result) 1)
           (<= (distance (car result) (last result)) tolerance))
    (setq result (reverse (cdr (reverse result)))))
  result)

(defun autocats-plclean-collinear-p (left middle right tolerance / cross dot)
  (setq cross
        (- (* (- (car middle) (car left)) (- (cadr right) (cadr left)))
           (* (- (cadr middle) (cadr left)) (- (car right) (car left))))
        dot
        (+ (* (- (car middle) (car left)) (- (car middle) (car right)))
           (* (- (cadr middle) (cadr left)) (- (cadr middle) (cadr right)))))
  (and (<= (abs cross) tolerance) (<= dot 0.0)))

(defun autocats-plclean-collinear (points closed tolerance / changed idx count prev next)
  (setq changed T)
  (while (and changed (> (length points) (if closed 3 2)))
    (setq changed nil idx 0 count (length points))
    (while (and (< idx count) (not changed))
      (if (and (or closed (and (> idx 0) (< idx (1- count))))
               (setq prev (nth (rem (+ idx count -1) count) points))
               (setq next (nth (rem (1+ idx) count) points))
               (autocats-plclean-collinear-p prev (nth idx points) next tolerance))
        (progn
          (setq points (autocats-plclean-remove-nth idx points)
                changed T)))
      (setq idx (1+ idx))))
  points)

(defun autocats-plclean-vertex-pairs (points / result)
  (setq result nil)
  (foreach point points
    (setq result (append result (list (cons 10 point)))))
  result)

(defun autocats-plclean-rebuild (data points / result inserted)
  (setq result nil inserted nil)
  (foreach pair data
    (cond
      ((member (car pair) '(10 40 41 42 91)))
      ((= (car pair) 90)
       (setq result (append result (list (cons 90 (length points))))))
      ((and (= (car pair) 210) (not inserted))
       (setq result
             (append result
               (autocats-plclean-vertex-pairs points)
               (list pair))
             inserted T))
      (T (setq result (append result (list pair))))))
  (if inserted
    result
    (append result (autocats-plclean-vertex-pairs points))))

(defun autocats-plclean-set-points (ent points / updated)
  (setq updated (entmod (autocats-plclean-rebuild (entget ent) points)))
  (if updated (progn (entupd ent) T) nil))

(defun autocats-plclean-apply (ent duplicate-tolerance remove-collinear
                               collinear-tolerance / closed original cleaned)
  (if (autocats-plclean-protected-geometry-p ent)
    nil
    (progn
      (setq closed (/= 0 (logand 1 (cdr (assoc 70 (entget ent)))))
            original (autocats-plclean-points ent)
            cleaned (autocats-plclean-duplicates original closed duplicate-tolerance))
      (if remove-collinear
        (setq cleaned
              (autocats-plclean-collinear cleaned closed collinear-tolerance)))
      (if (or (< (length cleaned) (if closed 3 2))
              (not (autocats-plclean-set-points ent cleaned)))
        nil
        (- (length original) (length cleaned))))))

(defun c:PLCLEAN (/ *error* doc undo-open duplicate-tolerance answer remove-collinear
                     collinear-tolerance ss idx ent result changed removed skipped)
  (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[PLCLEAN] 중단: " msg)))
    (princ))

  (initget 6)
  (setq duplicate-tolerance (getdist "\n[PLCLEAN] 중복 정점 허용거리 <0.01>: "))
  (if (null duplicate-tolerance) (setq duplicate-tolerance 0.01))
  (initget "Yes No")
  (setq answer (getkword "\n[PLCLEAN] 일직선 정점도 제거할까요? [Yes/No] <Yes>: ")
        remove-collinear (/= answer "No"))
  (if remove-collinear
    (progn
      (initget 6)
      (setq collinear-tolerance (getreal "\n[PLCLEAN] 일직선 판정 오차 <0.001>: "))
      (if (null collinear-tolerance) (setq collinear-tolerance 0.001))))
  (princ "\n[PLCLEAN] 정리할 2D LWPOLYLINE을 선택하세요.")
  (setq ss (ssget '((0 . "LWPOLYLINE"))))
  (if ss
    (progn
      (setq doc (vla-get-ActiveDocument (vlax-get-acad-object))
            idx 0 changed 0 removed 0 skipped 0)
      (vla-StartUndoMark doc)
      (setq undo-open T)
      (while (< idx (sslength ss))
        (setq ent (ssname ss idx))
        (if (or (autocats-plclean-locked-p ent)
                (null (setq result
                  (autocats-plclean-apply ent duplicate-tolerance
                    remove-collinear collinear-tolerance))))
          (setq skipped (1+ skipped))
          (progn
            (if (> result 0) (setq changed (1+ changed)))
            (setq removed (+ removed result))))
        (setq idx (1+ idx)))
      (vla-EndUndoMark doc)
      (setq undo-open nil)
      (princ (strcat "\n[PLCLEAN] 완료: " (itoa changed)
                     "개 폴리선 변경 / " (itoa removed)
                     "개 정점 제거 / " (itoa skipped) "개 건너뜀")))
    (princ "\n[PLCLEAN] 선택된 폴리선이 없습니다."))
  (princ))

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