;;; TORVA LISP - Drawing Title (torva.kr/lisp.html)
;;; DWT : pick a title type -> insertion point -> title text (yellow) with an underline (green)
;;; Types: 1 "<floor> FRAMING PLAN" / 2 "RC|STEEL COLUMN ARRANGEMENT" / 3 "<grid> LINE FRAMING ELEVATION" / 4 "FOUNDATION PLAN" / 5 custom
;;; Text = 7 x DIMSCALE (700 at 1:100), underline = 150 x DIMSCALE long, 1.5 x DIMSCALE below the text
;;; Layer TITLE, created if missing. Text uses the current text style. Last choices persist until the drawing closes

(vl-load-com)

(if (null *TV-DWT-TYPE*) (setq *TV-DWT-TYPE* "1"))
(if (null *TV-DWT-FLOOR*) (setq *TV-DWT-FLOOR* "1F"))
(if (null *TV-DWT-GRID*) (setq *TV-DWT-GRID* "Y1"))
(if (null *TV-DWT-MAT*) (setq *TV-DWT-MAT* "1"))
(setq *TV-DWT-LAYER* "TITLE")

(defun tv-dwt-ds () (if (> (getvar "DIMSCALE") 0) (getvar "DIMSCALE") 1.0))

;; getstring with a default shown as <..>
(defun tv-dwt-str (msg def / s)
  (setq s (getstring T (strcat msg " <" def ">: ")))
  (if (= s "") def s))

(defun tv-dwt-title (/ k)
  (initget "1 2 3 4 5")
  (if (setq k (getkword (strcat "\n제목 [1 평면 / 2 기둥 / 3 입면 / 4 기초 / 5 직접 입력] <" *TV-DWT-TYPE* ">: ")))
    (setq *TV-DWT-TYPE* k))
  (cond
    ((= *TV-DWT-TYPE* "1")
     (setq *TV-DWT-FLOOR* (tv-dwt-str "\n층" *TV-DWT-FLOOR*))
     (strcat (strcase *TV-DWT-FLOOR*) " FRAMING PLAN"))
    ((= *TV-DWT-TYPE* "2")
     (initget "1 2")
     (if (setq k (getkword (strcat "\n재료 [1 RC / 2 STEEL] <" *TV-DWT-MAT* ">: "))) (setq *TV-DWT-MAT* k))
     (if (= *TV-DWT-MAT* "1") "RC COLUMN ARRANGEMENT" "STEEL COLUMN ARRANGEMENT"))
    ((= *TV-DWT-TYPE* "3")
     (setq *TV-DWT-GRID* (tv-dwt-str "\n그리드" *TV-DWT-GRID*))
     (strcat (strcase *TV-DWT-GRID*) " LINE FRAMING ELEVATION"))
    ((= *TV-DWT-TYPE* "4") "FOUNDATION PLAN")
    (T (strcase (tv-dwt-str "\n제목" "TITLE"))))
)

(defun c:DWT (/ *error* old doc title pt ds rot h half gap a b)
  (setq old *error* doc (vla-get-ActiveDocument (vlax-get-acad-object)))
  (defun *error* (msg)
    (vla-EndUndoMark doc)
    (setq *error* old)
    (if (not (wcmatch (strcase msg) "*CANCEL*,*QUIT*,*BREAK*")) (princ (strcat "\nError: " msg)))
    (princ))
  (vla-StartUndoMark doc)
  (setq title (tv-dwt-title))
  (if (setq pt (getpoint (strcat "\n" title " 삽입점: ")))
    (progn
      (if (null (tblsearch "LAYER" *TV-DWT-LAYER*))
        (entmake (list '(0 . "LAYER") '(100 . "AcDbSymbolTableRecord") '(100 . "AcDbLayerTableRecord")
                       (cons 2 *TV-DWT-LAYER*) '(70 . 0) '(62 . 7) '(6 . "Continuous"))))
      ;; pt is UCS: build in UCS, trans each point to WCS, rotate with the UCS X axis
      (setq ds (tv-dwt-ds) h (* 7.0 ds) half (* 75.0 ds) gap (* 1.5 ds)
            rot (angle '(0 0 0) (trans '(1 0 0) 1 0 T))
            a (trans (list (- (car pt) half) (- (cadr pt) gap) (caddr pt)) 1 0)
            b (trans (list (+ (car pt) half) (- (cadr pt) gap) (caddr pt)) 1 0))
      (entmakex (list '(0 . "TEXT") (cons 8 *TV-DWT-LAYER*) '(62 . 2) (cons 7 (getvar "TEXTSTYLE"))
                      (cons 10 (trans pt 1 0)) (cons 11 (trans pt 1 0)) (cons 40 h) (cons 1 title) (cons 50 rot)
                      '(72 . 1) '(73 . 1)))
      (entmakex (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") (cons 8 *TV-DWT-LAYER*) '(62 . 3)
                      '(100 . "AcDbPolyline") '(90 . 2) '(70 . 0) (cons 38 (caddr a))
                      (cons 10 (list (car a) (cadr a))) (cons 10 (list (car b) (cadr b)))))
      (princ (strcat "\nTitle drawn: " title))))
  (vla-EndUndoMark doc)
  (setq *error* old)
  (princ)
)

(princ "\nTORVA Drawing Title: DWT | 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 ----