;;; ---------------------------------------------------------------------------
;;; WallRun.lsp
;;; code compiled by YZ August 2026
;;; ---------------------------------------------------------------------------
;;; MULTI-LINE WALLS WITH OPENINGS, DOORS AND WINDOWS
;;;
;;; PURPOSE
;;;   A complete wall system: draw a run of wall as any number of parallel lines
;;;   from a named wall type, with corners cleaned automatically, then cut
;;;   openings into it for doors, windows and relites.
;;;
;;;     WALLRUN     draw a run of wall, closing back on itself if you want
;;;     WALLTYPE    list, load and create wall types
;;;     WALLOPEN    cut a plain opening
;;;     WALLDOOR    cut an opening and draw a door leaf and swing
;;;     WALLWIN     cut an opening and draw glass and a ledge
;;;     WALLRELITE  cut an opening and draw glass only
;;;
;;; WHAT A WALL TYPE IS
;;;   A list of the lines that make up the wall, each with its own layer,
;;;   linetype, colour and offset from the run line:
;;;
;;;     *STUD-100
;;;     (("WALL" "CONTINUOUS" "BYLAYER" 50.0)
;;;      ("WALL" "CONTINUOUS" "BYLAYER" -50.0))
;;;
;;;   That is a 100 wide wall as two lines either side of the centreline. Add
;;;   more entries for a cavity wall, an insulation line, a finish line - as many
;;;   as the drawing needs. Any of layer, linetype or colour may be nil, meaning
;;;   "leave whatever is current".
;;;
;;;   Types live in WallRun.wal beside this file. Add your office's standard wall
;;;   build-ups there once and they are available in every drawing.
;;;
;;; HOW THE RUN IS DRAWN
;;;   You give a from-point, a to-point, and which side of that line the wall
;;;   sits on. Every offset in the wall type is then measured from that line, so
;;;   a wall type can describe a build-up that is not symmetrical - a cavity wall
;;;   set out from its structural leaf, say - and it stays the right way round.
;;;
;;;   Each new segment is filleted to the one before it, line by matching line,
;;;   at zero radius. That is what cleans the corners: line 1 of the new segment
;;;   meets line 1 of the old, line 2 meets line 2, and so on, so a five-line
;;;   wall turns a corner correctly rather than leaving twenty loose ends.
;;;
;;;   Close the run and it fillets back onto the first segment too.
;;;
;;; HOW AN OPENING IS CUT
;;;   All four opening commands share one engine:
;;;
;;;     1. Touch a point on one face of the wall.
;;;     2. Optionally give a distance from the nearest end, to set the opening
;;;        out from a corner rather than by eye.
;;;     3. Touch the opposite face - this measures the wall, so the opening
;;;        works on any wall thickness without being told it.
;;;     4. Give the opening width, and pick which way along the wall it runs.
;;;
;;;   The wall is then broken at both jambs and the jamb lines drawn in. Whether
;;;   each face is REMOVED between the jambs or merely SPLIT there depends on the
;;;   command: a door removes both faces, a window keeps one so the ledge can sit
;;;   against it.
;;;
;;;   WALLRUN  WALLTYPE  WALLOPEN  WALLDOOR  WALLWIN  WALLRELITE
;;; ---------------------------------------------------------------------------

;;; ---------------------------------------------------------------------------
;;; SESSION STATE
;;; ---------------------------------------------------------------------------

(if (null *WallRun:State*)
    (setq *WallRun:State*
        (list (cons "TYPE"  nil)     ; name of the loaded wall type
              (cons "LINES" nil)     ; its line definitions
              (cons "WIDTH" 100.0)   ; last opening width
              (cons "DOORANG" (* pi 0.5))  ; last door swing angle
              (cons "DOORTHK" 40.0)  ; last door leaf thickness
              (cons "LEDGE" 50.0)    ; last window ledge projection
        )
    )
)

(defun WallRun:Get ( key ) (cdr (assoc key *WallRun:State*)))

