;;; TORVA LISP - Brace Lines (torva.kr/lisp.html)
;;; BRX : two corners -> X brace inside the box, repeats until Enter
;;; BRL : selected lines -> brace lines (the original lines are replaced)
;;; Each diagonal is cut back by a gap at both ends (mode 2), or also at the middle (mode 1, default)
;;; Gap = 4 x DIMSCALE (400 at 1:100). Options 1 / 2 / 3 (gap) at the first prompt. Values persist until the drawing closes
;;; Layer BRACE, created if missing (color 4)

(vl-load-com)

(if (null *TV-BRACE-MODE*) (setq *TV-BRACE-MODE* 1))
(setq *TV-BRACE-LAYER* "BRACE")

(defun tv-brace-gap () (cond (*TV-BRACE-GAP*) ((* 4.0 (if (> (getvar "DIMSCALE") 0) (getvar "DIMSCALE") 1.0)))))
(defun tv-brace-now () (strcat "°£°Ý " (rtos (tv-brace-gap) 2 0) ", " (if (= *TV-BRACE-MODE* 1) "Áß¾Ó+´ÜºÎ" "´ÜºÎ¸¸")))

(defun tv-brace-layer ()
  (if (null (tblsearch "LAYER" *TV-BRACE-LAYER*))
    (entmake (list '(0 . "LAYER") '(100 . "AcDbSymbolTableRecord") '(100 . "AcDbLayerTableRecord")
                   (cons 2 *TV-BRACE-LAYER*) '(70 . 0) '(62 . 4) '(6 . "Continuous")))))

(defun tv-brace-line (a b)
  (entmakex (list '(0 . "LINE") (cons 8 *TV-BRACE-LAYER*) (cons 10 a) (cons 11 b))))

;; one brace between WCS points a b; nil when too short for the gaps
(defun tv-brace-one (a b / g ang m)
  (setq g (tv-brace-gap) ang (angle a b))
  (if (> (distance a b) (* g (if (= *TV-BRACE-MODE* 1) 4.2 2.1)))
    (progn
      (if (= *TV-BRACE-MODE* 1)
        (progn
          (setq m (mapcar '(lambda (x y) (/ (+ x y) 2.0)) a b))
          (tv-brace-line (polar a ang g) (polar m (+ ang pi) g))
          (tv-brace-line (polar m ang g) (polar b (+ ang pi) g)))
        (tv-brace-line (polar a ang g) (polar b (+ ang pi) g)))
      T)))

;; 1 / 2 / 3 options; returns T when a mode or gap changed
(defun tv-brace-opt (k / v)
  (cond
    ((= k "1") (setq *TV-BRACE-MODE* 1) T)
    ((= k "2") (setq *TV-BRACE-MODE* 2) T)
    ((= k "3") (if (setq v (getdist (strcat "\n°£°Ý <" (rtos (tv-brace-gap) 2 0) ">: "))) (setq *TV-BRACE-GAP* v)) T)))

(defun tv-brace-err (msg)
  (vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
  (if (not (wcmatch (strcase msg) "*CANCEL*,*QUIT*,*BREAK*")) (princ (strcat "\nError: " msg)))
  (princ))

(defun c:BRX (/ *error* old doc p1 p3 z n)
  (setq old *error* *error* tv-brace-err doc (vla-get-ActiveDocument (vlax-get-acad-object)) n 0)
  (vla-StartUndoMark doc)
  (setq p1 "")
  (while p1
    (initget "1 2 3")
    (setq p1 (getpoint (strcat "\nù ±¸¼® [1 Áß¾Ó+´ÜºÎ / 2 ´ÜºÎ¸¸ / 3 °£°Ý] <" (tv-brace-now) ">: ")))
    (cond
      ((= (type p1) 'STR) (tv-brace-opt p1))
      ((and p1 (setq p3 (getcorner p1 "\n¹Ý´ë ±¸¼®: ")))
       (tv-brace-layer)
       ;; corners are UCS: the box follows the UCS, each corner goes to WCS
       (setq z (caddr p1))
       (if (tv-brace-one (trans p1 1 0) (trans (list (car p3) (cadr p3) z) 1 0))
         (progn (tv-brace-one (trans (list (car p1) (cadr p3) z) 1 0) (trans (list (car p3) (cadr p1) z) 1 0))
                (setq n (1+ n)))
         (princ "\nBox too small for the gap, skipped")))))
  (if (> n 0) (princ (strcat "\n" (itoa n) " X brace(s) drawn (layer " *TV-BRACE-LAYER* ")")))
  (vla-EndUndoMark doc)
  (setq *error* old)
  (princ)
)

(defun c:BRL (/ *error* old doc k ss i e n skip)
  (setq old *error* *error* tv-brace-err doc (vla-get-ActiveDocument (vlax-get-acad-object)) n 0 skip 0)
  (vla-StartUndoMark doc)
  (setq k "")
  (while k
    (initget "1 2 3")
    (setq k (getkword (strcat "\n¼± ¼±Åà [1 Áß¾Ó+´ÜºÎ / 2 ´ÜºÎ¸¸ / 3 °£°Ý] <" (tv-brace-now) ">: ")))
    (tv-brace-opt k))
  ;; lines and single-segment plines; locked layers are left out by _:L
  (if (setq ss (ssget "_:L" '((-4 . "<OR") (0 . "LINE") (-4 . "<AND") (0 . "LWPOLYLINE") (90 . 2) (-4 . "AND>") (-4 . "OR>"))))
    (progn
      (tv-brace-layer)
      (setq i 0)
      (repeat (sslength ss)
        (setq e (ssname ss i) i (1+ i))
        (if (tv-brace-one (vlax-curve-getStartPoint e) (vlax-curve-getEndPoint e))
          (progn (entdel e) (setq n (1+ n)))
          (setq skip (1+ skip))))
      (princ (strcat "\n" (itoa n) " line(s) changed to brace (layer " *TV-BRACE-LAYER* ")"
                     (if (> skip 0) (strcat ", " (itoa skip) " too short, kept") "")))))
  (vla-EndUndoMark doc)
  (setq *error* old)
  (princ)
)

(princ "\nTORVA Brace Lines: BRX / BRL | 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 ----