;;; TORVA LISP - Even Lines (torva.kr/lisp.html)
;;; EQL : pick two LINEs, enter a count n -> n lines evenly spaced between them (n + 1 equal gaps)
;;; Each new line is a copy of the longer line (length, direction, layer, linetype, color, lineweight)
;;; moved toward the shorter one, so the midpoints are equally spaced. Line direction does not matter.
;;; Settings: none. The last count is remembered as the default. One U undoes the whole command.

(vl-load-com)

(defun tv-eql-mid (a b) (mapcar '(lambda (x y) (/ (+ x y) 2.0)) a b))

;; group codes copied from the longer line: linetype, layer, thickness, ltscale, color, space,
;; extrusion, lineweight, layout, true color, color book, transparency
(defun tv-eql-props (ed / out)
  (foreach x ed
    (if (member (car x) '(6 8 39 48 62 67 210 370 410 420 430 440)) (setq out (cons x out))))
  (reverse out))

(defun c:EQL (/ *error* doc ss n d1 d2 lng sht p1 p2 step props off q1 q2 i k cur)
  (setq doc (vla-get-activedocument (vlax-get-acad-object)))
  (defun *error* (msg)
    (vla-EndUndoMark doc)
    (if (not (wcmatch (strcase msg) "*CANCEL*,*QUIT*,*BREAK*")) (princ (strcat "\nError: " msg)))
    (princ))
  (vla-StartUndoMark doc)
  (if (not *TV-EQL-N*) (setq *TV-EQL-N* 2))
  ;; ask again until exactly two lines (Enter = quit)
  (while (and (progn (princ "\nµÎ ¼± ¼±ÅÃ: ") (setq ss (ssget '((0 . "LINE")))))
              (/= (sslength ss) 2))
    (princ (strcat "\nSelect exactly 2 lines (" (itoa (sslength ss)) " found)"))
    (sssetfirst nil nil))
  (if ss
    (progn
      (initget 6)
      (if (setq n (getint (strcat "\n¼± °³¼ö <" (itoa *TV-EQL-N*) ">: ")))
        (setq *TV-EQL-N* n)
        (setq n *TV-EQL-N*))
      ;; points from entget are WCS, so no UCS conversion is needed
      (setq d1 (entget (ssname ss 0)) d2 (entget (ssname ss 1)))
      (if (>= (distance (cdr (assoc 10 d1)) (cdr (assoc 11 d1)))
              (distance (cdr (assoc 10 d2)) (cdr (assoc 11 d2))))
        (setq lng d1 sht d2)
        (setq lng d2 sht d1))
      (setq p1 (cdr (assoc 10 lng)) p2 (cdr (assoc 11 lng))
            step (mapcar '(lambda (s l) (/ (- s l) (1+ n)))
                         (tv-eql-mid (cdr (assoc 10 sht)) (cdr (assoc 11 sht)))
                         (tv-eql-mid p1 p2)))
      (if (< (distance '(0 0 0) step) 1e-8)
        (princ "\nThe two lines share the same midpoint, nothing added")
        (progn
          (setq props (tv-eql-props lng) i 1 k 0 cur 0)
          (repeat n
            (setq off (mapcar '(lambda (x) (* x i)) step)
                  q1 (mapcar '+ p1 off)
                  q2 (mapcar '+ p2 off))
            (cond
              ((entmake (append '((0 . "LINE")) props (list (cons 10 q1) (cons 11 q2)))) (setq k (1+ k)))
              ;; layer refused the new line -> put it on the current layer
              ((entmake (list '(0 . "LINE") (cons 10 q1) (cons 11 q2))) (setq k (1+ k) cur (1+ cur))))
            (setq i (1+ i)))
          (princ (strcat "\n" (itoa k) (if (= k 1) " line added" " lines added")))
          (if (> cur 0) (princ (strcat ", " (itoa cur) " on the current layer")))))))
  (vla-EndUndoMark doc)
  (princ)
)

(princ "\nTORVA Even Lines: EQL | 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 ----