;;; ---------------------------------------------------------------------------
;;; TrussFrame.lsp
;;; code compiled by YZ August 2026
;;; ---------------------------------------------------------------------------
;;; PARAMETRIC TIMBER ROOF TRUSSES - SIX STANDARD WEB PATTERNS
;;;
;;; PURPOSE
;;;   Draws a complete roof truss - top chords, bottom chord and the full web
;;;   pattern - from four numbers and one pick point. Six standard configurations
;;;   are built in:
;;;
;;;     King Post  simplest of all: a single vertical post from the bottom chord
;;;                to the peak. Short spans only.
;;;     Fink       the common "W" pattern. The most widely used domestic truss,
;;;                and the most material-efficient of the six for medium spans.
;;;     Howe       verticals in tension, diagonals sloping toward the peak.
;;;     Pratt      the mirror of Howe - diagonals slope toward the heels, which
;;;                puts them in tension instead of compression.
;;;     Belgian    a simplified Fink with fewer web members.
;;;     Fan        webs radiating from the heels toward the peak.
;;;
;;; HOW IT WORKS
;;;   Every one of these trusses is the same triangle with a different set of web
;;;   members inside it, so rather than six near-identical routines this file
;;;   holds ONE drawing engine and a small table describing each pattern.
;;;
;;;   1. Four points frame the truss: the two heels, the midspan point on the
;;;      bottom chord, and the peak directly above it at the given rise.
;;;
;;;   2. The two rafters are divided into equal parts and the bottom chord into
;;;      equal parts. How many parts differs per truss - a Fink quarters its
;;;      rafters, a Howe thirds them - and those two divisors are the first two
;;;      numbers in each table entry.
;;;
;;;   3. Every division point gets a short name. The webs are then written out as
;;;      nothing more than lists of those names, so the Howe pattern reads
;;;      literally as "E A F B P3 C G D H" - a single zigzag from the left heel
;;;      across to the right. Adding a seventh truss type means adding one line
;;;      to the table, not writing another function.
;;;
;;;   4. The engine looks each name up in the point table and draws the polyline.
;;;
;;; LUMBER THICKNESS
;;;   The thickness you give is applied as AutoCAD extrusion thickness, so the
;;;   truss comes out as a 3D object with real depth rather than a flat diagram.
;;;   THICKNESS is put back to what it was afterwards, so the setting does not
;;;   leak into whatever you draw next.
;;;
;;;   Lumber width becomes the polyline width, so the chords and webs are drawn
;;;   at their true scantling rather than as single lines.
;;;
;;;   TRUSSFRAME  - draw a roof truss, prompting for the pattern
;;; ---------------------------------------------------------------------------

