AfraLisp Blog

The AutoLisp/Visual Lisp/VBA Resource Website

AfraLisp Blog

Home Newsletter Utter Rubbish Coding Tips AutoCAD Tips Contact Downloads WAUN

Attached is a routine similar to your Cumdist.lsp only this will calculate slope up or down and post elevation tags at selected points. This really comes in handy doing layout for plumbing drains and DI water and other piping systems that have to drain completely. I didn't write the original code, but have done my best to sort it out and clean it up along with adding the up/down routine and some additional tagging. Please feel free to share it with your readers if you desire.

Jim Exler

;;;CODING STARTS HERE
;;;SLOPE / DISTANCE
;;;Routine to calculate elevation change up or down
;;;from user entered elevation and % slope
;;;and place elev tags at selected points.
;;;Modified by Jim Exler to add new features.

(defun C:SD (/ d0 d1 e0 e1 e2 p1 p2 s0 s1 s2 t1 t2 v1 v2) ;main routine

(if (= e2 nil)
(setq e2 0.0)
);set first-time global elevation value to 0.0
(setq e0 (getdist (strcat "Starting Elevation: (" (rtos e2) ") ")))
(if (= e0 nil)
(setq e1 e2)
(setq e1 e0)
);if nil, use last elev, else use inputed
(if (= s2 nil)
(setq s2 1.0)
);set default slope to 1 %
(prompt (strcat "@ " (rtos s2 2) "%"))
(princ)
(if (= t1 nil)
(setq t1 "N")
);set default tag ? to N
(setq p2 0);gives p2 a value, if p2 ever equals nil, end routine
(setq d1 0)

(princ "\nEnter Slope %: <")
(princ s2)
(princ "> ")
(setq s0 (getREAL));get % input
(if (= s0 nil)
(setq s0 S2)
);end if
(setq S2 s0)
(setq s1 (/ s2 100));conv to decimal
(setq v1 "Y")
(setq v2 (strcase
(getstring (strcat "\nSlope Downward? Y/N [" v1 "] "))
)
);get direction of elev chg
(if (= v2 "")
(setq v2 nil)
)
(if (= v2 nil)
(setq v1 v1)
(setq v1 v2)
)
(if (= v1 "Y")
(setq direct "d")
(setq direct "u")
);set var to indicate up or down

(setq p1 (getpoint "First point: "))

;routine to determine if you want to place a tag at start elevation
(setq
t2 (strcase
(getstring (strcat "\nPlace Elevation Tag? Y/N [" t1 "] "))
)
)
(if (= t2 "")
(setq t2 nil)
)
(if (= t2 nil)
(setq t1 t1)
(setq t1 t2)
)
(if (= t1 "Y")
(progn;place tag if Yes
(command "leader" p1 pause "" (rtos e1) "")
(princ)
)
)
(if ;start if #1
(progn ;start progn #1
(while p2
(if ;start if #2 if no next pt given, exit
(setq p2 (getpoint p1 "\nNext pt: ")) ;get next point
(progn ;start progn #2
(setq d1 (+ d1 (setq d0 (distance p1 p2)))
p1 p2
)
(setq e2 (* d1 s1)) ;calculates drop from last point.
(if (= direct "d")
(setq e2 (- e1 e2))
(setq e2 (+ e1 e2)) ;subtracts or adds drop
); from last elevation.
(princ (strcat "\nDist from last pt: " (rtos d0)))
;display interim values
(princ (strcat " Cumulative dist: " (rtos d1)))
(princ (strcat "\nElevation: " (rtos e2)))
;displays elevation
; routine to determine if you want to place a tag
(setq
t2 (strcase
(getstring
(strcat "\nPlace Elevation Tag? Y/N [" t1 "] ")
)
)
)
(if (= t2 "")
(setq t2 nil)
)
(if (= t2 nil)
(setq t1 t1)
(setq t1 t2)
)
(if (= t1 "Y")
(progn ;place tag if Yes
(command "leader" p1 pause "" (rtos e2) "")
(princ)
)
)
) ;end progn #2
) ;end if #2
) ;end while
(if (/= d1 0) ;start if #3
(eval d1)
(princ)
) ;end if #3
) ;end progn #1
(princ)
) ;end if #1
;);end MD
(princ (strcat "Cumulative dist: " (rtos d1)))
;at end, display cumulative dist.
(princ (strcat "\nElevation Change: " (rtos (- e2 e1))))
;at end, displays total elevation chg.
(princ)
)

(princ)
;;;CODING ENDS HERE

The AutoLisp/Visual Lisp/VBA Resource Website

Copyright © 1999-Perpetuity by AfraLisp

All rights reserved.
Information in this document is subject to change without notice.
Site created and maintained by Kenny Ramage

The AutoLisp/Visual Lisp/VBA Resource Website