;;; TORVA LISP - Centerline (torva.kr/lisp.html)
;;; CL  : pick a rect polyline or two lines -> LINE through the centre, extended 15 x DIMSCALE past both ends
;;; CLX : same selection -> XLINE (infinite) through the centre
;;; Line goes on the current layer / linetype. Rect axis = its long side (first three vertices).
;;; Two lines: nearest ends are paired, midpoints joined.

(vl-load-com)

(defun tv-cl-ds ()
  (if (> (getvar "DIMSCALE") 0) (getvar "DIMSCALE") 1.0))

(defun tv-cl-mid (a b)
  (list (/ (+ (car a) (car b)) 2.0) (/ (+ (cadr a) (cadr b)) 2.0) 0.0))

;; selection -> (centre angle half-length), nil if not a rect or two lines
(defun tv-cl-axis (ss / e1 e2 pts p1 p2 p3 p4 m1 m2 c ang half)
  (cond
    ((and (= (sslength ss) 1) (= (cdr (assoc 0 (entget (ssname ss 0)))) "LWPOLYLINE"))
     (setq e1 (ssname ss 0) pts nil)
     (foreach x (entget e1) (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) c (tv-cl-mid p1 p3))
         (if (> (distance p1 p2) (distance p2 p3))
           (setq ang (angle p1 p2) half (/ (distance p1 p2) 2.0))
           (setq ang (angle p2 p3) half (/ (distance p2 p3) 2.0)))
         (list c ang half))
       (progn (princ "\nError: polyline needs 4 or more vertices") nil)))
    ((and (= (sslength ss) 2)
          (/= (cdr (assoc 0 (entget (ssname ss 0)))) "LWPOLYLINE")
          (/= (cdr (assoc 0 (entget (ssname ss 1)))) "LWPOLYLINE"))
     (setq e1 (ssname ss 0) e2 (ssname ss 1)
           p1 (vlax-curve-getStartPoint e1) p2 (vlax-curve-getEndPoint e1)
           p3 (vlax-curve-getStartPoint e2) p4 (vlax-curve-getEndPoint e2))
     (if (> (distance p1 p4) (distance p1 p3))
       (setq m1 (tv-cl-mid p1 p3) m2 (tv-cl-mid p2 p4))
       (setq m1 (tv-cl-mid p1 p4) m2 (tv-cl-mid p2 p3)))
     (list (tv-cl-mid m1 m2) (angle m1 m2) (/ (distance m1 m2) 2.0)))
    (T (princ "\nError: select one rect polyline or two lines") nil)))

(defun tv-cl-pick (/ ss)
  (princ "\n»ç°¢ Æú¸®¼± Çϳª ¶Ç´Â ¼± µÎ °³ ¼±ÅÃ: ")
  (if (not (setq ss (ssget '((0 . "LINE,XLINE,LWPOLYLINE"))))) (princ "\nNothing selected"))
  ss)

(defun c:CL (/ *error* old ss a c ang half ext)
  (setq old *error*)
  (defun *error* (msg)
    (setq *error* old)
    (if (not (wcmatch (strcase msg) "*CANCEL*,*QUIT*,*BREAK*")) (princ (strcat "\nError: " msg)))
    (princ))
  (if (and (setq ss (tv-cl-pick)) (setq a (tv-cl-axis ss)))
    (progn
      (setq c (car a) ang (cadr a) half (caddr a) ext (* 15.0 (tv-cl-ds)))
      (entmake (list '(0 . "LINE") (cons 10 (polar c (+ ang pi) (+ half ext))) (cons 11 (polar c ang (+ half ext)))))
      (princ (strcat "\nCenterline drawn, extended " (rtos ext 2 0) " each end"))))
  (setq *error* old)
  (princ))

(defun c:CLX (/ *error* old ss a c ang)
  (setq old *error*)
  (defun *error* (msg)
    (setq *error* old)
    (if (not (wcmatch (strcase msg) "*CANCEL*,*QUIT*,*BREAK*")) (princ (strcat "\nError: " msg)))
    (princ))
  (if (and (setq ss (tv-cl-pick)) (setq a (tv-cl-axis ss)))
    (progn
      (setq c (car a) ang (cadr a))
      (entmake (list '(0 . "XLINE") '(100 . "AcDbEntity") '(100 . "AcDbXline")
                     (cons 10 c) (cons 11 (list (cos ang) (sin ang) 0.0))))
      (princ "\nInfinite centerline drawn")))
  (setq *error* old)
  (princ))

(princ "\nTORVA Centerline: CL / CLX | 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 ----