Cross-Section Elevation + Distance Lisp

Hi

I have found attached lisp.This lisp labels any point on a cros-sections with elevetion and distance.(Please see the linked video).What i need is;

1- How can i edit this routine due to vertical scale of my cross-sections are 5 times exaggerated?

2- For every run of the command it keeps asking;

- the text size and the,

- decimal digits after coma,

- the centerline of cross-section,

- reference point of the cross-section,

- elevation of reference point.

How can i make it to keep in mind the previous entry and just hit enter to pass if i do not need to change it?

Thanks

KoMe.rar

1st thing put through google translate that will probably reveal where the scale factor is. For me its probably easier just start again.

Just me dont post RAR and going to a link and a link download some software yours is not right versions you have lost me. I just gave up on trying to get the movie.

start with something like this we use it all the time.

;Calculates level of a point in cross or long sections
; By Alan H 

(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:SRL ()
(setq olddimzin (getvar "dimzin"))
(setvar "dimzin" 0)
(if (= dwgscale nil)
(setq dwgscale (/ 1000.0 (getreal "\n enter vertical scale ")))
)
;(setq datum (getreal "\n Enter datum level "))
(setq datum (car (LM:ParseNumbers (cdr (assoc 1 (entget (car (entsel "\nPick datum text"))))))))

(setq test 1)
(setq pt1 (cadr (getpoint "\npick datum")))
(while (= test 1)

(setq pt2 (cadr (getpoint "\npick point")))

(setq dist (/(abs (- pt1 pt2)) dwgscale))

     (setq en1 (car (entsel "\nSelect text number:" )))
     (if (/= en1 nil)
       (progn
       (setq tent (entget en1))
       (setq a (+ dist datum))
       (setq a (rtos a 2 3))
       (setq el (subst (cons 1 a) (assoc 1 tent) tent))
       (entmod el)
  );progn
      (princ "\nplease pick again"); else
    );if
); while t

(setq el nil
en nil
a nil
en1 nil
test nil)

(setvar "cmdecho" 1)
(setvar "dimzin" olddimzin)
(princ)
)	;ends main defun

Just me dont post RAR and going to a link and a link download some software yours is not right versions you have lost me.

1st thing put through google translate that will probably reveal where the scale factor is. For me its probably easier just start again.

 

Just me dont post RAR and going to a link and a link download some software yours is not right versions you have lost me. I just gave up on trying to get the movie.

 

start with something like this we use it all the time.

;Calculates level of a point in cross or long sections
; By Alan H 

(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:SRL ()
(setq olddimzin (getvar "dimzin"))
(setvar "dimzin" 0)
(if (= dwgscale nil)
(setq dwgscale (/ 1000.0 (getreal "\n enter vertical scale ")))
)
;(setq datum (getreal "\n Enter datum level "))
(setq datum (car (LM:ParseNumbers (cdr (assoc 1 (entget (car (entsel "\nPick datum text"))))))))

(setq test 1)
(setq pt1 (cadr (getpoint "\npick datum")))
(while (= test 1)

(setq pt2 (cadr (getpoint "\npick point")))

(setq dist (/(abs (- pt1 pt2)) dwgscale))

     (setq en1 (car (entsel "\nSelect text number:" )))
     (if (/= en1 nil)
       (progn
       (setq tent (entget en1))
       (setq a (+ dist datum))
       (setq a (rtos a 2 3))
       (setq el (subst (cons 1 a) (assoc 1 tent) tent))
       (entmod el)
  );progn
      (princ "\nplease pick again"); else
    );if
); while t

(setq el nil
en nil
a nil
en1 nil
test nil)

(setvar "cmdecho" 1)
(setvar "dimzin" olddimzin)
(princ)
)	;ends main defun

Ok.Sorry for the mess.Your lisp looks much better.But just 1 thing;

- I also need offset distance from Center Line without any scale (1:1). Just after i pick the text for elevation, i should be asked for the text for offset distance.Negative "-" value if its on the left.No need "+" sign if it is on the right of CL.That means i also have to determine the CenterLine point.

Please check the attached screenshot.

Thank you

If you look at the code it uses a base point and compares the Y value the CADR of the pt for the X do the same but compare the CAR

(setq dwgscaley (/ 1000.0 (getreal "\n enter Vertical scale ")))
(setq dwgscalex (/ 1000.0 (getreal "\n enter Horizontal scale ")))


(setq pt2Y (cadr (getpoint "\npick point"))) ; this is Y
(setq distY (/(abs (- pt1 pt2y)) dwgscaley))
(setq pt2x (car (getpoint "\npick point"))) ; this is X
(setq distx (/(abs (- pt1 pt2x)) dwgscalex))

;Calculates level of a point in cross or long sections



