;;; TORVA LISP - Dimension Offset (torva.kr/lisp.html)
;;; DOF : pick the base object, then the object to move, type the gap
;;;       -> the second object moves so its distance to the base is exactly the gap (X or Y)
;;; Dimension as the second object: only the dimension line moves, extension line origins stay
;;; Two objects selected before DOF: the first one is the base
;;; Gap default 10 x DIMSCALE (1000 at 1:100), drawing units, kept until the drawing closes
;;; Direction X/Y follows the current UCS. Enter = the axis where the two are farther apart
;;; Object on a locked layer is not moved. U undoes one DOF

(vl-load-com)

;; number for prompts: 2 decimals below 10 (m drawings), else whole
(defun tv-dof-n (v) (rtos v 2 (if (< (abs v) 10) 2 0)))

(defun tv-dof-ds (/ s) (setq s (getvar "DIMSCALE")) (if (> s 0) s 1.0))

(defun tv-dof-locked (e)
  (= 4 (logand 4 (cdr (assoc 70 (tblsearch "LAYER" (cdr (assoc 8 (entget e)))))))))

;; reference point (DXF 10) in UCS. WCS for the types below, OCS for the rest
;; ponytail: one point per object (line start, text insertion, dimension line point), not the extents
(defun tv-dof-pt (e / ed p)
  (setq ed (entget e) p (cdr (assoc 10 ed)))
  (cond
    ((null p) nil)
    ((= (length p) 2) (trans (list (car p) (cadr p) (cond ((cdr (assoc 38 ed))) (0.0))) e 1))
    ((member (cdr (assoc 0 ed)) '("LINE" "POINT" "DIMENSION" "MTEXT" "XLINE" "RAY" "ELLIPSE" "SPLINE" "3DFACE"))
     (trans p 0 1))
    (T (trans p e 1))))

(defun c:DOF (/ *error* old doc ce ss e1 e2 d p1 p2 dx dy dir v ed)
  (setq old *error* doc (vla-get-ActiveDocument (vlax-get-acad-object)) ce (getvar "CMDECHO"))
  (defun *error* (msg)
    (setvar "CMDECHO" ce) (vla-EndUndoMark doc) (setq *error* old)
    (if (not (wcmatch (strcase msg) "*CANCEL*,*QUIT*,*EXIT*,*BREAK*")) (princ (strcat "\nError: " msg)))
    (princ))
  (if (null *TV-DOF-GAP*) (setq *TV-DOF-GAP* (* 10.0 (tv-dof-ds))))
  (vla-StartUndoMark doc)
  (setvar "CMDECHO" 0)
  (if (and (setq ss (ssget "_I")) (>= (sslength ss) 2))
    (setq e1 (ssname ss 0) e2 (ssname ss 1))
    (and (setq e1 (car (entsel "\n±âÁØ °´Ã¼: "))) (setq e2 (car (entsel "\n¿Å±æ °´Ã¼: ")))))
  (sssetfirst nil nil)
  (cond
    ((not (and e1 e2)) nil)
    ((eq e1 e2) (princ "\nPick two different objects"))
    ((tv-dof-locked e2) (princ "\nLocked layer, skipped"))
    ((not (and (setq p1 (tv-dof-pt e1)) (setq p2 (tv-dof-pt e2)))) (princ "\nNo base point on the object"))
    (T
     (initget 6)
     (if (setq d (getdist (strcat "\n°£°Ý <" (tv-dof-n *TV-DOF-GAP*) ">: "))) (setq *TV-DOF-GAP* d))
     (setq dx (- (car p2) (car p1)) dy (- (cadr p2) (cadr p1)))
     (initget "X Y")
     (setq dir (cond ((getkword "\n¹æÇâ [X/Y] <ÀÚµ¿>: ")) ((> (abs dx) (abs dy)) "X") ("Y")))
     ;; UCS displacement that puts p2 exactly gap away from p1, on the side it already is
     (setq v (if (= dir "X")
               (list (- (+ (car p1) (if (> dx 0) *TV-DOF-GAP* (- *TV-DOF-GAP*))) (car p2)) 0.0 0.0)
               (list 0.0 (- (+ (cadr p1) (if (> dy 0) *TV-DOF-GAP* (- *TV-DOF-GAP*))) (cadr p2)) 0.0)))
     (setq ed (entget e2))
     (if (= (cdr (assoc 0 ed)) "DIMENSION")
       (entmod (subst (cons 10 (mapcar '+ (cdr (assoc 10 ed)) (trans v 1 0 T))) (assoc 10 ed) ed))
       (command "_.MOVE" e2 "" "_non" '(0.0 0.0 0.0) "_non" v))
     (princ (strcat "\nGap " (tv-dof-n *TV-DOF-GAP*) " (" dir ")"))))
  (setvar "CMDECHO" ce)
  (vla-EndUndoMark doc) (setq *error* old)
  (princ))

(princ "\nTORVA Dimension Offset: DOF | 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 ----