Calculate elevations above grade along lines that are not orthogonal to the slope of the deck or roof.

elevations.lsp

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;Elevation command
;;Type EV to run this command
;;Triangulates the elevation of a point between two other points of known elevations
;;useful for calculating BOD and other deck elevation related measurements
;;Type "ELEVATION" to run this routine
;;1/27/2008 Written by Joe C.
;;1/29/2008 streamlined data entry to require less keyboard usage
;;2/15/2008 streamlined data entry some more (added loop through unknown point entry)
;;2/20/2008 changed to accept architectural input rather than just decimal feet
;;	    Also added more direct link to rounder program
;;4/14/2008 Changed name of command from Elevation to EV to resolve conflict with existing
;;		AutoCad 'elevation' variable.
;;9/12/2008 Added error handler to reset variables on error or cancel. Also added option for
;;              text to be inserted at the calculated z coordinate.
;;10/31/2008 Cleaned up options process and added options for adding and subtracting distances
;;		from the overall result
(defun c:EV(/ e1a     e2a     p1      p2      p3      p1a     p2a
	      p3a     e3      dst1    dst2    dstratio	      echange
	      theecho thelayer	      stop    ztext AcadObject ActiveDoc ModelSpace theText theOption thePrompt
	     )
  ;initial variable setup
  (setq theecho (getvar "cmdecho"))
  (setq thelayer (getvar "clayer"))
  ;setup error handler
  (defun *error*(msg)
    (setvar "CMDECHO" theecho)
    (setvar "CLAYER" thelayer)
  )
  ;load the object model
  (vl-load-com)
  (setq AcadObject (vlax-get-acad-object)
	ActiveDoc (vla-get-activedocument AcadObject)
	ModelSpace (vla-get-modelspace ActiveDoc)
  );_setq
  ;if in paperspace, set to modelspace
  (if (= (getvar "TILEMODE") 0)
    (setvar "TILEMODE" 1)
  );_if
  ;(prompt
  ;  "\n'ELEVATION1' calculates unknown elevation points on a line between any two known elevation points, and labels the new elevation on the 'no print' layer."
  ;)
  ;(prompt
  ;  "\nUse the 'ROUNDER' routine to round decimal feet text to nearest half inch after labeling points with ELEVATION."
  ;)
  (while (= 1 1)
    (setvar "cmdecho" 0)

    (if	(= nil e1)
      (setq e1 0)
    )
    (if	(= nil e2)
      (setq e2 0)
    )
    (if (= nil AddDistance)
      (setq AddDistance 0)
    )
    (if (= nil SubtractDistance)
      (setq SubtractDistance 0)
    )
    (setq thePrompt " ")
    (if (/= 0 AddDistance)
      (setq thePrompt (strcat " (" (rtos AddDistance 3 2) " will be added)"))
    )
    (if (/= 0 SubtractDistance)
      (setq thePrompt (strcat thePrompt " (" (rtos SubtractDistance 3 2) " will be subtracted)"))
    )
    (initget 1 "O")
    (setq p1 (getpoint "\nPick first point with known elevation/length [Options]: "))
    (if (= p1 "O")
      (Options)
    );_end if
    (setq e1a (getdist (strcat "\nEnter elevation/length at first point <"
			       (rtos e1 4 4)
			       "> " theprompt " : "
		       )
	      )
    )
    (if	(/= nil e1a)
      (setq e1 e1a)
    )

    (initget 1)
    (setq p2 (getpoint "\nPick second point with known elevation/length: "))
    (setq e2a (getdist (strcat "\nEnter elevation of second point <"
			       (rtos e2 4 4)
			       "> " theprompt " : "
		       )
	      )
    )
    (if	(/= nil e2a)
      (setq e2 e2a)
    )
    (setq stop "C")
    (while (= stop "C")
      (initget 1)
      (setq p3
	     (getpoint
	       "\nPick point with unknown elevation/length (must be in line with other two points):  "
	     )
      )
      ;set z coordinate of selected points to zero to avoid improper distance calculation
      (setq p1a (subst 0 (nth 2 p1) p1))
      (setq p2a (subst 0 (nth 2 p2) p2))
      (setq p3a (subst 0 (nth 2 p3) p3))
      ;determine distance between all points
      (setq dst1 (distance p1a p2a))
      (setq dst2 (distance p1a p3a))
      (setq dstratio (/ dst2 dst1))
      (setq echange (- e2 e1))
      (setq e3 (/ (+ e1 (* dstratio echange)) 12))

      (prompt (strcat "\nElevation/distance at this point" theprompt ": " (rtos e3 2 2) "'"))

      (setq e3 (- e3 (/ SubtractDistance 12)))
      (setq e3 (+ e3 (/ AddDistance 12)))

      (setvar "CLAYER" "NO PRINT")
      (setq theangle 0)
      (if ztext
	(setq p3 (subst (* e3 12) (nth 2 p3) p3))
      );_end if
      ;add text to modelspace
      (setq theText (vla-addtext ModelSpace (rtos e3 2 2) (vlax-3d-point p3) 3)) 
      ;(command "text" p3 3 theangle (rtos e3 2 2)) ;print the elevation
      (initget "C S R X")
      (setq temp
	     (getkword
	       (strcat
		 "\n(C)ontinue along same line, (S)et new endpoints, run (R)ounder, or e(X)it? <"
		 stop
		 ">: "
	       )
	     )
      )
      (if (/= temp nil)
	(setq stop temp)
      )					;end if
      (if (= temp "R")
	(progn
	  (setvar "Clayer" thelayer)
	  (setvar "cmdecho" theecho)
	  (c:rounder)
	)				;end progn
	(if (= temp "X")		;exit cleanly
	  (progn
	    (setvar "Clayer" thelayer)
	    (setvar "cmdecho" theecho)
	    (exit)
	  )				;end progn
	)				;end if
      )					;end if
    )					;close while
    (setvar "Clayer" thelayer)		;clean up
    (setvar "cmdecho" theecho)
  )
  ;;close while
)
;;close defun

