;;; --------------------------------------------------------------------------- ;;; PitchMark.lsp ;;; code compiled by YZ August 2026 ;;; --------------------------------------------------------------------------- ;;; ROOF PITCH SYMBOL - THE RISE-OVER-RUN TRIANGLE ;;; ;;; PURPOSE ;;; Measures the slope of a line and draws the standard pitch triangle beside ;;; it: a small right-angled triangle whose hypotenuse lies parallel to the ;;; roof, with the run written along the horizontal leg and the rise along the ;;; vertical one. ;;; ;;; It can also report the same slope as an angle in degrees, as a percentage ;;; grade, or as a ratio - the four ways a slope gets called up depending on ;;; whether you are drawing a roof, a ramp, a road or a drain. ;;; ;;; HOW IT WORKS ;;; 1. You select a sloping line, or pick two points along the slope. ;;; ;;; 2. The slope is the vertical change divided by the horizontal change, ;;; always taken as a positive value - a roof falling to the left has the ;;; same pitch as one falling to the right, and the symbol is mirrored ;;; rather than signed. ;;; ;;; A perfectly vertical line has no defined pitch and is rejected. A ;;; perfectly horizontal one has a pitch of zero, which is reported rather ;;; than drawn, because a zero-height triangle is not a symbol. ;;; ;;; 3. You pick which side of the line the symbol should sit on. The triangle ;;; is built at the near end of the line and then shifted bodily ;;; perpendicular to the roof, toward the side you picked, by a small gap. ;;; That way the symbol never lands on top of the roof line itself. ;;; ;;; 4. The triangle is drawn as a single closed polyline so it selects, moves ;;; and erases as one object. ;;; ;;; HOW IT IS SIZED ;;; The horizontal leg defaults to DIMDLI times DIMSCALE, which ties the symbol ;;; to the same size family as the drawing's dimensions. Override it once and ;;; the new size is remembered for the session. Text height comes from DIMTXT ;;; times DIMSCALE and the standoff gap from DIMGAP times DIMSCALE, for the ;;; same reason - the symbol should look like it belongs with the dimensions ;;; already on the sheet. ;;; ;;; RISE-PER-RUN CONVENTION ;;; Imperial roof pitch is quoted as rise per 12 of run, so the run label reads ;;; 12 and the rise is whatever the slope gives against it. Metric practice ;;; quotes a run of 100 or a plain angle, both of which are available from the ;;; Format option. ;;; ;;; PITCHMARK - measure a slope and draw the pitch symbol ;;; --------------------------------------------------------------------------- ;;; --------------------------------------------------------------------------- ;;; SESSION MEMORY ;;; --------------------------------------------------------------------------- (if (null *PitchMark:Prefs*) (setq *PitchMark:Prefs* (list (cons "BASE" nil) ; horizontal leg length, nil = derive (cons "FORMAT" "Run12") ; Run12 | Run100 | Degrees | Percent ) ) ) (defun PitchMark:Get ( key ) (cdr (assoc key *PitchMark:Prefs*))) (defun PitchMark:Put ( key val ) (setq *PitchMark:Prefs* (cons (cons key val) (vl-remove-if '(lambda (p) (= (car p) key)) *PitchMark:Prefs*))) val ) ;;; --------------------------------------------------------------------------- ;;; SLOPE ;;; ;;; Returns the slope of the line between two points as a positive rise over run, ;;; or nil when the line is vertical and has no meaningful pitch. ;;; --------------------------------------------------------------------------- (defun PitchMark:Slope ( p1 p2 / dx dy ) (setq dx (abs (- (car p2) (car p1))) dy (abs (- (cadr p2) (cadr p1)))) ;; A tolerance rather than a test against exactly zero: a line drawn at ;; 89.999 degrees is a vertical line as far as a roof is concerned, and ;; dividing by its tiny run would produce an absurd pitch. (if (< dx 1e-8) nil (/ dy dx)) ) ;;; Trim a formatted number back to something a drawing would actually carry. ;;; RTOS at four places gives 6.0000 where a roof wants 6, so trailing zeros and ;;; a stranded decimal point are removed. (defun PitchMark:Tidy ( s ) (if (vl-string-search "." s) (progn (while (and (> (strlen s) 1) (= "0" (substr s (strlen s) 1))) (setq s (substr s 1 (1- (strlen s))))) (if (= "." (substr s (strlen s) 1)) (setq s (substr s 1 (1- (strlen s))))))) s ) ;;; The two labels for the symbol, given the slope and the chosen format. ;;; Returns (run-label . rise-label). (defun PitchMark:Labels ( slope fmt ) (cond ((= fmt "Run100") (cons "100" (PitchMark:Tidy (rtos (* slope 100.0) 2 2)))) ((= fmt "Degrees") (cons "" (strcat (PitchMark:Tidy (rtos (/ (* (atan slope) 180.0) pi) 2 2)) "%%d"))) ((= fmt "Percent") (cons "" (strcat (PitchMark:Tidy (rtos (* slope 100.0) 2 1)) "%%%"))) ;; Run12 is the default: imperial roof pitch, rise per 12 of run. (t (cons "12" (PitchMark:Tidy (rtos (* slope 12.0) 2 2)))) ) ) ;;; --------------------------------------------------------------------------- ;;; MAIN COMMAND ;;; --------------------------------------------------------------------------- (defun c:PITCHMARK ( / *error* vars vals scl base gap txth fmt sel ent dat p1 p2 pick opt slope ang dirX rise apex corner start perp side off labels runlab riselab midRun midRise ) (setq vars '("CMDECHO" "OSMODE" "BLIPMODE" "CLAYER" "PLINEWID") vals (mapcar 'getvar vars)) (defun PitchMark: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 ) (PitchMark:Restore) (if (and msg (not (wcmatch (strcase msg t) "*break*,*cancel*,*exit*"))) (princ (strcat "\n** PITCHMARK 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. Restore does, ;; to close this undo group. The declaring call is absent on older ;; releases, so it is wrapped rather than tested for. (vl-catch-all-apply '(lambda ( ) (*push-error-using-command*)) '()) (command "_.UNDO" "_Begin") ;; Sizes taken from the dimension variables so the symbol matches the sheet. (setq scl (getvar "DIMSCALE")) (if (zerop scl) (setq scl 1.0)) (setq base (if (PitchMark:Get "BASE") (PitchMark:Get "BASE") (* scl (getvar "DIMDLI"))) gap (* scl (getvar "DIMGAP")) txth (* scl (getvar "DIMTXT")) fmt (PitchMark:Get "FORMAT")) ;; Guard against a template with these left at zero, which would draw an ;; invisible symbol and give no clue why. (if (<= base 0.0) (setq base (* scl 0.38))) (if (<= txth 0.0) (setq txth (* scl 0.18))) (if (<= gap 0.0) (setq gap (* scl 0.09))) ;; Offer the two settings before measuring, so the common case is one Enter. (initget "Format Base Measure") (setq opt (getkword (strcat "\nPitch symbol: " fmt ", base " (rtos base 2 3) "\n[Format/Base/Measure] : "))) (cond ((= opt "Format") (initget "Run12 Run100 Degrees Percent") (setq opt (getkword "\nReport pitch as [Run12/Run100/Degrees/Percent]: ")) (if opt (setq fmt (PitchMark:Put "FORMAT" opt)))) ((= opt "Base") (initget 6) (setq opt (getdist (strcat "\nHorizontal leg length <" (rtos base 2 3) ">: "))) (if opt (setq base (PitchMark:Put "BASE" opt)))) ) ;; --- get the slope ------------------------------------------------------- ;; A line can be selected directly, or two points picked for a slope that is ;; not drawn as a single line - a roof made of several segments, say. (setq sel (entsel "\nSelect the sloping line, or press Enter to pick two points: ")) (if sel (progn (setq ent (car sel) dat (entget ent)) (if (= "LINE" (cdr (assoc 0 dat))) (setq p1 (cdr (assoc 10 dat)) p2 (cdr (assoc 11 dat))) (princ "\nThat is not a line."))) (progn (setq p1 (getpoint "\nFirst point on the slope: ")) (if p1 (setq p2 (getpoint p1 "\nSecond point on the slope: "))))) (cond ((or (null p1) (null p2)) (princ "\nNothing measured.")) ((null (setq slope (PitchMark:Slope p1 p2))) (princ "\nThat line is vertical - it has no pitch.")) ((< slope 1e-8) (princ "\nThat line is horizontal - the pitch is zero, so there is nothing to draw.")) (t ;; Report the measurement whether or not a symbol gets drawn. (setq labels (PitchMark:Labels slope fmt) runlab (car labels) riselab (cdr labels)) (princ (strcat "\nPitch: " (if (= runlab "") "" (strcat runlab " run : ")) riselab " (" (PitchMark:Tidy (rtos (/ (* (atan slope) 180.0) pi) 2 2)) " degrees, " (PitchMark:Tidy (rtos (* slope 100.0) 2 1)) "% grade)")) ;; Which side of the roof line the symbol goes on. (setq pick (getpoint (polar p1 (angle p1 p2) (/ (distance p1 p2) 2.0)) "\nPick the side for the symbol: ")) (if (null pick) (princ "\nNo side picked - measurement only, nothing drawn.") (progn (setvar "OSMODE" 0) (setvar "BLIPMODE" 0) ;; Work in the uphill direction so the triangle always reads ;; the same way round regardless of which end was picked ;; first when the line was drawn. (if (> (cadr p1) (cadr p2)) (setq start p2 apex p1) (setq start p1 apex p2)) (setq ang (angle start apex)) ;; Does the roof climb to the right or to the left? The ;; triangle is built the same way and simply mirrored. (setq dirX (if (> (car apex) (car start)) 1.0 -1.0)) ;; Triangle: horizontal leg of `base` from the start point, ;; then vertical up by base * slope to meet the hypotenuse. (setq rise (* base slope) corner (list (+ (car start) (* dirX base)) (cadr start) 0.0) apex (list (+ (car start) (* dirX base)) (+ (cadr start) rise) 0.0)) ;; Shift the whole triangle clear of the roof line, toward ;; whichever side was picked. The perpendicular is taken from ;; the roof angle, and its sign chosen by testing which of the ;; two perpendicular directions lands nearer the pick. (setq perp (+ ang (* pi 0.5)) side (if (< (distance pick (polar start perp 1.0)) (distance pick (polar start (- perp pi) 1.0))) perp (- perp pi)) off (+ gap (* gap 2.0))) (setq start (polar start side off) corner (polar corner side off) apex (polar apex side off)) ;; The triangle itself, as one closed polyline. (command "_.PLINE" start "_W" 0 0 corner apex "_C") ;; Labels sit just outside their own leg, offset along the ;; same perpendicular logic so they never overlap the symbol. (setq midRun (polar (polar start (angle start corner) (/ (distance start corner) 2.0)) (if (> (cadr apex) (cadr corner)) (* pi 1.5) (* pi 0.5)) (+ gap (* txth 0.5))) midRise (polar (polar corner (angle corner apex) (/ (distance corner apex) 2.0)) (if (> dirX 0.0) 0.0 pi) (+ gap (* txth 0.5)))) ;; A fixed-height text style supplies its own height and the ;; TEXT command does not prompt for one. (if (zerop (cdr (assoc 40 (tblsearch "style" (getvar "TEXTSTYLE"))))) (progn (if (/= runlab "") (command "_.TEXT" "_J" "_MC" midRun txth 0 runlab)) (command "_.TEXT" "_J" "_MC" midRise txth 0 riselab)) (progn (if (/= runlab "") (command "_.TEXT" "_J" "_MC" midRun 0 runlab)) (command "_.TEXT" "_J" "_MC" midRise 0 riselab))) ) ) ) ) (PitchMark:Restore) (princ) ) (princ)