;;; 중복선 삭제 - TORVA 무료 리습 (torva.kr/lisp.html)
;;; DUP : 고른 범위의 선(LINE) 가운데 같은 레이어의 다른 선에 완전히 덮인 선을 지운다
;;;       똑같이 겹친 선은 하나만 남는다. 걸쳐서 겹친 선은 합치지 않는다
;;; U 한 번이면 지운 선이 모두 돌아온다

(vl-load-com)

(setq *TV-OVERLAP-TOL* 1e-4)   ; 점이 선 위에 있다고 보는 허용 오차(도면 단위)

;; 점 p 가 선분 a-b 위에 있나
(defun tv-overlap-on (p a b)
  (<= (+ (distance a p) (distance p b)) (+ (distance a b) *TV-OVERLAP-TOL*)))

(defun c:DUP (/ *error* old doc ss lst i a b n)
  (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)) old *error*)
  (defun *error* (msg)
    (vla-EndUndoMark doc)
    (setq *error* old)
    (if (not (wcmatch (strcase msg) "*CANCEL*,*QUIT*,*BREAK*")) (princ (strcat "\n오류: " msg)))
    (princ))
  (princ "\n정리할 범위 선택: ")
  (if (setq ss (ssget '((0 . "LINE"))))
    (progn
      (vla-StartUndoMark doc)
      ;; (엔티티 레이어 시작점 끝점)
      (repeat (setq i (sslength ss))
        (setq a (entget (ssname ss (setq i (1- i)))))
        (setq lst (cons (list (cdr (assoc -1 a)) (cdr (assoc 8 a)) (cdr (assoc 10 a)) (cdr (assoc 11 a))) lst)))
      ;; ponytail: 선 N 개면 N^2 비교. 수천 개까지는 바로 끝난다
      (setq n 0)
      (while (setq a (car lst))
        (setq lst (cdr lst))
        (cond
          ;; a 가 남은 선 가운데 하나에 덮이면 a 를 지운다
          ((vl-some '(lambda (b) (and (= (strcase (cadr a)) (strcase (cadr b)))
                                      (tv-overlap-on (caddr a) (caddr b) (cadddr b))
                                      (tv-overlap-on (cadddr a) (caddr b) (cadddr b)))) lst)
           (entdel (car a)) (setq n (1+ n)))
          ;; a 가 남은 선을 덮으면 그 선들을 지우고 목록에서 뺀다
          (t
           (foreach b lst
             (if (and (= (strcase (cadr a)) (strcase (cadr b)))
                      (tv-overlap-on (caddr b) (caddr a) (cadddr a))
                      (tv-overlap-on (cadddr b) (caddr a) (cadddr a)))
               (progn (entdel (car b)) (setq n (1+ n) lst (vl-remove b lst))))))
        )
      )
      (vla-EndUndoMark doc)
      (princ (strcat "\n중복선 " (itoa n) "개 삭제"))
    )
  )
  (setq *error* old)
  (princ)
)

(princ "\n중복선 삭제: DUP / torva.kr")
(princ)

;;; ---- 단축키 바꾸기 (TVKEY) - TORVA 리습 공통, torva.kr/lisp-guide.html ----
;;; TVKEY -> 명령 -> 새 단축키. 원래 명령어도 그대로 쓴다
;;; 정한 단축키는 이 PC 에 TORVA-KEYS 로 저장되고, 리습을 불러올 때마다 되살아난다
;;; (TORVA 리습 파일마다 같은 코드가 들어 있다. 여러 개를 불러와도 같은 정의를 덮어쓸 뿐이다)

;; "A1=PY;B2=CN;" -> (("A1" . "PY") ("B2" . "CN"))
(defun tv-key-list (/ s i out)
  (setq s (cond ((getenv "TORVA-KEYS")) ("")) out nil)
  (while (setq i (vl-string-search ";" s))
    (setq out (cons (substr s 1 i) out) s (substr s (+ i 2))))
  (if (/= s "") (setq out (cons s out)))
  (vl-remove nil
    (mapcar '(lambda (x / j) (if (setq j (vl-string-search "=" x)) (cons (substr x 1 j) (substr x (+ j 2)))))
            (reverse out))))

(defun tv-key-save (lst)
  (setenv "TORVA-KEYS" (apply 'strcat (mapcar '(lambda (p) (strcat (car p) "=" (cdr p) ";")) lst))))

;; 불러온 리습 명령인가
(defun tv-key-cmd-p (cmd)
  (member (type (eval (read (strcat "C:" cmd)))) '(SUBR USUBR EXRXSUBR)))

(defun tv-key-def (key cmd)
  (eval (list 'defun (read (strcat "C:" key)) '() (list (read (strcat "C:" cmd))) '(princ))))

;; acad.pgp 에 같은 별칭이 있나 ("L,   *LINE")
(defun tv-key-pgp-p (key / f h l hit)
  (if (setq f (findfile "acad.pgp"))
    (progn
      (setq h (open f "r"))
      (while (and (not hit) (setq l (read-line h)))
        (if (and (not (wcmatch l ";*")) (wcmatch (strcase l) (strcat key ",*"))) (setq hit T)))
      (close h)))
  hit)

;; 쓸 수 없는 단축키면 까닭을, 쓸 수 있으면 nil
(defun tv-key-bad (key lst)
  (cond
    ((not (vl-every '(lambda (c) (or (<= 48 c 57) (<= 65 c 90))) (vl-string->list key))) "영문과 숫자만 씁니다")
    ((getcname key) "AutoCAD 명령과 같은 이름입니다")
    ((tv-key-pgp-p key) "AutoCAD 단축키(acad.pgp)와 같은 이름입니다")
    ((and (tv-key-cmd-p key) (not (assoc key lst))) "이미 있는 리습 명령입니다")))

(defun c:TVKEY (/ cmd key lst why)
  (setq lst (tv-key-list)
        cmd (strcase (getstring "\n단축키를 붙일 명령 [목록(?)]: ")))
  (cond
    ((= cmd ""))
    ((= cmd "?")
     (if lst
       (foreach p lst (princ (strcat "\n  " (car p) " = " (cdr p))))
       (princ "\n정한 단축키가 없습니다")))
    ((not (tv-key-cmd-p cmd)) (princ (strcat "\n" cmd " 는 불러온 리습 명령이 아닙니다")))
    (T
     (setq key (strcase (getstring (strcat "\n" cmd " 의 새 단축키 [지우기(-)]: "))))
     (cond
       ((= key ""))
       ((= key "-")
        (foreach p lst
          (if (= (cdr p) cmd) (set (read (strcat "C:" (car p))) nil)))
        (tv-key-save (vl-remove-if '(lambda (p) (= (cdr p) cmd)) lst))
        (princ (strcat "\n" cmd " 의 단축키를 지웠습니다")))
       ((= key cmd))
       ((setq why (tv-key-bad key lst)) (princ (strcat "\n" key ": " why)))
       (T
        (tv-key-save (cons (cons key cmd) (vl-remove-if '(lambda (p) (= (car p) key)) lst)))
        (tv-key-def key cmd)
        (princ (strcat "\n이제 " key " 로도 " cmd " 가 실행됩니다"))))))
  (princ))

;; 불러올 때 - 저장된 단축키 중 명령이 불러와져 있는 것을 되살린다
(foreach p (tv-key-list)
  (if (tv-key-cmd-p (cdr p)) (tv-key-def (car p) (cdr p))))
(princ "\n단축키 바꾸기: TVKEY")
(princ)