;;; 파단선 - TORVA 무료 리습 (torva.kr/lisp.html)
;;; BKL : 두 점 사이에 가운데가 번개 모양으로 꺾인 파단선(폴리선)을 그린다
;;; 시작점을 찍기 전에 S 로 선 두께와 번개 크기를 바꾼다. 바꾼 값은 도면을 닫을 때까지 유지된다
;;; 번개 크기 기본값 = 3.5 x DIMSCALE (1:100 도면이면 350). 선 두께 기본값 0. 레이어는 BREAK (없으면 만든다)
;;; 두 점 사이가 번개 크기의 두 배보다 짧으면 번개를 줄여 그린다

(vl-load-com)

(if (null *TV-BREAKLINE-WIDTH*) (setq *TV-BREAKLINE-WIDTH* 0.0))
(setq *TV-BREAKLINE-LAYER* "BREAK")

;; 번개 크기 - 직접 정한 값이 없으면 도면 축척에 맞춘다
(defun tv-breakline-size ()
  (cond (*TV-BREAKLINE-SIZE*)
        ((> (getvar "DIMSCALE") 0) (* 3.5 (getvar "DIMSCALE")))
        (3.5)))

(defun c:BKL (/ *error* old osm lay p1 p2 v ang dist sz half p3 p4 p5 p6)
  (setq osm (getvar "OSMODE") lay (getvar "CLAYER") old *error*)
  (defun *error* (msg)
    (setvar "OSMODE" osm) (setvar "CLAYER" lay) (setvar "CMDECHO" 1)
    (setq *error* old)
    (if (not (wcmatch (strcase msg) "*CANCEL*,*QUIT*,*BREAK*")) (princ (strcat "\n오류: " msg)))
    (princ))
  (setvar "CMDECHO" 0)
  (setq p1 "S")
  (while (= p1 "S")
    (initget "S")
    (setq p1 (getpoint (strcat "\n시작점 [설정(S)] <두께 " (rtos *TV-BREAKLINE-WIDTH* 2 1)
                               ", 번개 " (rtos (tv-breakline-size) 2 0) ">: ")))
    (if (= p1 "S")
      (progn
        (if (setq v (getdist (strcat "\n선 두께 <" (rtos *TV-BREAKLINE-WIDTH* 2 1) ">: "))) (setq *TV-BREAKLINE-WIDTH* v))
        (if (setq v (getdist (strcat "\n번개 크기 <" (rtos (tv-breakline-size) 2 0) ">: "))) (setq *TV-BREAKLINE-SIZE* v)))))
  (if (and p1 (setq p2 (getpoint p1 "\n끝점: ")))
    (progn
      (setq ang (angle p1 p2) dist (distance p1 p2) sz (tv-breakline-size))
      (if (< dist (* 2.0 sz)) (setq sz (/ dist 3.0)))
      (setq half (/ dist 2.0)
            p3 (polar p1 ang (- half (/ sz 2.0)))
            p4 (polar p3 (+ ang (* pi 0.45)) sz)
            p6 (polar p1 ang (+ half (/ sz 2.0)))
            p5 (polar p6 (- ang (* pi 0.45)) sz))
      (if (null (tblsearch "LAYER" *TV-BREAKLINE-LAYER*))
        (entmake (list '(0 . "LAYER") '(100 . "AcDbSymbolTableRecord") '(100 . "AcDbLayerTableRecord")
                       (cons 2 *TV-BREAKLINE-LAYER*) '(70 . 0) '(62 . 2) '(6 . "Continuous"))))
      (setvar "CLAYER" *TV-BREAKLINE-LAYER*)
      (setvar "OSMODE" 0)
      (command "_.PLINE" p1 "_W" *TV-BREAKLINE-WIDTH* *TV-BREAKLINE-WIDTH* p3 p4 p5 p6 p2 "")
    )
  )
  (setvar "OSMODE" osm) (setvar "CLAYER" lay) (setvar "CMDECHO" 1)
  (setq *error* old)
  (princ)
)

(princ "\n파단선: BKL / 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)