Create slope with lisp Polyline (WANT TO ENHANCE)

[Prageeth]

I Have lisp for placing slope and arrow with polyline 

and i want enhance this to what i need mention in my drawing file..so i have attached lisp & sample drawing file .

and also want to enhance lisp for select all polyline at once, currently lisp select on object at once.

thanks. 

 

Slope.lsp SLOPE SAMPLE.dwg

Edited September 29, 2020 by Prageeth

[BIGAL]

Have a look at this, yes it does 1 at a time now but could be changed pretty easy to do all pline sections. Needs multi getvals takes into account hor and ver scales.Multi GETVALS.lsp

 

; 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

 

[bilalntk1]

@Prageeth 

thanks for this lisp. is there any way to change the precision to 3 numbers instead of 2?

[ronjonp]

5 hours ago, bilalntk1 said:

@Prageeth 

thanks for this lisp. is there any way to change the precision to 3 numbers instead of 2?

Change this:
(rtos z 2 2)

to this:

(rtos z 2 3)