(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:SRL ()
(setq olddimzin (getvar "dimzin"))
(setvar "dimzin" 0)
(if (= dwgscale nil)
(setq dwgscaley (/ 1000.0 (getreal "\n enter Vertical scale ")))
(setq dwgscalex (/ 1000.0 (getreal "\n enter Horizontal scale ")))


(setq pt2Y (cadr (getpoint "\npick point"))) ; this is Y
(setq distY (/(abs (- pt1 pt2y)) dwgscaley))
(setq pt2x (car (getpoint "\npick point"))) ; this is X
(setq distx (/(abs (- pt1 pt2x)) dwgscalex))
)
;(setq datum (getreal "\n Enter datum level "))
(setq datum (car (LM:ParseNumbers (cdr (assoc 1 (entget (car (entsel "\nPick datum text"))))))))



(setq test 1)
(setq pt1 (cadr (getpoint "\npick datum")))
(while (= test 1)

(setq pt2 (cadr (getpoint "\npick point")))

(setq dist (/(abs (- pt1 pt2)) dwgscale))

     (setq en1 (car (entsel "\nSelect text number:" )))
     (if (/= en1 nil)
       (progn
       (setq tent (entget en1))
       (setq a (+ dist datum))
       (setq a (rtos a 2 3))
       (setq el (subst (cons 1 a) (assoc 1 tent) tent))
       (entmod el)
  );progn
      (princ "\nplease pick again"); else
    );if
); while t

(setq el nil
en nil
a nil
en1 nil
test nil)

(setvar "cmdecho" 1)
(setvar "dimzin" olddimzin)
(princ)
)	;ends main defun

I tried this, but as i know nothing about lisp language, i even don't know where i made the mistake.I appreciate if you make a final magical touch.

Thank you

I looked at you movie and it can be done using what I provided but needs a rewrite. Will try to find time. Its still pick base point correct for y scale and datum then just work out X Y of new point pretty simple. It uses text style standard with no height set.

try this

;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 (/(abs (- pt1x pt2x)) dwgscalex))
(setq disty (/(abs (- pt1y pt2y)) dwgscaley))
(setq RL (+ datum disty ))

(command "-text"  (list pt2x pt2y) 2.5 0 (rtos distx 2 2))
(command "-text"  (list pt2x pt2y) 2.5 90 (rtos RL 2 2))
); while t

(setvar "cmdecho" 1)
(setvar "dimzin" olddimzin)
(princ)
)	;ends main defun

Now it seems we are just at he beginning of the thread again. Actually your lisp was way way better then I uploaded. Because I already have these elevation and offset texts on the cross-section bands. These existing values are wrong , so I have to correct them with a lisp. Becasue I have hundreds of sections and thousands of points.

So what I need is; after specifying the scales, datum and the datum text (just exactly you have done it in the last post), in order to click the elevation and offset texts (existing texts) to correct them.

However, the offset value has to be (-) signed (-214.217), if it is on the left side of the centreline and the values for both elevation and offset have to be 3 digits after coma.

Thank you very much for your kind help.

In the 1st post I did (entsel "\nSelect text number:") you need to do this twice once picking point, and use the (rtos distx 2 2) is the offset, (rtos RL 2 2) is the elevation. Try this version.

;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 (/(- pt1y pt2y) 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

In the 1st post I did (entsel "\nSelect text number:") you need to do this twice once picking point, and use the (rtos distx 2 2) is the offset, (rtos RL 2 2) is the elevation. Try this version.

 

;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 (/(abs (- pt1x pt2x)) dwgscalex))
(setq disty (/(abs (- pt1y pt2y)) 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 2)) (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 2)) (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

That's it but;

- Just could you please make values for both elevation and offset 3 digits after coma,

- And if the offset point is on the left side of the datum point it has to be - prefixed.(For example: -214.759).

Thank you

A bit of lisp home work and learning, look at link and the two commands RTOS & ABS they are the answer to your questions.

http://www.afralisp.net/reference/autolisp-functions.php

Sorry, i could not figure it out.As i told you before i know nothing about lisp language and i have not enough time to learn it because my time is already over for this task.Thank you for all your attention and help.

Code changed look carefully at (RTOS RL 2 3)and the ABS has been removed.

it seems the elevation value is wrong in this version and the offset value is not - prefixed if it is on the left side of the datum point.

Did not check will do now.

Ok it really was something that should have been obvious. I appreciate your trying to learn hence I used pt1x & pt2x for the x values of the two points, I tried to make the code some what self explanatory. I just reversed the subtraction and now it works.

(setq distx (/(- pt2x pt1x) dwgscalex))

After i fixed the "dwgscaley" also, it works perfect now.i admire you and your patience.Thank you very much king.