;;; ---------------------------------------------------------------------------
;;; THE TRUSS TABLE
;;;
;;; Each entry is:
;;;   name          what the user types at the prompt
;;;   rafter parts  how many equal divisions along each sloping top chord
;;;   chord parts   how many equal divisions along the bottom chord
;;;   centre post   T when a vertical from midspan to the peak is part of the
;;;                 pattern, nil when it is not
;;;   webs          a list of polylines, each written as a list of point names
;;;
;;; Point names available to the web lists:
;;;   P1 P2   left and right heel          P3   midspan on the bottom chord
;;;   P4      peak
;;;   A B S   up the LEFT rafter, at one, two and three divisions from the heel
;;;   D C TT  up the RIGHT rafter, at one, two and three divisions from the heel
;;;   E F     along the bottom chord from the LEFT heel, at one and two divisions
;;;   H G     along the bottom chord from the RIGHT heel, at one and two divisions
;;;   Y Z     midway between F and the peak, and between G and the peak
;;;
;;; ("TT" is the third point up the right rafter. It is spelled with two letters
;;;  deliberately - a single T is LISP's true constant and must never be reused.)
;;; ---------------------------------------------------------------------------

(setq TrussFrame:Types
    (list
        (list "King" 2 2 t
              nil)

        (list "Fink" 4 8 nil
              '(("A"  "E" "B" "F" "P4")
                ("P4" "G" "C" "H" "D")
                ("S"  "Y" "B")
                ("TT" "Z" "C")))

        (list "Howe" 3 6 t
              '(("E" "A" "F" "B" "P3" "C" "G" "D" "H")))

        (list "Pratt" 3 6 t
              '(("A" "E" "B" "F" "P4" "G" "C" "H" "D")))

        (list "Belgian" 3 4 t
              '(("A" "E" "B" "P3" "C" "H" "D")))

        (list "Fan" 3 4 nil
              '(("A" "E" "P4" "H" "D")
                ("B" "E")
                ("C" "H")))
    )
)

;;; ---------------------------------------------------------------------------
;;; POINT TABLE
;;;
;;; Works out every named point for one truss and returns them as an association
;;; list of (name . point). Building them all up front - even the ones a given
;;; pattern does not use - costs nothing and keeps the drawing engine free of
;;; special cases.
;;; ---------------------------------------------------------------------------

(defun TrussFrame:Points ( base span rise rDiv bDiv
                           / p1 p2 p3 p4 angL angR rLen d1 d2 fpt gpt )

    (setq p1   base
          p2   (polar p1 0.0 span)
          p3   (polar p1 0.0 (* span 0.5))
          p4   (polar p3 (* pi 0.5) rise)

          ;; Rafter length is measured to the peak, so both rafters divide into
          ;; equal true lengths rather than equal horizontal runs.
          angL (angle p1 p4)
          angR (angle p2 p4)
          rLen (distance p1 p4)
          d1   (/ rLen rDiv)
          d2   (/ span bDiv)

          ;; Named on the bottom chord first, because Y and Z are measured from
          ;; F and G and so need them to exist already.
          fpt  (polar p1 0.0 (* 2 d2))
          gpt  (polar p2 pi  (* 2 d2))
    )

    (list
        (cons "P1" p1)
        (cons "P2" p2)
        (cons "P3" p3)
        (cons "P4" p4)

        ;; Up the left rafter.
        (cons "A"  (polar p1 angL d1))
        (cons "B"  (polar p1 angL (* 2 d1)))
        (cons "S"  (polar p1 angL (* 3 d1)))

        ;; Up the right rafter, mirrored.
        (cons "D"  (polar p2 angR d1))
        (cons "C"  (polar p2 angR (* 2 d1)))
        (cons "TT" (polar p2 angR (* 3 d1)))

        ;; Along the bottom chord from each heel.
        (cons "E"  (polar p1 0.0 d2))
        (cons "F"  fpt)
        (cons "H"  (polar p2 pi  d2))
        (cons "G"  gpt)

        ;; Halfway from the inner chord points up to the peak - the Fink pattern
        ;; hangs its secondary webs off these.
        (cons "Y"  (polar fpt (angle fpt p4) (* 0.5 (distance fpt p4))))
        (cons "Z"  (polar gpt (angle gpt p4) (* 0.5 (distance gpt p4))))
    )
)

;;; ---------------------------------------------------------------------------
;;; LAYER
;;;
;;; Trusses go on their own layer so they can be frozen for a plan-only plot.
;;; An existing layer is left as the office standard set it - only made usable.
;;; ---------------------------------------------------------------------------

(defun TrussFrame:EnsureLayer ( name / rec )
    (if (setq rec (tblsearch "layer" name))
        (progn
            (if (minusp (cdr (assoc 62 rec)))       (command "_.LAYER" "_ON"     name ""))
            (if (= 1 (logand 1 (cdr (assoc 70 rec)))) (command "_.LAYER" "_THAW"   name ""))
            (if (= 4 (logand 4 (cdr (assoc 70 rec)))) (command "_.LAYER" "_UNLOCK" name ""))
        )
        (command "_.LAYER" "_NEW" name "_COLOR" "_GREEN" name "")
    )
    (setvar "CLAYER" name)
)

;;; ---------------------------------------------------------------------------
;;; DRAWING
;;;
;;; Draws one polyline through the named points at the given lumber width. The
;;; width is set explicitly on every polyline rather than relying on PLINE
;;; remembering the last one used, so a truss drawn straight after some other
;;; polyline work still comes out at the right scantling.
;;; ---------------------------------------------------------------------------

(defun TrussFrame:Poly ( names pts width close / run )
    (setq run (mapcar '(lambda (n) (cdr (assoc n pts))) names))
    ;; A name that is not in the point table would put nil into the command
    ;; stream and hang the PLINE prompt, so refuse to draw a broken run.
    (if (vl-some 'null run)
        (princ (strcat "\n** TrussFrame: unknown point in web run - skipped **"))
        (progn
            (command "_.PLINE" (car run) "_W" width width)
            (foreach p (cdr run) (command p))
            (if close (command "_C") (command ""))
        )
    )
    (princ)
)

;;; ---------------------------------------------------------------------------
;;; MAIN COMMAND
;;; ---------------------------------------------------------------------------

(defun c:TRUSSFRAME ( / *error* vars vals kind entry span rise thick width base
                        pts names )

    (setq vars '("CMDECHO" "CLAYER" "THICKNESS" "OSMODE" "BLIPMODE" "PLINEWID")
          vals (mapcar 'getvar vars))

    (defun TrussFrame: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 )
        (TrussFrame:Restore)
        (if (and msg (not (wcmatch (strcase msg t) "*break*,*cancel*,*exit*")))
            (princ (strcat "\n** TRUSSFRAME 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")

    ;; Which pattern. The keyword list is built from the table so the two can
    ;; never disagree about what is on offer.
    (initget 1 "King Fink Howe Pratt Belgian Fan")
    (setq kind (getkword "\nTruss pattern [King/Fink/Howe/Pratt/Belgian/Fan] <Fink>: "))
    (if (null kind) (setq kind "Fink"))
    (setq entry (assoc kind TrussFrame:Types))

    ;; Input filtering is done by INITGET rather than by checking afterwards, so
    ;; a bad value is refused at the prompt and the user simply retypes it.
    ;;   7 = reject empty, zero and negative - a span or rise of zero would
    ;;       collapse the truss and divide by zero when dividing the rafters.
    ;;   5 = reject empty and negative, but allow zero - a zero lumber width is
    ;;       a legitimate request for single-line members.
    ;;   1 = reject empty only - zero thickness is a legitimate flat 2D truss.
    (initget 7)
    (setq span (getdist "\nOverall span: "))
    (initget 7)
    (setq rise (getdist "\nRise from bottom chord to peak: "))
    (initget 1)
    (setq thick (getdist "\nLumber thickness (extrusion depth, 0 for flat): "))
    (initget 5)
    (setq width (getdist "\nLumber width (member width on plan): "))
    (initget 1)
    (setq base (getpoint "\nLeft heel of the truss: "))

    (cond
        ((or (null span) (null rise) (null thick) (null width) (null base))
         (princ "\nCancelled."))

        (t
            (TrussFrame:EnsureLayer "TRUSS")

            ;; Extrusion depth gives the truss real thickness in 3D. Restored on
            ;; the way out along with every other saved variable.
            (setvar "THICKNESS" thick)
            ;; Osnaps would grab existing geometry instead of the calculated
            ;; points; blips would litter the drawing with marker crosses.
            (setvar "OSMODE" 0)
            (setvar "BLIPMODE" 0)

            (setq pts (TrussFrame:Points base span rise
                                         (float (cadr entry))
                                         (float (caddr entry))))

            ;; The outline is the same for every pattern: bottom chord out to the
            ;; right heel, up the right rafter to the peak, then closed back down
            ;; the left rafter to where it started.
            (TrussFrame:Poly '("P1" "P2" "P4") pts width t)

            ;; Centre post, for the patterns that have one.
            (if (cadddr entry)
                (TrussFrame:Poly '("P3" "P4") pts width nil))

            ;; And the web members that make this pattern what it is.
            (foreach names (nth 4 entry)
                (TrussFrame:Poly names pts width nil))

            (princ (strcat "\n" kind " truss drawn - span "
                           (rtos span 2 2) ", rise " (rtos rise 2 2) "."))
        )
    )

    (TrussFrame:Restore)
    (princ)
)

(princ)