Fandom

AutoCAD

Grading calculator (AutoLISP application)

45pages on
this wiki
Add New Page
Talk0 Share

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.

UsageEdit

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.

Source codeEdit

;;; 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! ***|;

Ad blocker interference detected!


Wikia is a free-to-use site that makes money from advertising. We have a modified experience for viewers using ad blockers

Wikia is not accessible if you’ve made further modifications. Remove the custom ad blocker rule(s) and the page will load as expected.