;;; TORVA LISP - Brace Tag (torva.kr/lisp.html)
;;; BRT : select brace LINEs (window, or select them before BRT) -> one label above each crossing pair
;;;       Lines pair up only where the segments really cross mid-length (no extensions, end-to-end touches ignored)
;;;       Each line is used once
;;;       The label is centred over the crossing, above the highest end of the pair
;;; At the label prompt: Enter or Space = last label (default VB1), S = text height and gap
;;; Text height 3 x DIMSCALE (300 at 1:100), gap above the brace 0.5 x DIMSCALE (50 at 1:100). Current text style
;;; Layer BRACE-TAG (color 7), created if missing. Works in any UCS. U undoes one run

(vl-load-com)

(if (null *TV-BRT-LABEL*) (setq *TV-BRT-LABEL* "VB1"))

(defun tv-brt-ds () (if (> (getvar "DIMSCALE") 0) (getvar "DIMSCALE") 1.0))
(defun tv-brt-h () (cond (*TV-BRT-H*) ((* 3.0 (tv-brt-ds)))))
(defun tv-brt-gap () (cond (*TV-BRT-GAP*) ((* 0.5 (tv-brt-ds)))))
(defun tv-brt-n (v) (rtos v 2 (if (< (abs v) 10) 2 0)))

;; LINE end points in UCS
(defun tv-brt-ends (e / d)
  (setq d (entget e))
  (list (trans (cdr (assoc 10 d)) 0 1) (trans (cdr (assoc 11 d)) 0 1)))

;; crossing point of two segments in the UCS XY plane; nil if they miss or only touch at an end
;; (stacked braces and frame lines meet end to end - those are not crossings)
(defun tv-brt-x (a b / f ip)
  (setq f (lambda (p) (list (car p) (cadr p))))
  (if (and (setq ip (inters (f (car a)) (f (cadr a)) (f (car b)) (f (cadr b)) T))
           (not (vl-some '(lambda (p) (equal ip (f p) 1e-6)) (append a b))))
    ip))

;; label prompt; S changes height / gap and asks again
(defun tv-brt-label (/ in v lab)
  (while (null lab)
    (setq in (getstring (strcat "\nÇ¥±â ¹®ÀÚ [¼³Á¤(S)] <" *TV-BRT-LABEL* ">: ")))
    (cond
      ((= (strcase in) "S")
       (initget 6)
       (if (setq v (getdist (strcat "\n±ÛÀÚ ³ôÀÌ <" (tv-brt-n (tv-brt-h)) ">: "))) (setq *TV-BRT-H* v))
       (initget 4)
       (if (setq v (getdist (strcat "\nºê·¹À̽º À§ ¶ç¿ò <" (tv-brt-n (tv-brt-gap)) ">: "))) (setq *TV-BRT-GAP* v)))
      ((= in "") (setq lab *TV-BRT-LABEL*))
      (T (setq lab in *TV-BRT-LABEL* in))))
  lab)

(defun c:BRT (/ *error* old doc ss lab lst a b ip top tp nrm ua h i n)
  (setq old *error* doc (vla-get-ActiveDocument (vlax-get-acad-object)))
  (defun *error* (msg)
    (vla-EndUndoMark doc) (setq *error* old)
    (if (not (wcmatch (strcase msg) "*CANCEL*,*QUIT*,*EXIT*,*BREAK*")) (princ (strcat "\nError: " msg)))
    (princ))
  (vla-StartUndoMark doc)
  (if (null (setq ss (ssget "_I" '((0 . "LINE")))))
    (progn (princ "\nºê·¹À̽º ¼± ¼±ÅÃ: ") (setq ss (ssget '((0 . "LINE"))))))
  (if (and ss (setq lab (tv-brt-label)))
    (progn
      (if (null (tblsearch "LAYER" "BRACE-TAG"))
        (entmake (list '(0 . "LAYER") '(100 . "AcDbSymbolTableRecord") '(100 . "AcDbLayerTableRecord")
                       '(2 . "BRACE-TAG") '(70 . 0) '(62 . 7) '(6 . "Continuous"))))
      (setq nrm (trans '(0.0 0.0 1.0) 1 0 T)
            ua (angle '(0.0 0.0 0.0) (trans '(1.0 0.0 0.0) 1 nrm T))
            h (tv-brt-h) i 0 n 0)
      (repeat (sslength ss) (setq lst (cons (tv-brt-ends (ssname ss i)) lst) i (1+ i)))
      (setq lst (reverse lst))
      (while lst
        (setq a (car lst) lst (cdr lst)
              b (vl-some '(lambda (l) (if (tv-brt-x a l) l)) lst))
        (if b
          (progn
            (setq ip (tv-brt-x a b)
                  lst (vl-remove b lst)
                  top (max (cadar a) (cadadr a) (cadar b) (cadadr b))
                  tp (trans (list (car ip) (+ top (/ h 2.0) (tv-brt-gap)) (caddar a)) 1 nrm)
                  n (1+ n))
            (entmake (list '(0 . "TEXT") '(100 . "AcDbEntity") '(8 . "BRACE-TAG") '(100 . "AcDbText")
                           (cons 10 tp) (cons 11 tp) (cons 40 h) (cons 1 lab) (cons 50 ua)
                           (cons 7 (getvar "TEXTSTYLE")) '(72 . 1) '(73 . 2) (cons 210 nrm))))))
      (princ (if (> n 0) (strcat "\n" (itoa n) " crossings tagged " lab) "\nNo crossing lines found"))))
  (vla-EndUndoMark doc) (setq *error* old)
  (princ))

(princ "\nTORVA Brace Tag: BRT | torva.kr")
(princ)

;;; ---- TVKEY: change a shortcut - shared by every TORVA LISP (torva.kr/lisp.html) ----
;;; TVKEY -> command -> new shortcut. The original command keeps working
;;; Shortcuts are saved on this PC as TORVA-KEYS and restored whenever a TORVA LISP loads
;;; (Every TORVA LISP carries this block; loading several just redefines the same functions)

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

;; is cmd a loaded LISP command
(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))))

;; is key an alias in 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)

;; reason the key cannot be used, nil if fine
(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) "acad.pgp º°Äª°ú °°À½")
    ((and (tv-key-cmd-p key) (not (assoc key lst))) "ÀÌ¹Ì ÀÖ´Â ¸®½À ¸í·É")))

;; "My shortcuts" lines at the end of the file: (tv-my-key "A1" "BN"). Bad key -> reason only
(defun tv-my-key (key cmd / why)
  (setq key (strcase key) cmd (strcase cmd))
  (cond ((not (tv-key-cmd-p cmd)))
        ((setq why (tv-key-bad key (list (cons key cmd)))) (princ (strcat "\nShortcut " key ": " why)))
        (T (tv-key-def key cmd))))

(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 "\nNo shortcuts set")))
    ((not (tv-key-cmd-p cmd)) (princ (strcat "\n" cmd " is not a loaded LISP command")))
    (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 "\nShortcut for " cmd " removed")))
       ((= 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 " now runs " cmd))))))
  (princ))

;; on load: restore saved shortcuts whose command is loaded
(foreach p (tv-key-list)
  (if (tv-key-cmd-p (cdr p)) (tv-key-def (car p) (cdr p))))
(princ "\nTVKEY: change a shortcut | torva.kr")
(princ)

;;; ---- My shortcuts: lines set at torva.kr download land below. Edit or add lines to change them ----