;;; TORVA LISP - Beam Width (torva.kr/lisp.html)
;;; BW : type a width, click beams (4-vertex polylines) -> width changes about the centre line
;;; Long side = beam axis, short side = width. Rotated beams OK. Locked layers skipped
;;; Default width 400, last value kept until the drawing is closed

(vl-load-com)

(if (null *TV-BW-W*) (setq *TV-BW-W* 400.0))

;; T if the entity's layer is locked
(defun tv-bw-locked (en / d)
  (setq d (tblsearch "LAYER" (cdr (assoc 8 (entget en)))))
  (and d (= 4 (logand 4 (cdr (assoc 70 d))))))

;; Set the short side of a 4-vertex polyline to nw, half each side of the centre line
(defun tv-bw-set (en nw / ed pts p1 p2 p3 p4 c1 c2 hw np n out)
  (setq ed (entget en) hw (/ nw 2.0) pts nil)
  (foreach x ed (if (= (car x) 10) (setq pts (append pts (list (cdr x))))))
  (if (= (length pts) 4)
    (progn
      (setq p1 (nth 0 pts) p2 (nth 1 pts) p3 (nth 2 pts) p4 (nth 3 pts))
      (if (>= (distance p1 p2) (distance p2 p3))
        (setq c1 (mapcar '(lambda (a b) (/ (+ a b) 2.0)) p1 p4) c2 (mapcar '(lambda (a b) (/ (+ a b) 2.0)) p2 p3)
              np (list (polar c1 (angle c1 p1) hw) (polar c2 (angle c2 p2) hw) (polar c2 (angle c2 p3) hw) (polar c1 (angle c1 p4) hw)))
        (setq c1 (mapcar '(lambda (a b) (/ (+ a b) 2.0)) p1 p2) c2 (mapcar '(lambda (a b) (/ (+ a b) 2.0)) p3 p4)
              np (list (polar c1 (angle c1 p1) hw) (polar c1 (angle c1 p2) hw) (polar c2 (angle c2 p3) hw) (polar c2 (angle c2 p4) hw))))
      (setq n 0 out nil)
      (foreach x ed
        (if (= (car x) 10)
          (setq out (append out (list (cons 10 (nth n np)))) n (1+ n))
          (setq out (append out (list x)))))
      (entmod out)
      T)))

(defun c:BW (/ *error* old ce nw ss i en k skip tot)
  (setq ce (getvar "CMDECHO") old *error*)
  (defun *error* (msg)
    (setvar "CMDECHO" ce) (setq *error* old)
    (if (not (wcmatch (strcase msg) "*CANCEL*,*QUIT*,*BREAK*")) (princ (strcat "\nError: " msg)))
    (princ))
  (setvar "CMDECHO" 0)
  (setq nw (getdist (strcat "\nº¸ Æø <" (rtos *TV-BW-W* 2 0) ">: ")))
  (if (and nw (> nw 0)) (setq *TV-BW-W* nw) (setq nw *TV-BW-W*))
  (setq tot 0)
  (princ "\nº¸ ¼±Åà (¿£ÅÍ = ³¡): ")
  ;; _:S returns as soon as one pick/window is done -> beams change on each click
  (while (setq ss (ssget "_:S" '((0 . "LWPOLYLINE") (90 . 4))))
    (setq i 0 k 0 skip 0)
    (repeat (sslength ss)
      (setq en (ssname ss i) i (1+ i))
      (cond ((tv-bw-locked en) (setq skip (1+ skip)))
            ((tv-bw-set en nw) (setq k (1+ k)))))
    (setq tot (+ tot k))
    (if (> skip 0) (princ (strcat "\nLocked layer, skipped " (itoa skip))))
    (princ (strcat "\n" (itoa k) " beams set to " (rtos nw 2 0) ". º¸ ¼±Åà (¿£ÅÍ = ³¡): ")))
  (princ (strcat "\nDone: " (itoa tot) " beams set to " (rtos nw 2 0)))
  (setvar "CMDECHO" ce) (setq *error* old)
  (princ))

(princ "\nTORVA Beam Width: BW | 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 ----