LISP for SLOPE from text

[Anonymous]

Need a LISP to calculate slope in ‰ from selection a to elevation (text number 0.00) and a distance  (text number 0.00) and paste to another txt and the result to be 0.00‰
the excel function is =((A3-B3)/C3)*1000 where A3 is elevation 1, B3 elevation 2, C3 is horizontal distance

Thnks!

[hak_vz]

Post sample drawing for easier work, and explain  how you want slope to be calculated

[Anonymous]

[hak_vz · Accepted solution]

(defun c:slopetext ( / h1 h2 d slp st);
(while (not h1)(setq h1 (car(entsel "\nSelect first elevation text >"))))
(while (not h2)(setq h2 (car(entsel "\nSelect second elevation text >"))))
(while (not d)(setq d (car(entsel "\nSelect distance text >"))))
(setq h1 (atof(cdr (assoc 1 (entget h1)))))
(setq h2 (atof(cdr (assoc 1 (entget h2)))))
(setq d (atof(cdr (assoc 1 (entget d)))))
(setq slp (rtos (* 1000.0 (/ (- h1 h2) d)) 2 2))
(setq slp (strcat slp " \U+2030"))
(while (not st)(setq st (car(entsel "\nSelect slope text to modify >"))))
(setq st (entget st))
(setq st (subst (cons 1 slp) (assoc 1 st) st))
(setq st (entmod st))
(princ)
)

Here you have initial version.

[Anonymous]

Works Great! Tanks a lot! 

"of topic... from what materials did you learn coding lisps?"

[hak_vz]

There is a lot of good sources on the internet, just Google for "learn autolisp".

You may start at Afralisp    Use Acad developer documentation in HELP

I would start coding in notepad++ editor since it has option to automatically close open parentheses "( )" and vlide editor in ACAD for error handling. Stay active in this forum and ask what ever you need to be cleared, you will always receive an explanation.  Autolisp seams complicated but is relatively easy to learn.

In my work I sometime have to create sections with stations and road segments. With lisp creation of the table is easy to automate so you don't have to pick and edit texts It can all be done in few seconds with full precision. For a start my code will be more than useful, but you have to look for complete solution. There is a lot of lisp codes that do that already written and some of them on this forum. 

[Sea-Haven]

This will do label based on picking line or pline segment and takes into account a vertical and horizontal scale.

; xfall as a percentage 
; Modified to work with plines 
; By Alan H July 2017
 
;(defun trap (errmsg)
;  (prompt "\nAn error has occured.")
;  (command "undo" "b")
;  (setvar "osmode" os)
;  (setq *error* temperr)
;)
 
(defun rtd (a)(/ (*  a 180.0) pi))

(setvar "TEXTSTYLE" "STANDARD")
; cross fall as a percentage 
; modified to recognise a pline
; By Alan H July 2017
(defun c:xfallper ( / pt1 pt2 pt3 pt4 ans pr pt1x pt1y pt2x pt2 ans) 
(setvar "cmdecho" 0)
 
(SETQ ANGBASEE (GETVAR "ANGBASE"))
(SETQ ANGDIRR (GETVAR "ANGDIR"))
(SETQ LUNITSS (GETVAR "LUNITS"))
(SETQ LUPRECC (GETVAR "LUPREC"))
(SETQ AUNITSS (GETVAR "AUNITS"))
(SETQ AUPRECC (GETVAR "AUPREC"))
 
(SETVAR "LUNITS" 2)
(SETVAR "ANGBASE" 0.0)
(SETVAR "ANGDIR" 0)
(SETVAR "LUPREC" 3)
(SETVAR "AUNITS" 3)
(SETVAR "AUPREC" 3)
 
(setq os (getvar "osmode"))
(setvar "osmode" 0)
 
(if (= horiz nil)
(progn
(if (not AH:getvalsm)(load "Multi getvals"))
(setq ans (ah:getvalsm (list "Xfall per by %" "Enter Horizontal scale " 5 4 "100" "Enter Vertical scale" 5 4 "50" "Enter number of decimal places" 5 4 "2")))
(setq horiz (atof (nth 0 ans)))
(setq vert (atof (nth 1 ans)))
(setq prec (atoi (nth 2 ans)))
)
)
 
(alert "Pick lines or plines")
 
(while (setq s (entsel "Select line pick nothing to exit"))
(setq objname (cdr (assoc 0 (entget (car s)))))
 
(if (=  objname  "LWPOLYLINE")
(progn
(setq pr (vlax-curve-getparamatpoint (car s) (setq p (vlax-curve-getclosestpointto (car s) (cadr s)))))
(setq pt1 (vlax-curve-getpointatparam (car s) (fix pr)))
(setq pt2 (vlax-curve-getpointatparam (car s) (1+ (fix pr))))
(setq found "Y")
)
)
 
(if (=  objname  "LINE")
(progn
(setq pt1 (cdr (assoc 10 (entget (car s)))))
(setq pt2 (cdr (assoc 11 (entget (car s)))))
(setq found "Y")
)
)
 
(if (= Found nil)
(progn
(alert "Do again object has no slope")
(exit)
)
)
 
(setq pt1x (car pt1))
(setq pt1y (cadr pt1))
(setq pt2x (car pt2))
(setq pt2y (cadr pt2))
 
(setq ydist (abs (- pt1y pt2y)))
(setq xdist (abs (- pt1x pt2x)))
(setq xfall (strcat (rtos  (* (/ (* ydist vert) (* xdist horiz)) 100) 2 prec) "%") )
(setq ang (angle pt1 pt2))
(setq dist (distance pt1 pt2))
(if (> dist 0)
(progn 
(setq halfdist (/ dist 2))
(setq pt3 (polar pt1 ang halfdist))
(if (> ang pi) (setq ang (- ang pi)))
(if (> ang (/ pi 2)) (setq pt4ang (- ang (/ pi 2))) (setq pt4ang (+ ang (/ pi 2))))
(setq pt4 (polar pt3 pt4ang 0.75))
(if (> ang (/ pi 2)) (setq ang (+ ang pi)))
)
)

(setq cursty (getvar 'textstyle))
(setq tsty (vla-get-textstyles (vla-get-activedocument (vlax-get-acad-object))))
(vlax-for ent tsty
(if (= (vla-get-name ent) cursty)
(setq txtht (vla-get-height ent))
)
)

(if (= txtht 0.0)
(command "TEXT" pt4 2.5 ang xfall)
(command "TEXT" pt4 ang xfall )
)

(setq s nil)
 
) 
;  (setvar "DIMZIN" dimz)
(setvar "cmdecho" 1)
(setvar "osmode" os)
;  (setq *error* temperr)
(SETVAR "LUNITS" lunitss)
(SETVAR "ANGBASE" angbasee)
(SETVAR "ANGDIR" angdirr)
(SETVAR "LUPREC" luprecc)
(SETVAR "AUNITS" aunitss)
(SETVAR "AUPREC" auprecc)

 
(princ)
) ;defun

section