Grading calculator (AutoLISP application)
From AutoCAD
Grading calculator (AutoLISP application) is a civil engineering application that calculates percent slopes (grades) and elevations and writes them to existing drawing text after prompting user to select drawing points and text. This is not a quick and dirty calculator, but a full featured one that interacts with a text-based grading plan drawing. The user interface has been optimized for speed and allows for arcs.
The wiki code has not been tested and may be missing functions at the moment.
If you are looking at this function, PLEASE indicate your interest by leaving a note at the Discussion link on this article.
[edit] Usage
Grading calculator consists of three command functions:
- GCS (Grade Calc Slope)
- Calculates the slope between two points along a single line or curve without any number entry. Can account for curb and gutter adjustments.
- GCR (Grade Calc Running)
- Calculates repeated elevations at a uniform slope along a single line or curve without any number entry. Can calculate multiple elevations (like curb and gutter) at each point.
- GC (Grade Calc)
- Calculates elevations from a point using multiple grade runs. Harder to set up, but powerful enough to calculate an entire parking lot row including islands with no number entry beyond initial setup.
[edit] Source code
;;; WIKI-GC-SETUP
;;; Creates a settings list for use in WIKI-GC-
;;; *WIKI-GC-SETTINGS*
;;; '((1 (Slope1 DistAdj1) ( Slope2 DistAdj2) ... (Slopei DistAdjI))(2 elevAdj1 ElevAdj2 ... ElevAdjI) (3 . gcs-distadj) (4 . gcselevadj))
;;;Set up defaults on load.
(SETQ *WIKI-GC-SETTINGS* '((1 (0.0 0.0)) (2 0.0) (3 . 0.0) (4 . 0.0)))
(DEFUN
WIKI-GC-SETUP (OPT / DISTADJI I IRUNS RISEI RUNLIST SLOPEI TARGETLIST
TOTI
)
(COND
((= OPT "Distance")
(SETQ
I 1
IRUNS
(GETINT "\nNumber of distance runs between points:")
)
(REPEAT IRUNS
(SETQ
SLOPEI
(WIKI-GC-PTOR
(GETREAL (STRCAT "\n% slope for run " (ITOA I) ": "))
)
)
(SETQ
DISTADJI
(COND
((GETDIST
(STRCAT
"\nDistance adjustment for run "
(ITOA I)
" <"
(RTOS 0 2)
">: "
)
)
)
(T 0)
)
)
(SETQ RUNLIST (CONS (LIST SLOPEI DISTADJI) RUNLIST))
(SETQ I (1+ I))
)
(SETQ
*WIKI-GC-SETTINGS*
(SUBST
(CONS 1 (REVERSE RUNLIST))
(ASSOC 1 *WIKI-GC-SETTINGS*)
*WIKI-GC-SETTINGS*
)
)
)
((= OPT "Targets")
(SETQ
I 1
TOTI (GETINT
"\nNumber of target text objects at each calculated point: "
)
)
(REPEAT TOTI
(SETQ
RISEI
(GETREAL
(STRCAT
"\nRise to add to calculated elevation for target text "
(ITOA I)
": "
)
)
)
(SETQ TARGETLIST (CONS RISEI TARGETLIST))
(SETQ I (1+ I))
)
(SETQ
*WIKI-GC-SETTINGS*
(SUBST
(CONS 2 (REVERSE TARGETLIST))
(ASSOC 2 *WIKI-GC-SETTINGS*)
*WIKI-GC-SETTINGS*
)
)
)
((= OPT "Import")
(SETQ
*WIKI-GC-SETTINGS*
(READ
(CDR
(ASSOC
1
(ENTGET
(CAR
(ENTSEL
"\nSelect text object containing settings list: "
)
)
)
)
)
)
)
)
((= OPT "Export")
(COMMAND "undo" "g")
(WIKI-MKTEXT
"L"
(GETPOINT
"Insertion point for exported settings text object: "
)
(* (GETVAR "dimscale") (GETVAR "dimtxt"))
0
(WIKI-PRIN1-TO-STRING *WIKI-GC-SETTINGS*)
)
(COMMAND "undo" "e")
)
((= OPT "Help")
(ALERT
(PRINC
(STRCAT
"Enter distances in the same order as the slopes you put in the list."
"\nMake slopes in the list plus or minus to go up or down from the reference point."
"\nCheck your answers at first to be sure you are using this tool right."
)
)
)
)
)
)
;;;WIKI-GC-ECHOOPTIONS
;;;Echos the current state of options for gradecalc
(DEFUN
WIKI-GC-ECHOOPTIONS (/ I RISE RUN)
(PRINC "\n")
(SETQ I 0)
(FOREACH
RUN (CDR (ASSOC 1 *WIKI-GC-SETTINGS*))
(PRINC
(STRCAT
"Dist "
(ITOA (SETQ I (1+ I)))
" "
(WIKI-GC-RTOP (CADR RUN))
" * "
(WIKI-GC-RTOPS (CAR RUN))
" "
)
)
)
(PRINC "\n")
(SETQ I 0)
(FOREACH
RISE (CDR (ASSOC 2 *WIKI-GC-SETTINGS*))
(PRINC
(STRCAT
"Target "
(ITOA (SETQ I (1+ I)))
" "
(WIKI-GC-RTOP RISE)
" "
)
)
)
)
(DEFUN C:GC () (C:GRADECALC))
(DEFUN
C:GRADECALC (/ DISTI ELEV1 ELEVINC ELEVTXT ELEVTXTORIG EN1 ES1 ENTLST
POINT1 POINT2 SLOPELIST
)
(WHILE (PROGN
(WIKI-GC-ECHOOPTIONS)
(INITGET "Distance Targets Export Import Help")
(SETQ
POINT1
(GETPOINT
"\nFirst point or [Distance runs/Target elevations/Export/Import/Help]: "
)
)
)
(COND
((= (TYPE POINT1) 'STR) (WIKI-GC-SETUP POINT1))
(T
(SETQ
I 0
ELEVINC 0
)
(REPEAT (LENGTH (CDR (ASSOC 1 *WIKI-GC-SETTINGS*)))
(SETQ POINT2 (GETPOINT POINT1 "\nNext point:"))
(SETQ
I (1+ I)
ELEVINC
(+ ELEVINC
(* (CAR (NTH I (ASSOC 1 *WIKI-GC-SETTINGS*)))
(+ (CADR (NTH I (ASSOC 1 *WIKI-GC-SETTINGS*)))
(SETQ DISTI (DISTANCE POINT1 POINT2))
)
)
)
POINT1 POINT2
)
)
(PRINC
(SETQ
ELEV1
(ATOF
(CADR
(WIKI-EXTRACT
(CDR
(ASSOC
1
(ENTGET
(CAR
(NENTSEL
"\nSelect reference point elevation text: "
)
)
)
)
)
)
)
)
)
)
(SETQ I 0)
(COND
((AND
(= 2 (LENGTH (ASSOC 1 *WIKI-GC-SETTINGS*)))
(PROGN
(INITGET "Slope")
(= "Slope"
(SETQ
ES1
(ENTSEL
(STRCAT
"\nSelect target point text 1 or [Slope]: "
)
)
)
)
)
)
(SETQ
ELEV2
(ATOF
(CADR
(WIKI-EXTRACT
(CDR
(ASSOC
1
(ENTGET
(CAR
(NENTSEL
"\nSelect point 2 elevation text: "
)
)
)
)
)
)
)
)
)
(SETQ
SLOPETXT
(WIKI-GC-RTOPS
(/ (ABS (- ELEV2 ELEV1))
(+ DISTI
(CADR (NTH 1 (ASSOC 1 *WIKI-GC-SETTINGS*)))
)
)
)
ENTLST
(ENTGET
(SETQ
EN1
(CAR
(ENTSEL
(STRCAT
"\nSelect slope text to change (Slope = "
SLOPETXT
"): "
)
)
)
)
)
)
(COND
(ENTLST
(COMMAND "undo" "g")
(ENTMOD (SUBST (CONS 1 SLOPETXT) (ASSOC 1 ENTLST) ENTLST))
(ENTUPD EN1)
(COMMAND "undo" "e")
)
)
)
;;If we didn't write slope, write elevation(s)
(T
(WHILE (SETQ
RISE
(NTH (SETQ I (1+ I)) (ASSOC 2 *WIKI-GC-SETTINGS*))
)
(SETQ
ELEVTXT
(RTOS (+ ELEV1 ELEVINC RISE) 2 2)
ENTLST
(ENTGET
(COND
(ES1 (SETQ EN1 (CAR ES1)))
(T
(SETQ
EN1
(CAR
(ENTSEL
(STRCAT
"\nSelect elevation text "
(ITOA I)
" to change (Elevation = "
ELEVTXT
"): "
)
)
)
)
)
)
)
)
(SETQ
ES1 NIL
ELEVTXTORIG
(WIKI-EXTRACT (CDR (ASSOC 1 ENTLST)))
)
(COMMAND "undo" "g")
(ENTMOD
(SUBST
(CONS
1
(STRCAT (CAR ELEVTXTORIG) ELEVTXT (CADDR ELEVTXTORIG))
)
(ASSOC 1 ENTLST)
ENTLST
)
)
(ENTUPD EN1)
(COMMAND "undo" "e")
)
)
)
)
)
)
(PRINC)
)
(DEFUN C:GCRS () (WIKI-GC-SETUP "Targets"))
(DEFUN
C:GCR (/ DISTI ELEV1 ELEVINC ELEVTXT ELEVTXTORIG EN1 ES1 ENTLST
POINT1 POINT2 SLOPE
)
(WIKI-GC-RECHOOPTIONS)
(PRINC " (Use GCRS (Grade Calc Running Setup) to change.)")
(SETQ
*WIKI-GC-RSLOPE*
(WIKI-GC-PTOR
(WIKI-GETREALXX
"% slope"
(WIKI-GC-RTOP *WIKI-GC-RSLOPE*)
1.9
0
)
)
)
(IF *WIKI-GC-RSLOPE*
(SETQ
ELEVSTART
(WIKI-GETREALXX
"Starting elevation"
*WIKI-GC-RELEVSTART*
NIL
1
)
)
)
(IF ELEVSTART
(SETQ PTSTART (GETPOINT "\nStarting point: "))
)
(IF PTSTART
(WIKI-GC-RLOOPRUNS *WIKI-GC-RSLOPE* ELEVSTART PTSTART)
)
)
(DEFUN
WIKI-GC-RLOOPRUNS (SLOPE ELEVSTART STARTINGPOINT)
(SETQ CURRENTELEV ELEVSTART)
;;Until user hits return, loop.
(WHILE (SETQ
CURRENTDISTANCE
(CAR
(SETQ
GDP
(WIKI-GETDISTPOINT
STARTINGPOINT
"Distance to next point"
NIL
NIL
)
)
)
)
;;Calculate elevation and write text.
(SETQ
STARTINGPOINT
(CADR GDP)
I 0
CURRENTELEV
(+ CURRENTELEV (* SLOPE CURRENTDISTANCE))
)
(WHILE (SETQ RISE (NTH (SETQ I (1+ I)) (ASSOC 2 *WIKI-GC-SETTINGS*)))
(SETQ
ELEVTXT
(RTOS (+ CURRENTELEV RISE) 2 2)
ENTLST
(ENTGET
(SETQ
EN1
(CAR
(ENTSEL
(STRCAT
"\nSelect elevation text "
(ITOA I)
" to change (Elevation = "
ELEVTXT
"): "
)
)
)
)
)
ELEVTXTORIG
(WIKI-EXTRACT (CDR (ASSOC 1 ENTLST)))
)
(COMMAND "undo" "g")
(ENTMOD
(SUBST
(CONS
1
(STRCAT (CAR ELEVTXTORIG) ELEVTXT (CADDR ELEVTXTORIG))
)
(ASSOC 1 ENTLST)
ENTLST
)
)
(ENTUPD EN1)
(COMMAND "undo" "e")
)
)
(PRINC)
)
(DEFUN
WIKI-GC-RECHOOPTIONS ()
(PRINC "\n")
(SETQ I 0)
(FOREACH
RISE (CDR (ASSOC 2 *WIKI-GC-SETTINGS*))
(PRINC
(STRCAT
"Target "
(ITOA (SETQ I (1+ I)))
" "
(WIKI-GC-RTOP RISE)
" "
)
)
)
)
;;;GCS
;;;GRADE CALC SLOPE
;;;CALC SLOPE BETWEEN TWO POINTS
(DEFUN
C:GCS (/ GCS-DIST GCS-EGSLOPETEXT GCS-ELEV1 GCS-ELEV2 GCS-ESSLOPETEXT
GCS-PNT1 GCS-RSLOPE GCS-SLOPETEXTRESPONSE GCS-STRSLOPE
)
(WHILE (AND
;;Prompt for first point
(SETQ GCS-PNT1 (GETPOINT "\nFirst point: "))
;;Prompt for first elevation
(SETQ GCS-ELEV1 (WIKI-GETREALXX "First elevation" NIL NIL 1))
;;Prompt for second point
(SETQ GCS-DIST (WIKI-GETDISTX GCS-PNT1 "Second point" NIL NIL))
;;Prompt for second elevation
(SETQ GCS-ELEV2 (WIKI-GETREALXX "Second elevation" NIL NIL 1))
;;Prompt for slope text to change
(PROGN
;;Set a dummy string value for GCS-SLOPETEXTRESPONSE
(SETQ GCS-SLOPETEXTRESPONSE "Temp")
;;Prompt for slope text or adjustment options until an entity is selected.
;;As long as user keeps choosing a keyword option, the while loop continues.
(WHILE (= 'STR (TYPE GCS-SLOPETEXTRESPONSE))
;;Calculate slope and turn into a percent text
(SETQ
GCS-RSLOPE
(/ (+ (ABS (- GCS-ELEV1 GCS-ELEV2))
;;Add elevation adjustment
(CDR (ASSOC 4 *WIKI-GC-SETTINGS*))
)
(+ GCS-DIST
;;Add distance adjustment
(CDR (ASSOC 3 *WIKI-GC-SETTINGS*))
)
)
)
(SETQ GCS-STRSLOPE (STRCAT (RTOS (* GCS-RSLOPE 100.0) 2) "%"))
;;Display the current adjustment
(PROMPT
(STRCAT
"\nCurrent slope adjustments: Distance"
(IF (MINUSP (CDR (ASSOC 3 *WIKI-GC-SETTINGS*)))
""
"+"
)
(RTOS (CDR (ASSOC 3 *WIKI-GC-SETTINGS*)) 2)
" and Elevation"
(IF (MINUSP (CDR (ASSOC 4 *WIKI-GC-SETTINGS*)))
""
"+"
)
(RTOS (CDR (ASSOC 4 *WIKI-GC-SETTINGS*)) 2)
)
)
;;Set the keywords that (entsel) will accept.
(INITGET "Off Vert Roll Custom")
(SETQ
GCS-SLOPETEXTRESPONSE
(ENTSEL
(STRCAT
"\nSlope text to change (Slope = "
GCS-STRSLOPE
") or [turn gutter adjustment Off/Vert. curb face/Roll curb back/Custom]: "
)
)
)
(WIKI-GC-SADJUST GCS-SLOPETEXTRESPONSE)
)
;;When while loop exits, save GCS-SLOPETEXTRESPONSE as GCS-ESSLOPETEXT
(SETQ GCS-ESSLOPETEXT GCS-SLOPETEXTRESPONSE)
)
)
;;Put slope in slope text
(SETQ GCS-EGSLOPETEXT (ENTGET (CAR GCS-ESSLOPETEXT)))
(ENTMOD
(SUBST
(CONS 1 GCS-STRSLOPE)
(ASSOC 1 GCS-EGSLOPETEXT)
GCS-EGSLOPETEXT
)
)
)
(PRINC)
)
(DEFUN
WIKI-GC-SADJUST (GCS-ESSLOPETEXT)
(COND
;;If user wants to turn gutter adjustment off
((= GCS-ESSLOPETEXT "Off")
;;then put gutter adjustment settings in *WIKI-GC-SETTINGS*
(SETQ
*WIKI-GC-SETTINGS*
(SUBST
(CONS 3 0.0)
(ASSOC 3 *WIKI-GC-SETTINGS*)
*WIKI-GC-SETTINGS*
)
*WIKI-GC-SETTINGS*
(SUBST
(CONS 4 0.0)
(ASSOC 4 *WIKI-GC-SETTINGS*)
*WIKI-GC-SETTINGS*
)
)
)
;;Else if user wants to turn MAG220A vert curb gutter adjustment on
((= GCS-ESSLOPETEXT "Vert")
;;then put zero adjustment settings in *WIKI-GC-SETTINGS*
(SETQ
*WIKI-GC-SETTINGS*
(SUBST
(CONS 3 -1.5)
(ASSOC 3 *WIKI-GC-SETTINGS*)
*WIKI-GC-SETTINGS*
)
*WIKI-GC-SETTINGS*
(SUBST
(CONS 4 -0.08333)
(ASSOC 4 *WIKI-GC-SETTINGS*)
*WIKI-GC-SETTINGS*
)
)
)
;;Else if user wants to turn MAG220C roll curb gutter adjustment on
((= GCS-ESSLOPETEXT "Roll")
;;then put zero adjustment settings in *WIKI-GC-SETTINGS*
(SETQ
*WIKI-GC-SETTINGS*
(SUBST
(CONS 3 -2)
(ASSOC 3 *WIKI-GC-SETTINGS*)
*WIKI-GC-SETTINGS*
)
*WIKI-GC-SETTINGS*
(SUBST
(CONS 4 -0.0625)
(ASSOC 4 *WIKI-GC-SETTINGS*)
*WIKI-GC-SETTINGS*
)
)
)
;;Else if user asked to give custom adjustment
((= GCS-ESSLOPETEXT "Custom")
;;then put custom adjustment settings in *WIKI-GC-SETTINGS*
(SETQ
*WIKI-GC-SETTINGS*
(SUBST
(CONS
3
(WIKI-GETREALX
"Distance adjustment"
(CDR (ASSOC 3 *WIKI-GC-SETTINGS*))
0.0
)
)
(ASSOC 3 *WIKI-GC-SETTINGS*)
*WIKI-GC-SETTINGS*
)
*WIKI-GC-SETTINGS*
(SUBST
(CONS
4
(WIKI-GETREALX
"Elevation adjustment"
(CDR (ASSOC 4 *WIKI-GC-SETTINGS*))
0.0
)
)
(ASSOC 4 *WIKI-GC-SETTINGS*)
*WIKI-GC-SETTINGS*
)
)
)
)
)
(DEFUN
WIKI-GC-PTOR (PERCENT)
(COND (PERCENT (/ PERCENT 100.0)))
)
(DEFUN
WIKI-GC-RTOP (REALNUM)
(COND (REALNUM (* REALNUM 100.0)))
)
(DEFUN
WIKI-GC-RTOPS (REALNUM)
(STRCAT (RTOS (* REALNUM 100.0) 2) "%")
)
(DEFUN
WIKI-GC-RTOP (REALNUM)
(STRCAT
(COND
((MINUSP REALNUM) "")
(T "+")
)
(RTOS REALNUM 2)
)
)
;|«Visual LISP© Format Options»
(72 2 40 2 nil "end of " 60 2 2 2 1 T nil nil T)
;*** DO NOT add text below the comment! ***|;