(defun options(/ aDistance)
  (setq theOption nil)
  (initget "A S Z")
  (setq theOption (getkword "\n(A)dd or (S)ubtract from each distance insert at calculated (Z) coordinate, or Enter to continue: "))
  (if (/= nil theOption)
    (cond
      ((= theOption "Z")
       (initget "Y N")
       (setq ztext (getkword "\nInsert text at calculated elevation (z-coordinate)? <N>: "))
      )
      ((= theOption "A")
       (initget 4)
       (setq aDistance (getdist (strcat "Enter the distance you would like to add to each elevation/length <" (rtos AddDistance 3 2) ">: ")))
       (if (/= aDistance nil)
	 (setq AddDistance aDistance)
       );_end if
      )
      ((= theOption "S")
       (initget 4)
       (setq aDistance (getdist (strcat "Enter the distance you would like to subtract from each elevation/length <" (rtos SubtractDistance 3 2) ">: ")))
       (if (/= aDistance nil)
	 (setq SubtractDistance aDistance)
       );_end if
      )
    );_end cond
  );_end if
  (c:ev)
);_end defun


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;Decimal to Architectural Text Rounder
;;This routine rounds Decimal numbers found in text objects to architecural units
;;The routine rounds to the nearest 1/2 inch,
;;and assumes decimal values that are being converted are already in feet
;;This routine was primarily designed to be used in conjuction with the Elevation routine
;;
;;1/27/2008 written by Joe C.
;;2/15/2008 modified to append square brackets at either end of the dimension
;;2/18/2008 added ability to append comments to measurements

(defun c:Rounder (/ xyz counter entity entity1 atrbt atrbt1 bk comment)
  (setq
    comment (getstring
	      "Enter a comment to append to measurement (optional):  "
	    )
  )
  (while (= 1 1)
    (if	(= comment nil)
      (setq comment "")
    )
    (setq bk 1)
    (setq entity 2)
    (while (/= bk "TEXT")
      (setq entity (entget (car (nentsel))))
      (setq bk (cdr (assoc 0 entity)))
    )					;close while
    (setq BkName (cdr (assoc 330 entity)))
    (setq atrbt (assoc 1 entity))
					;(print atrbt)
    (setq atrbt1 (* 12.0 (atof (cdr atrbt))))
    (setq atrbt1 (strcat "[" (rtos atrbt1 4 1) "] " comment))
    (setq entity1 (subst (cons 1 atrbt1) atrbt entity))
    (entmod entity1)
    (entupd Bkname)
  )					;close while
)					;close defun

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;