(defun WallRun:Put ( key val )
    (setq *WallRun:State*
        (cons (cons key val)
              (vl-remove-if '(lambda (p) (= (car p) key)) *WallRun:State*)))
    val
)

;;; ---------------------------------------------------------------------------
;;; ENVIRONMENT
;;;
;;; One save/restore pair used by every command in the file, so no command can
;;; leave the drawing in a state another one did not expect.
;;; ---------------------------------------------------------------------------

(setq WallRun:VARS
    '("CMDECHO" "OSMODE" "ORTHOMODE" "APERTURE" "PICKBOX" "BLIPMODE"
      "HIGHLIGHT" "CLAYER" "CECOLOR" "CELTYPE" "FILLETRAD"))

(defun WallRun:Save ( ) (mapcar 'getvar WallRun:VARS))

(defun WallRun:Restore ( vals )
    (mapcar 'setvar WallRun:VARS vals)
    (while (= 8 (logand 8 (getvar 'undoctl))) (command "_.UNDO" "_End"))
    (vl-catch-all-apply '(lambda ( ) (*pop-error-mode*)) '())
    (princ)
)

;;; ---------------------------------------------------------------------------
;;; WHICH SIDE
;;;
;;; Turns a "which side?" pick into a sign, +1 or -1, which every offset is then
;;; multiplied by. The routine this replaces stored the + or - FUNCTION itself in
;;; a variable and called it - clever, but it made every line of geometry that
;;; used it unreadable.
;;; ---------------------------------------------------------------------------

(defun WallRun:Side ( base along pick / diff )
    (setq diff (- (angle base pick) along))
    (while (< diff 0.0) (setq diff (+ diff pi pi)))
    (if (< diff pi) 1.0 -1.0)
)

;;; Perpendicular to a run, on the chosen side.
(defun WallRun:Perp ( along sgn ) (+ along (* sgn (* pi 0.5))))

;;; ---------------------------------------------------------------------------
;;; WALL TYPES
;;;
;;; A set of standard build-ups is embedded below, so this file works on its own
;;; with nothing to install. Each entry is a list of the lines making up the
;;; wall, written as ( layer linetype colour offset ). Any of the first three may
;;; be nil, meaning "leave whatever is current" - useful when the drawing's own
;;; layer standard should decide and the type is only setting out the geometry.
;;;
;;; The offsets below are in millimetres. They are only numbers - use whatever
;;; the drawing is in.
;;;
;;; AN EXTERNAL FILE IS STILL READ IF YOU WANT ONE
;;;   If a file called WallRun.wal is found on the support path, the types in it
;;;   are added to these, and a type there with the same name wins. That keeps
;;;   an office standard in one shared file without editing this one - but
;;;   nothing needs it, and without it everything below still works.
;;;
;;;   Its format is plain text: a line starting with * names a type, and the
;;;   line or lines after it hold the definition as a LISP list.
;;; ---------------------------------------------------------------------------

(setq WallRun:Builtin
    (list
        ;; A single line on the run line - for setting out before the build-up
        ;; has been decided.
        (cons "CENTRELINE" '((nil nil nil 0.0)))

        ;; Plain partitions, faces either side of the centreline.
        (cons "STUD-100" '((nil nil nil 50.0) (nil nil nil -50.0)))
        (cons "STUD-140" '((nil nil nil 70.0) (nil nil nil -70.0)))

        ;; 90 stud with 13 board each side - structure and finish shown apart.
        (cons "STUD-116" '((nil nil nil  58.0) (nil nil nil  45.0)
                           (nil nil nil -45.0) (nil nil nil -58.0)))

        ;; Blockwork.
        (cons "BLOCK-190" '((nil nil nil 95.0) (nil nil nil -95.0)))

        ;; Cavity wall set out from the OUTSIDE face of the inner leaf, which is
        ;; how a structural grid usually runs: inner leaf 90, cavity 50, outer 90.
        (cons "CAVITY-230" '((nil nil nil 0.0) (nil nil nil 90.0)
                             (nil nil nil 140.0) (nil nil nil 230.0)))

        ;; The same, with the cavity shown dashed down the middle so it reads as
        ;; a void rather than as two separate walls.
        (cons "CAVITY-230-DASH" '((nil nil    nil   0.0)
                                  (nil nil    nil  90.0)
                                  (nil "HIDDEN" nil 115.0)
                                  (nil nil    nil 140.0)
                                  (nil nil    nil 230.0)))

        ;; Partition with a centreline through it, for dimensioning to grid.
        (cons "STUD-100-CL" '((nil nil      nil  50.0)
                              (nil "CENTER" nil   0.0)
                              (nil nil      nil -50.0)))
    )
)

;;; Types added during this session by WALLTYPE Define.
(if (null *WallRun:User*) (setq *WallRun:User* nil))

(defun WallRun:File ( ) (findfile "WallRun.wal"))

;;; Read the optional external file into the same ( name . lines ) form.
(defun WallRun:External ( / f in line name body out )
    (if (and (setq f (WallRun:File)) (setq in (open f "r")))
        (progn
            (setq line (read-line in))
            (while line
                (if (= "*" (substr line 1 1))
                    (progn
                        (setq name (strcase (substr line 2)) body "")
                        ;; Everything up to the next * belongs to this type, so a
                        ;; long build-up can be spread over several lines.
                        (setq line (read-line in))
                        (while (and line (/= "*" (substr line 1 1)))
                            (setq body (strcat body " " line)
                                  line (read-line in)))
                        (if (/= (vl-string-trim " " body) "")
                            (setq out (cons (cons name (read body)) out))))
                    (setq line (read-line in))))
            (close in)
            (reverse out)))
)

;;; Every type available, session first, then external, then built in - so a
;;; name defined later in the session, or in the office file, takes precedence.
(defun WallRun:AllTypes ( / out )
    (setq out (append *WallRun:User* (WallRun:External) WallRun:Builtin))
    ;; Keep only the first entry for each name.
    (vl-remove-if
        '(lambda (p) (not (eq p (assoc (car p) out))))
        out)
)

(defun WallRun:TypeNames ( ) (mapcar 'car (WallRun:AllTypes)))

;;; Load one type by name. Returns its line list, or nil.
(defun WallRun:Load ( name / hit )
    (setq name (strcase name))
    (if (setq hit (assoc name (WallRun:AllTypes)))
        (progn
            (WallRun:Put "TYPE" name)
            (WallRun:Put "LINES" (cdr hit))
            (princ (strcat "\nWall type " name " loaded - "
                           (itoa (length (cdr hit))) " line(s)."))
            (cdr hit))
        (progn (princ (strcat "\n** No wall type called " name ". **")) nil))
)

;;; ---------------------------------------------------------------------------
;;; DRAWING ONE WALL SEGMENT
;;;
;;; Draws every line of the wall type between two points and hands back the
;;; entity names in the same order as the type, which is what lets the corner
;;; fillet match line to line.
;;; ---------------------------------------------------------------------------

(defun WallRun:Segment ( p1 p2 perp lines clayer ccolor cltype / out lay lt col dist )
    (setq out nil)
    (foreach ln lines
        (setq lay  (car   ln)
              lt   (cadr  ln)
              col  (caddr ln)
              dist (last  ln))

        (if lay (command "_.LAYER" "_S" lay ""))
        (if lt  (command "_.LINETYPE" "_S" lt ""))
        (if col (command "_.COLOR" col))

        (command "_.LINE" (polar p1 perp dist) (polar p2 perp dist) "")
        (setq out (cons (entlast) out))

        ;; Put the drawing's own settings straight back, so a wall type that only
        ;; overrides colour does not leave the layer changed.
        (if lay (command "_.LAYER" "_S" clayer ""))
        (if lt  (command "_.LINETYPE" "_S" cltype ""))
        (if col (command "_.COLOR" ccolor)))
    (reverse out)
)

;;; Fillet each line of one segment to the matching line of the next. Wrapped
;;; because two lines that are already collinear cannot be filleted, and that is
;;; not worth stopping a wall run for.
(defun WallRun:Corner ( listA listB )
    (mapcar
        '(lambda (a b / ss)
             (if (and a b)
                 (progn
                     (setq ss (ssadd))
                     (ssadd a ss)
                     (ssadd b ss)
                     (vl-catch-all-apply
                         '(lambda ( ) (command "_.FILLET" ss))))))
        listA listB)
    (princ)
)

;;; ---------------------------------------------------------------------------
;;; WALLRUN
;;; ---------------------------------------------------------------------------

(defun c:WALLRUN ( / vals *error* lines p1 p2 pick sgn perp
                     clayer ccolor cltype segs first count opt )

    (setq vals (WallRun:Save))
    (defun *error* ( msg )
        (WallRun:Restore vals)
        (if (and msg (not (wcmatch (strcase msg t) "*break*,*cancel*,*exit*")))
            (princ (strcat "\n** WALLRUN 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")

    ;; A type must be loaded before anything can be drawn.
    (setq lines (WallRun:Get "LINES"))
    (if (null lines)
        (progn
            (princ "\nNo wall type loaded.")
            (initget "Load Custom")
            (setq opt (getkword "\n[Load a saved type/Custom offsets]: "))
            (cond
                ((= opt "Load")
                 (setq lines (WallRun:Load (getstring "\nType name: "))))
                ((= opt "Custom")
                 ;; The runtime-offset mode the old WALL3 provided, folded in here
                 ;; so a one-off wall does not need a saved type.
                 (setq lines nil)
                 (while (setq p1 (getdist "\nOffset from the run line <Enter to finish>: "))
                     (setq lines (append lines (list (list nil nil nil p1)))))
                 (if lines (WallRun:Put "LINES" lines))))))

    (if (null lines)
        (princ "\nNothing to draw with.")
        (progn
            (setq clayer (getvar "CLAYER")
                  ccolor (getvar "CECOLOR")
                  cltype (getvar "CELTYPE"))

            (setvar "FILLETRAD" 0)
            (setvar "BLIPMODE" 0)

            (initget 1)
            (setq p1 (getpoint "\nFrom point: "))
            (initget 1)
            (setq p2 (getpoint p1 "\nTo point: "))

            (grdraw p1 p2 -1)
            (initget 1)
            (setq pick (getpoint "\nWhich side does the wall sit on? "))
            (grdraw p1 p2 -1)

            (setq sgn   (WallRun:Side p1 (angle p1 p2) pick)
                  perp  (WallRun:Perp (angle p1 p2) sgn)
                  segs  (WallRun:Segment p1 p2 perp lines clayer ccolor cltype)
                  first (list p1 segs)
                  count 1
                  p1    p2)

            ;; Keep taking points until Enter, or Close to fillet back to the start.
            (while
                (and
                    (not (initget "Close"))
                    (setq p2 (getpoint p1 "\nTo point [Close]: "))
                    (cond
                        ((= p2 "Close")
                         (if (> count 1)
                             (progn
                                 (setq perp (WallRun:Perp (angle p1 (car first)) sgn))
                                 (WallRun:Corner
                                     segs
                                     (setq segs (WallRun:Segment p1 (car first) perp
                                                                 lines clayer ccolor cltype)))
                                 ;; And the closing corner, back onto the very
                                 ;; first segment drawn.
                                 (WallRun:Corner segs (cadr first))
                                 nil)
                             (progn (princ "\nCannot close until two segments are drawn.") t)))

                        (t
                         (setq perp (WallRun:Perp (angle p1 p2) sgn))
                         (WallRun:Corner
                             segs
                             (setq segs (WallRun:Segment p1 p2 perp lines clayer ccolor cltype)))
                         (setq p1 p2 count (1+ count))
                         t))))

            (princ (strcat "\n" (itoa count) " wall segment(s) drawn"
                           (if (WallRun:Get "TYPE")
                               (strcat " in type " (WallRun:Get "TYPE")) "")
                           "."))
        )
    )

    (WallRun:Restore vals)
    (princ)
)

;;; ---------------------------------------------------------------------------
;;; WALLTYPE
;;; ---------------------------------------------------------------------------

(defun c:WALLTYPE ( / vals *error* opt names name lines d v )

    (setq vals (WallRun:Save))
    (defun *error* ( msg )
        (WallRun:Restore vals)
        (if (and msg (not (wcmatch (strcase msg t) "*break*,*cancel*,*exit*")))
            (princ (strcat "\n** WALLTYPE error: " msg " **")))
        (princ))

    (setvar "CMDECHO" 0)

    (initget "List Load Current Define")
    (setq opt (getkword "\nWall type [List/Load/Current/Define] <List>: "))
    (if (null opt) (setq opt "List"))

    (cond
        ((= opt "List")
         (if (setq names (WallRun:TypeNames))
             (progn
                 (princ (strcat "\n" (itoa (length names)) " wall type(s) in "
                                (WallRun:File) ":"))
                 (foreach n names (princ (strcat "\n  " n))))
             (princ "\nNo wall types found.")))

        ((= opt "Load")
         (setq name (getstring "\nType name to load: "))
         (if (/= name "") (WallRun:Load name)))

        ((= opt "Current")
         (if (WallRun:Get "TYPE")
             (progn
                 (princ (strcat "\nCurrent wall type: " (WallRun:Get "TYPE")))
                 (foreach ln (WallRun:Get "LINES")
                     (princ (strcat "\n  offset " (rtos (last ln) 2 3)
                                    "  layer " (if (car ln) (car ln) "current")
                                    "  linetype " (if (cadr ln) (cadr ln) "current")
                                    "  colour " (if (caddr ln) (caddr ln) "current")))))
             (princ "\nNo wall type loaded.")))

        ((= opt "Define")
         ;; Builds a type interactively and makes it current straight away. It
         ;; lasts for the drawing session; keeping it permanently is a separate
         ;; question, asked below, because that needs somewhere to write to.
         (setq name (strcase (getstring "\nName for the new wall type: ")))
         (if (= name "")
             (princ "\nNo name given.")
             (progn
                 (setq lines nil)
                 (princ "\nEnter each line's offset from the run line. Enter alone to finish.")
                 (while (setq d (getdist "\n  Offset: "))
                     (setq lines (append lines (list (list nil nil nil d)))))
                 (if (null lines)
                     (princ "\nNo lines given - nothing defined.")
                     (progn
                         ;; Available immediately, ahead of anything of the same
                         ;; name in the office file or built in.
                         (setq *WallRun:User* (cons (cons name lines) *WallRun:User*))
                         (WallRun:Put "TYPE" name)
                         (WallRun:Put "LINES" lines)
                         (princ (strcat "\nWall type " name
                                        " defined and made current, for this session."))

                         (initget "Yes No")
                         (if (= "Yes" (getkword "\nKeep it permanently in WallRun.wal [Yes/No] <No>: "))
                             (progn
                                 ;; Written to an existing office file if there is
                                 ;; one; otherwise a new file is started beside
                                 ;; the drawing, which is somewhere findable.
                                 (setq v (WallRun:File))
                                 (if (null v)
                                     (setq v (strcat (getvar "DWGPREFIX") "WallRun.wal")))
                                 (if (setq d (open v "a"))
                                     (progn
                                         (write-line (strcat "*" name) d)
                                         (write-line (vl-prin1-to-string lines) d)
                                         (close d)
                                         (princ (strcat "\nSaved to " v
                                                        "\nAdd that folder to the support file search"
                                                        " path so it is found next time.")))
                                     (princ (strcat "\n** Could not write to " v " **")))))))))
        )
    )

    (WallRun:Restore vals)
    (princ)
)

;;; ---------------------------------------------------------------------------
;;; THE OPENING ENGINE
;;;
;;; Shared by all four opening commands.
;;;
;;;   keepNear  T to split the near face at the jambs but leave it in place;
;;;             nil to remove it between them
;;;   keepFar   the same for the far face
;;;
;;; Returns (p1 p2 p3 p4 across sgn) where p1-p2 is the first jamb, p3-p4 the
;;; second, and `across` is the angle through the wall.
;;; ---------------------------------------------------------------------------

(defun WallRun:Break ( prompt keepNear keepFar / sel p1 p2 p3 p4 dist mid
                       across along sgn pick size )

    (setvar "BLIPMODE" 1)
    (setvar "OSMODE" 0)

    ;; Touch the wall. NEAREST puts the point exactly on the line, which
    ;; everything downstream depends on.
    (while (not (and (setq sel (entsel "\nTouch a point on the wall: "))
                     (setq p1 (osnap (cadr sel) "_near"))))
        (princ "\nNothing there - try again."))

    ;; Optional set-out from the nearer end of that line.
    (initget 6)
    (if (setq dist (getdist "\nDistance from the end <Enter for where you touched>: "))
        (progn
            (setq mid (osnap p1 "_midp")
                  p2  (osnap p1 "_endp"))
            (if (and mid p2)
                (setq p1 (polar p2 (angle p2 mid) dist)))))

    ;; The opposite face. PERPENDICULAR measures the wall for us, so the opening
    ;; works on any thickness without being told it.
    (setvar "OSMODE" 128)
    (initget 1)
    (setq p2 (getpoint p1 "\nTouch the opposite face of the wall: "))
    (setvar "OSMODE" 0)
    (setvar "BLIPMODE" 0)

    (setq across (angle p1 p2))

    (setq size (getdist (strcat "\n" prompt " <"
                                (rtos (WallRun:Get "WIDTH") 2 2) ">: ")))
    (if size (WallRun:Put "WIDTH" size) (setq size (WallRun:Get "WIDTH")))

    (initget 1)
    (setq pick  (getpoint p1 "\nWhich way along the wall? ")
          sgn   (WallRun:Side p1 across pick)
          along (WallRun:Perp across sgn)
          p3    (polar p1 along size)
          p4    (polar p2 along size))

    ;; BREAK with the same point twice splits without removing anything; with two
    ;; different points it removes what lies between them.
    (if keepNear
        (progn (command "_.BREAK" p1 p1 "@") (command "_.BREAK" p3 p3 "@"))
        (command "_.BREAK" p1 p1 p3))
    (if keepFar
        (progn (command "_.BREAK" p2 p2 "@") (command "_.BREAK" p4 p4 "@"))
        (command "_.BREAK" p2 p2 p4))

    ;; The two jambs.
    (command "_.LINE" p1 p2 "")
    (command "_.LINE" p3 p4 "")

    (list p1 p2 p3 p4 across sgn)
)

;;; ---------------------------------------------------------------------------
;;; THE FOUR OPENING COMMANDS
;;; ---------------------------------------------------------------------------

(defun c:WALLOPEN ( / vals *error* )
    (setq vals (WallRun:Save))
    (defun *error* ( msg )
        (WallRun:Restore vals)
        (if (and msg (not (wcmatch (strcase msg t) "*break*,*cancel*,*exit*")))
            (princ (strcat "\n** WALLOPEN 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")
    (WallRun:Break "Width of the opening" nil nil)
    (WallRun:Restore vals)
    (princ)
)

(defun c:WALLDOOR ( / vals *error* r p1 p2 p3 across sgn leaf ang thk swing )
    (setq vals (WallRun:Save))
    (defun *error* ( msg )
        (WallRun:Restore vals)
        (if (and msg (not (wcmatch (strcase msg t) "*break*,*cancel*,*exit*")))
            (princ (strcat "\n** WALLDOOR 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")

    (setq r (WallRun:Break "Width of the door" nil nil))
    (if r
        (progn
            (setq p1     (nth 0 r)
                  p3     (nth 2 r)
                  across (nth 4 r)
                  sgn    (nth 5 r))

            ;; Swing angle, kept between 0 and 180 - a door cannot open through
            ;; its own wall, and 0 or 180 would put the leaf inside it.
            (setq swing nil)
            (while (null swing)
                (setq swing (getorient p1 (strcat "\nSwing angle <"
                                                  (angtos (WallRun:Get "DOORANG")
                                                          (getvar "AUNITS")
                                                          (getvar "AUPREC")) ">: ")))
                (cond
                    ((null swing) (setq swing (WallRun:Get "DOORANG")))
                    ((and (> swing 0.0) (< swing pi)) (WallRun:Put "DOORANG" swing))
                    (t (princ "\nThe swing must be between 0 and 180 degrees.")
                       (setq swing nil))))

            ;; The leaf runs from the hinge at p1, out at the swing angle.
            (setq leaf (polar p1 (+ across (* sgn (+ (* pi 0.5) swing)))
                              (distance p1 p3))
                  ang  (angle p1 leaf))

            (setq thk (getdist (strcat "\nLeaf thickness, 0 for a single line <"
                                       (rtos (WallRun:Get "DOORTHK") 2 2) ">: ")))
            (if thk (WallRun:Put "DOORTHK" thk) (setq thk (WallRun:Get "DOORTHK")))

            (if (zerop thk)
                (command "_.LINE" leaf p1 "")
                (command "_.PLINE" leaf p1
                         (polar p1   (- ang (* sgn (* pi 0.5))) thk)
                         (polar leaf (- ang (* sgn (* pi 0.5))) thk) ""))

            ;; Swing arc, from the far jamb through the swing angle.
            (command "_.ARC" "_C" p1 p3 "_A" (* sgn (/ (* swing 180.0) pi)))))

    (WallRun:Restore vals)
    (princ)
)

(defun c:WALLWIN ( / vals *error* r p1 p2 p3 p4 across half ledge )
    (setq vals (WallRun:Save))
    (defun *error* ( msg )
        (WallRun:Restore vals)
        (if (and msg (not (wcmatch (strcase msg t) "*break*,*cancel*,*exit*")))
            (princ (strcat "\n** WALLWIN 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")

    ;; The near face is kept - the ledge sits against it.
    (setq r (WallRun:Break "Width of the window" t nil))
    (if r
        (progn
            (setq p1 (nth 0 r) p2 (nth 1 r) p3 (nth 2 r) p4 (nth 3 r)
                  across (nth 4 r)
                  half   (/ (distance p1 p2) 2.0))

            ;; Glass on the centreline of the wall.
            (command "_.LINE" (polar p1 across half) (polar p3 across half) "")

            (setq ledge (getdist (strcat "\nLedge projection <"
                                         (rtos (WallRun:Get "LEDGE") 2 2) ">: ")))
            (if ledge (WallRun:Put "LEDGE" ledge) (setq ledge (WallRun:Get "LEDGE")))

            (command "_.PLINE" p2 (polar p2 across ledge)
                               (polar p4 across ledge) p4 "")))

    (WallRun:Restore vals)
    (princ)
)

(defun c:WALLRELITE ( / vals *error* keep r p1 p2 p3 across half )
    (setq vals (WallRun:Save))
    (defun *error* ( msg )
        (WallRun:Restore vals)
        (if (and msg (not (wcmatch (strcase msg t) "*break*,*cancel*,*exit*")))
            (princ (strcat "\n** WALLRELITE 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")

    ;; A relite may sit in a wall that stays intact, or cut right through it.
    (initget "Yes No")
    (setq keep (getkword "\nRemove the wall between the jambs [Yes/No] <Yes>: "))
    (setq keep (= keep "No"))

    (setq r (WallRun:Break "Width of the relite" keep keep))
    (if r
        (progn
            (setq p1 (nth 0 r) p2 (nth 1 r) p3 (nth 2 r)
                  across (nth 4 r)
                  half   (/ (distance p1 p2) 2.0))
            (command "_.LINE" (polar p1 across half) (polar p3 across half) "")))

    (WallRun:Restore vals)
    (princ)
)

(princ)