
(setvar "aperture" 3)
(setvar "pickbox" 3)
(setvar "blipmode" 0)
(setvar "cmdecho" 0)

;#***************  vhdim  *****************

(defun C:VHDIM (/ base dir pickmode str temp)
;
    (menucmd "s=vhdim")
    (setvar "cmdecho" 0)
    (setq pickmode 37)
    (setq temp 0)
    (setq dir "b")
    (while (and (/= dir "x") (/= dir "X"))
        (cond ((or (= dir "b") (= dir "B"))
               (setq base (getp pickmode temp "\nBase point : "))
              )
              ((or (= dir "h") (= dir "H"))
               (hdim base temp pickmode)
              )
              ((or (= dir "v") (= dir "V") (= dir ""))
               (vdim base temp pickmode)
              )
              ((or (= dir "VL") (= dir "Vl") (= dir "vL") (= dir "vl"))
               (vleader base temp pickmode)
              )
              ((or (= dir "HL") (= dir "Hl") (= dir "hL") (= dir "hl"))
               (hleader base temp pickmode)
              )
              ((or (= dir "s") (= dir "S"))
               (prompt "\nSystem variable : ")
               (setq str (getstring))
               (prompt "Enter value <")
               (prin1 (getvar str))
                (setq dir (getreal "> : "))
                (if (/= dir nil) (setvar str dir))
              )
              ((or (= dir "d") (= dir "D"))
             ;  (command "select" pause)
             (prompt "\nErase Entity")
             (setq er (ssget))
               (command "erase" er "")
              )
        )
        (prompt "\nBase/(H)(V)continuous/(H)(V)Leader/")
        (prompt "Setvar/Del/eXit <V> : ")
        (setq dir (getstring))
     )
     (menucmd "s=s")
)
;
;--------------------- vdim --------------------
;
(defun VDIM (base temp pickmode / dimlo dimx dimy dist exo n pt ptset
             txt x y msg)
    (setq msg "\nSelect object <RETURN to end> : ")
    (while (/= (setq pt (getp pickmode temp msg)) nil)
        (setq ptset (cons pt ptset))
    )
;
    (if (> (setq n (length ptset)) 0)
        (progn
               (setq dimlo (getpoint "Dim. line location : "))
               (setq txt (getvar "dimtxt"))
               (setq exo (getvar "dimexo"))
               (setq dimx (nth 0 dimlo))
               (setq dimy (nth 1 dimlo))
        )
    )
;
    (while (> n 0)
        (setq n (1- n))
        (setq x (nth 0 (nth n ptset)))
        (setq y (nth 1 (nth n ptset)))
        (setq dist (abs (- y (nth 1 base))))
        (if (minusp (- x dimx))
            (progn (setq x (+ x exo))
                   (command "line" (list x y) (list dimx y) "")
                   (command "text" (list (+ dimx (/ txt 2)) (- y (/ txt 2)))
                            txt 0.0 (rtos dist (getvar "lunits")
                            (getvar "luprec")) )
            )
            (progn (setq x (- x exo))
                   (command "line" (list x y) (list dimx y) "")
                   (command "text" "r" (list (- dimx (/ txt 2))
                   (- y (/ txt  2)))
                   txt 0.0 (rtos dist (getvar "lunits")
                   (getvar "luprec")) )
             )
        )
    )
)
;
;--------------------- hdim ----------------------
;

