; yatay ve dikey  farkli olcek girisi yaparak referans noktasina gore
istenen noktanin  mesafesi ve kotu secilen text~in icerigini  degistirir
;
;Calculates level of a point in cross or long sections
; ver 3 change existing text
; By Alan H May 2018
(setvar "cmdecho" 0)
(princ "\n To run just type SRL")
;;-------------------=={ Parse Numbers }==--------------------;;`
;;                                                            ;;
;;  Parses a list of numerical values from a supplied string. ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  s - String to process                                     ;;
;;------------------------------------------------------------;;
;;  Returns:  List of numerical values found in string.       ;;
;;------------------------------------------------------------;;
(defun LM:ParseNumbers ( s )
(
   (lambda ( l )
     (read
       (strcat "("
         (vl-list->string
           (mapcar
             (function
               (lambda ( a b c )
                 (if
                   (or
                     (< 47 b 58)
                     (and (= 45 b) (< 47 c 58) (not (< 47 a 58)))
                     (and (= 46 b) (< 47 a 58) (< 47 c 58))
                   )
                   b 32
                 )
               )
             )
             (cons nil l) l (append (cdr l) (list nil))
           )
         )
         ")"
       )
     )
   )
   (vl-string->list s)
)
)
(defun c:SRLAB ( / dwgscalex dwgscaley datum pt1 pt2 dist pt1x  pt1y)
(setq olddimzin (getvar "dimzin"))
(setvar "dimzin" 0)
(if (= dwgscale nil)
(progn
(setq dwgscaley (/ 1000.0 (getreal "\n Enter vertical scale ")))
(setq dwgscalex (/ 1000.0 (getreal "\n Enter horizontal scale ")))
)
)
;(setq datum (getreal "\n Enter datum level "))
(setq datum (car (LM:ParseNumbers (cdr (assoc 1 (entget (car (entsel "\nPick datum text"))))))))
(setq pt1 (getpoint "\nPick datum point"))
(setq pt1y (cadr pt1))
(setq pt1x (car pt1))
(while (setq pt2  (getpoint "\npick point"))
(setq pt2y (cadr  pt2))
(setq pt2x (car pt2))
(setq distx (/(- pt2x pt1x) dwgscalex))
(setq disty (/(- pt2y pt1y) dwgscaley))
(setq RL (+ datum disty ))
(setq en1 (car (entsel "\nSelect text Offset :" )))
     (if (/= en1 nil)
       (progn
       (setq tent (entget en1))
       (setq el (subst (cons 1 (rtos distx 2 3)) (assoc 1 tent) tent))
       (entmod el)
     );progn
      (princ "\nplease pick again"); else
    );if
    (setq en1 (car (entsel "\nSelect text Elevation :" )))
     (if (/= en1 nil)
       (progn
       (setq tent (entget en1))
       (setq el (subst (cons 1 (rtos rl 2 3)) (assoc 1 tent) tent))
       (entmod el)
     );progn
      (princ "\nplease pick again"); else
    );if
); while t
(setvar "cmdecho" 1)
(setvar "dimzin" olddimzin)
(princ)
)    ;ends main defun

; yatay ve dikey  farkli olcek girisi yaparak referans noktasina gore
istenen noktanin  mesafesi ve kotu text olarak yazdirir
;
;Calculates level of a point in cross or long sections
; By Alan H May 2018
(setvar "cmdecho" 0)
(princ "\n To run just type SRLAB")
;;-------------------=={ Parse Numbers }==--------------------;;`
;;                                                            ;;
;;  Parses a list of numerical values from a supplied string. ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  s - String to process                                     ;;
;;------------------------------------------------------------;;
;;  Returns:  List of numerical values found in string.       ;;
;;------------------------------------------------------------;;
(defun LM:ParseNumbers ( s )
(
   (lambda ( l )
     (read
       (strcat "("
         (vl-list->string
           (mapcar
             (function
               (lambda ( a b c )
                 (if
                   (or
                     (< 47 b 58)
                     (and (= 45 b) (< 47 c 58) (not (< 47 a 58)))
                     (and (= 46 b) (< 47 a 58) (< 47 c 58))
                   )
                   b 32
                 )
               )
             )
             (cons nil l) l (append (cdr l) (list nil))
           )
         )
         ")"
       )
     )
   )
   (vl-string->list s)
)
)
(defun c:SRLAB ( / dwgscalex dwgscaley datum pt1 pt2 dist pt1x  pt1y)
(setq olddimzin (getvar "dimzin"))
(setvar "dimzin" 0)
(if (= dwgscale nil)
(progn
(setq dwgscaley (/ 1000.0 (getreal "\n Enter vertical scale ")))
(setq dwgscalex (/ 1000.0 (getreal "\n Enter horizontal scale ")))
)
)
;(setq datum (getreal "\n Enter datum level "))
(setq datum (car (LM:ParseNumbers (cdr (assoc 1 (entget (car (entsel "\nPick datum text"))))))))
(setq pt1 (getpoint "\nPick datum point"))
(setq pt1y (cadr pt1))
(setq pt1x (car pt1))
(while (setq pt2  (getpoint "\npick point"))
(setq pt2y (cadr  pt2))
(setq pt2x (car pt2))
(setq distx (/(- pt2x pt1x) dwgscalex))
(setq disty (/(- pt2y pt1y) dwgscaley))
(setq RL (+ datum disty ))
(command "-text"  (list pt2x pt2y) 2.5 0 (rtos distx 2 3))
(command "-text"  (list pt2x pt2y) 2.5 90 (rtos RL 2 3))
); while t
(setvar "cmdecho" 1)
(setvar "dimzin" olddimzin)
(princ)
) ;ends main defun