;;; --------------------------------------------------------------------------- ;;; RoofPitch.lsp ;;; code compiled by YZ August 2026 ;;; --------------------------------------------------------------------------- ;;; ROOF PITCH TRIANGLE ;;; ;;; PURPOSE ;;; Draws the little right-angled triangle that marks a roof slope, with the ;;; rise and the run written on it - 4 over 12, 1 over 40, whatever the roof ;;; is. The triangle can face any of the four ways, so it sits correctly ;;; whichever slope it is labelling. ;;; ;;; |\ /| ;;; 4 | \ / | 4 ;;; |__\ /__| ;;; 12 12 ;;; ;;; It will also read the slope off the drawing: pick two points along the ;;; roof line and it works out the rise for a run of 12, which saves doing it ;;; in your head and getting it wrong. ;;; ;;; WHAT WAS FIXED ;;; This replaces four near-identical files - one per corner - each of which ;;; inserted a different block that had to already be in the drawing. Without ;;; those four blocks none of them did anything. The triangle is drawn ;;; directly now, and the direction is an option rather than four commands. ;;; ;;; All four set ATTDIA, ATTMODE and ATTREQ and left them changed. ;;; ;;; All four also tested their input like this: ;;; ;;; (setq A (getint "\nValue for Rise: ")) ;;; (if (= a nil)(command)) ;;; ;;; (command) with no arguments cancels whatever command is running - it does ;;; not leave the routine. So pressing Enter at the prompt carried on with a ;;; rise of nil, which then went to INSERT as an attribute value. ;;; ;;; They took the rise and run as integers, so a 2.5 in 12 pitch could not be ;;; entered at all. ;;; ;;; ROOFPITCH - draw a roof pitch triangle ;;; --------------------------------------------------------------------------- ;;; Carried between runs - a roof plan usually wants the same pitch several ;;; times over. (setq *RoofPitch:Rise* nil *RoofPitch:Run* nil) ;;; --------------------------------------------------------------------------- ;;; SUPPORT ;;; --------------------------------------------------------------------------- (defun Pitch:Layer ( name colour ) (if (not (tblsearch "LAYER" name)) (entmake (list '(0 . "LAYER") '(100 . "AcDbSymbolTableRecord") '(100 . "AcDbLayerTableRecord") (cons 2 name) '(70 . 0) (cons 62 colour) '(6 . "Continuous")))) name ) (defun Pitch:Line ( p1 p2 layer ) (entmake (list '(0 . "LINE") (cons 8 layer) (cons 10 p1) (cons 11 p2))) ) ;;; Text centred on a point. Group 11 has to carry the point too whenever the ;;; justification is anything but the default. (defun Pitch:Text ( pt hgt txt layer just ) (entmake (list '(0 . "TEXT") (cons 8 layer) (cons 10 pt) (cons 11 pt) (cons 40 hgt) (cons 1 txt) (cons 72 just) '(73 . 2))) ) ;;; A number written without a trailing ".00" when it is a whole one. (defun Pitch:Num ( v ) (if (equal v (float (fix v)) 1e-9) (itoa (fix v)) (rtos v 2 2)) ) ;;; --------------------------------------------------------------------------- ;;; MAIN COMMAND ;;; --------------------------------------------------------------------------- (defun c:ROOFPITCH ( / *error* vars vals rise run size ins dir lay hgt dx dy corner horiz vert v p1 p2 measured ) (setq vars '("CMDECHO" "OSMODE" "CLAYER") vals (mapcar 'getvar vars)) (defun Pitch:Restore ( ) (mapcar 'setvar vars vals) (while (= 8 (logand 8 (getvar 'undoctl))) (command "_.UNDO" "_End")) (vl-catch-all-apply '(lambda ( ) (*pop-error-mode*)) '()) (princ) ) (defun *error* ( msg ) (Pitch:Restore) (if (and msg (not (wcmatch (strcase msg t) "*break*,*cancel*,*exit*"))) (princ (strcat "\n** ROOFPITCH error: " msg " **"))) (princ) ) (setvar "CMDECHO" 0) ;; AutoCAD 2015 and later refuse (command) inside an *error* handler unless ;; the routine says up front that it will use one. (vl-catch-all-apply '(lambda ( ) (*push-error-using-command*)) '()) (command "_.UNDO" "_Begin") ;; --- the pitch ---------------------------------------------------------- (initget "Measure Type") (setq v (getkword "\nPitch by [Measure/Type] : ")) (if (= v "Measure") (progn (princ "\nPick two points along the roof line.") (if (and (setq p1 (getpoint "\n First point: ")) (setq p2 (getpoint p1 "\n Second point: "))) (progn (setq dx (abs (- (car p2) (car p1))) dy (abs (- (cadr p2) (cadr p1)))) (if (< dx 1e-9) (princ "\n That line is vertical - it has no run.") (progn (initget 6) (setq run (getreal "\n Express it over a run of <12>: ")) (if (null run) (setq run 12.0)) (setq rise (/ (* dy run) dx) measured t) (princ (strcat "\n Measured " (Pitch:Num rise) " in " (Pitch:Num run))))))))) (if (null rise) (progn (initget 6) (setq rise (getreal (strcat "\nRise" (if *RoofPitch:Rise* (strcat " <" (Pitch:Num *RoofPitch:Rise*) ">") "") ": "))) (if (null rise) (setq rise *RoofPitch:Rise*)) (initget 6) (setq run (getreal (strcat "\nRun <" (Pitch:Num (cond (*RoofPitch:Run*) (t 12.0))) ">: "))) (if (null run) (setq run (cond (*RoofPitch:Run*) (t 12.0)))))) (if (or (null rise) (null run)) (princ "\nNo pitch given.") (progn (setq *RoofPitch:Rise* rise *RoofPitch:Run* run) ;; --- which way it faces ---------------------------------------- ;; The corner is the right angle. Upper-right means the triangle ;; climbs to the right, so the vertical leg is on the right. (initget "UpperLeft UpperRight LowerLeft LowerRight") (setq dir (getkword "\nFacing [UpperLeft/UpperRight/LowerLeft/LowerRight] : ")) (if (null dir) (setq dir "LowerRight")) ;; --- how big ----------------------------------------------------- (setq size (getvar "DIMSCALE")) (if (or (null size) (<= size 0.0)) (setq size 1.0)) (initget 6) (setq v (getdist (strcat "\nLength of the horizontal leg <" (rtos (* size 12.0) 2 3) ">: "))) (setq size (if v v (* size 12.0))) (setq ins (getpoint "\nCorner of the triangle - the right angle: ")) (if (null ins) (princ "\nCancelled.") (progn (setvar "OSMODE" 0) (setq ins (list (car ins) (cadr ins) 0.0) lay (Pitch:Layer "Roof-Pitch" 7) hgt (/ size 5.0) ;; The vertical leg is in the same proportion to the ;; horizontal as the rise is to the run, so the ;; triangle actually shows the slope it names. dx (if (member dir '("UpperRight" "LowerRight")) size (- size)) dy (if (member dir '("UpperLeft" "UpperRight")) (* size (/ rise run)) (- (* size (/ rise run))))) (setq corner ins horiz (list (+ (car ins) dx) (cadr ins) 0.0) vert (list (car ins) (+ (cadr ins) dy) 0.0)) ;; The right angle sits at the corner; the sloping side ;; joins the two free ends. (Pitch:Line corner horiz lay) (Pitch:Line corner vert lay) (Pitch:Line horiz vert lay) ;; Run along the horizontal leg, on the outside of it. (Pitch:Text (list (+ (car ins) (/ dx 2.0)) (- (cadr ins) (if (> dy 0.0) (* hgt 1.1) (* hgt -1.1))) 0.0) hgt (Pitch:Num run) lay 1) ;; Rise beside the vertical leg, on the outside of it. (Pitch:Text (list (- (car ins) (if (> dx 0.0) (* hgt 0.7) (* hgt -0.7))) (+ (cadr ins) (/ dy 2.0)) 0.0) hgt (Pitch:Num rise) lay (if (> dx 0.0) 2 0)) (princ (strcat "\nPitch " (Pitch:Num rise) " in " (Pitch:Num run) " - " (rtos (/ (* 180.0 (atan (/ rise run))) pi) 2 2) " degrees" (if measured " (measured off the drawing)" "") ".")) ) ) ) ) (Pitch:Restore) (princ) ) (princ)