;;; ------------------------------------------------------------ ;;; 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] : ") 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)