(defun HDIM (base temp pickmode / dimlo dimx dimy dist exo n pt ptset
             txt x y msg)
    (setq msg "\nSelect object <RETURN to end> : ")
    (while (/= (setq pt (getp pickmode temp msg)) nil)
        (setq ptset (cons pt ptset))
    )
;
    (if (> (setq n (length ptset)) 0)
        (progn
               (setq dimlo (getpoint "Dim. line location : "))
               (setq txt (getvar "dimtxt"))
               (setq exo (getvar "dimexo"))
               (setq dimx (nth 0 dimlo))
               (setq dimy (nth 1 dimlo))
        )
    )
;
    (while (> n 0)
        (setq n (1- n))
        (setq x (nth 0 (nth n ptset)))
        (setq y (nth 1 (nth n ptset)))
        (setq dist (abs (- x (nth 0 base))))
        (if (minusp (- y dimy))
            (progn (setq y (+ y exo))
                   (command "line" (list x y) (list x dimy) "")
                   (command "text" (list (+ x (/ txt 2)) (+ dimy (/ txt 2)))
                            txt 90.0 (rtos dist (getvar "lunits")
                            (getvar "luprec")) )
            )
            (progn (setq y (- y exo))
                   (command "line" (list x y) (list x dimy) "")
                   (command "text" "r" (list (+ x (/ txt 2))
                   (- dimy (/ txt  2)))
                   txt 90.0 (rtos dist (getvar "lunits")
                   (getvar "luprec")) )
             )
        )
    )
)
;
;--------------------- vleader --------------------
;
(defun VLEADER (base temp pickmode / dimlo dimx dimy dist exo  p1 p2 pt
               txt x y msg)
    (setq msg "\nSelect object <RETURN to end> : ")
    (setq txt (getvar "dimtxt"))
    (setq exo (getvar "dimexo"))
    (setq pt (getp pickmode temp msg))
;
    (while (/= pt nil)
        (while (= (setq p1 (getpoint "\nLeader line from : ")) nil))
        (while (/= (setq p2 (getpoint p1 "\nTo : ")) nil)
            (command "line" p1 p2 "")
            (setq p1 p2)
        )
        (setq dimlo (getvar "lastpoint"))
        (setq dimx (nth 0 dimlo))
        (setq dimy (nth 1 dimlo))
        (setq x (nth 0 pt))
        (setq y (nth 1 pt))
        (setq dist (abs (- y (nth 1 base))))
        (if (minusp (- x dimx))
            (command "text" (list (+ dimx (/ txt 2)) (- dimy (/ txt 2)))
                     txt 0.0 (rtos dist (getvar "lunits") (getvar
                     "luprec")))
            (command "text" "r" (list (- dimx (/ txt 2))
                                      (- dimy (/ txt 2)))
                     txt 0.0 (rtos dist (getvar "lunits") (getvar
                     "luprec")))
        )
        (setq pt (getp pickmode temp msg))
    )
)
;
;--------------------------- hleader ---------------------
;
(defun HLEADER (base temp pickmode / dimlo dimx dimy dist exo  p1 p2 pt
               txt x y msg)
    (setq msg "\nSelect object <RETURN to end> : ")
    (setq txt (getvar "dimtxt"))
    (setq exo (getvar "dimexo"))
    (setq pt (getp pickmode temp msg))
;
    (while (/= pt nil)
        (while (= (setq p1 (getpoint "\nLeader line from : ")) nil))
        (while (/= (setq p2 (getpoint p1 "\nTo : ")) nil)
            (command "line" p1 p2 "")
            (setq p1 p2)
        )
        (setq dimlo (getvar "lastpoint"))
        (setq dimx (nth 0 dimlo))
        (setq dimy (nth 1 dimlo))
        (setq x (nth 0 pt))
        (setq y (nth 1 pt))
        (setq dist (abs (- x (nth 0 base))))
        (if (minusp (- y dimy))
            (command "text" (list (+ dimx (/ txt 2)) (+ dimy (/ txt 2)))
                     txt 90.0 (rtos dist (getvar "lunits") (getvar
                     "luprec")))
            (command "text" "r" (list (+ dimx (/ txt 2))
                                      (- dimy (/ txt 2)))
                     txt 90.0 (rtos dist (getvar "lunits") (getvar
                     "luprec")))
        )
        (setq pt (getp pickmode temp msg))
    )
)
;
;-------------------- getp -----------------
;
(defun getp (pickmode temp text / pt)
(initget 0 "Pin")
(setvar "osmode" pickmode)
(setq pt (getpoint text))
(if (= pt "Pin")
    (progn
    (setvar "osmode" temp)
    (setq pt (pin))
)   )
(setvar "osmode" temp)
(if (/= pt nil) (vp pt))
(setq pt pt)
)
;
;--------------------- pin ------------------
;
(DEFUN PIN (/ P1 P2 P3 P4 TEMP L1 L2)        ;GET INTERSECTION OF TWO LINES
(SETQ L1 (CAR (ENTSEL "\nFIRST LINE : ")))
(IF (/= L1 nil)
    (PROGN
        (REDRAW L1 3)
        (SETQ TEMP (ENTGET L1))
        (SETQ P1 (CDR (ASSOC 10 TEMP)))
        (SETQ P2 (CDR (ASSOC 11 TEMP)))
;
        (SETQ L2 (CAR (ENTSEL "\nSECOND LINE : ")))
        (IF (/= L2 nil)
            (PROGN
                (REDRAW L2 3)
                (SETQ TEMP (ENTGET L2))
                (SETQ P3 (CDR (ASSOC 10 TEMP)))
                (SETQ P4 (CDR (ASSOC 11 TEMP)))
                (REDRAW L2 1)
            )
        )
        (REDRAW L1 1)
    )
)
(IF (AND (/= L1 nil) (/= L2 nil))
(INTERS P1 P2 P3 P4 nil)
)
)
;
;---------------------- vp ------------------
;
(defun vp (cen / arm l r b t)                     ;Virtual Point
;
;variable :
;
;   1. cen    : point center
;
    (setq arm (/ (getvar "viewsize") 200.0))
    (setq l (list (- (car cen) arm) (cadr cen)))
    (setq r (list (+ (car cen) arm) (cadr cen)))
    (setq b (list (car cen) (- (cadr cen) arm)))
    (setq t (list (car cen) (+ (cadr cen) arm)))
    (grdraw l r -1)
    (grdraw b t -1)
)
;

