;;; TORVA LISP - Angle Dimension (torva.kr/lisp.html)
;;; AGD : pick two lines -> angular dimension at the intersection of their extensions
;;;       (works when the lines do not touch, and for XLINE / RAY)
;;; T (text height) before the first line. Default 3.5 x DIMSCALE (350 at 1:100). Value persists until the drawing closes
;;; Layer DIM (color 7), created if missing. Dimension style = current

(vl-load-com)

(if (null *TV-AGD-TEXT*) (setq *TV-AGD-TEXT* 3.5))
(setq *TV-AGD-LAYER* "DIM")

;; pick a LINE / XLINE / RAY; T changes text height, Enter = nil
(defun tv-agd-pick (msg allow-t / e v)
  (setq e "T")
  (while (= (type e) 'STR)
    (if allow-t (initget "T"))
    (setq e (entsel msg))
    (cond
      ((= e "T")
       (if (setq v (getdist (strcat "\n±ÛÀÚ Å©±â <" (rtos *TV-AGD-TEXT* 2 1) ">: "))) (setq *TV-AGD-TEXT* v)))
      ((and e (not (wcmatch (cdr (assoc 0 (entget (car e)))) "LINE,XLINE,RAY")))
       (princ "\nNot a line")
       (setq e "T"))
    )
  )
  e
)

;; nearest point on the picked line (UCS pick -> WCS)
(defun tv-agd-on (sel)
  (vlax-curve-getClosestPointTo (car sel) (trans (cadr sel) 1 0) T))

;; picked on the vertex -> step 1 unit along the line so the 3 points differ (UCS in, UCS out)
(defun tv-agd-off (en ip p)
  (if (equal ip p 1e-6)
    (polar ip (angle '(0 0 0) (trans (vlax-curve-getFirstDeriv en (vlax-curve-getParamAtPoint en (trans p 1 0))) 0 1 T)) 1.0)
    p))

(defun c:AGD (/ *error* old doc ce lay s1 s2 o1 o2 ip p1 p2 last new obj)
  (setq ce (getvar "CMDECHO") lay (getvar "CLAYER") old *error*
        doc (vla-get-ActiveDocument (vlax-get-acad-object)))
  (defun *error* (msg)
    (setvar "CMDECHO" ce) (setvar "CLAYER" lay)
    (vla-EndUndoMark doc)
    (setq *error* old)
    (if (not (wcmatch (strcase msg) "*CANCEL*,*QUIT*,*BREAK*")) (princ (strcat "\nError: " msg)))
    (princ))
  (setvar "CMDECHO" 0)
  (vla-StartUndoMark doc)
  (if (and (setq s1 (tv-agd-pick (strcat "\nù ¹ø° ¼± [±ÛÀÚ Å©±â(T)] <" (rtos *TV-AGD-TEXT* 2 1) ">: ") T))
           (setq s2 (tv-agd-pick "\nµÎ ¹ø° ¼±: " nil)))
    (progn
      (setq o1 (vlax-ename->vla-object (car s1)) o2 (vlax-ename->vla-object (car s2))
            ip (vlax-invoke o1 'IntersectWith o2 3)) ; 3 = extend both
      (if (< (length ip) 3)
        (princ "\nParallel lines, no intersection")
        (progn
          (setq ip (trans (list (car ip) (cadr ip) (caddr ip)) 0 1)
                p1 (trans (tv-agd-on s1) 0 1)
                p2 (trans (tv-agd-on s2) 0 1))
          (setq p1 (tv-agd-off (car s1) ip p1) p2 (tv-agd-off (car s2) ip p2))
          (if (null (tblsearch "LAYER" *TV-AGD-LAYER*))
            (entmake (list '(0 . "LAYER") '(100 . "AcDbSymbolTableRecord") '(100 . "AcDbLayerTableRecord")
                           (cons 2 *TV-AGD-LAYER*) '(70 . 0) '(62 . 7) '(6 . "Continuous"))))
          (setvar "CLAYER" *TV-AGD-LAYER*)
          (setq last (entlast))
          ;; Enter at "select arc" = 3-point mode: vertex, point on line 1, point on line 2, then drag
          (princ "\nÄ¡¼ö À§Ä¡: ")
          (command "_.DIMANGULAR" "" "_non" ip "_non" p1 "_non" p2 pause)
          (setq new (entlast))
          (if (and (not (eq last new)) (= (cdr (assoc 0 (entget new))) "DIMENSION"))
            (progn
              (setq obj (vlax-ename->vla-object new))
              ;; text height is multiplied by DIMSCALE when drawn
              (vl-catch-all-apply 'vla-put-TextHeight (list obj *TV-AGD-TEXT*))
              (princ (strcat "\nAngle " (rtos (* (cdr (assoc 42 (entget new))) (/ 180.0 pi)) 2 2) " deg"))))
        )
      )
    )
  )
  (setvar "CMDECHO" ce) (setvar "CLAYER" lay)
  (vla-EndUndoMark doc)
  (setq *error* old)
  (princ)
)

(princ "\nTORVA Angle Dimension: AGD | 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 ----