;;; --------------------------------------------------------------------------- ;;; CeilingGrid.lsp ;;; code compiled by YZ August 2026 ;;; --------------------------------------------------------------------------- ;;; SUSPENDED CEILING GRID INSIDE A ROOM ;;; ;;; PURPOSE ;;; Fills a room outline with a suspended ceiling grid at the tile size you ;;; give, at any rotation, and centred so the cut tiles come out equal on ;;; opposite walls - which is what a ceiling contractor will do on site and ;;; what the drawing should therefore show. ;;; ;;; Pick the room boundary, give the tile size, and nudge the grid until the ;;; edge tiles look right. ;;; ;;; CENTRING ;;; The grid starts centred on the middle of the boundary's extents, so both ;;; edge tiles in each direction are the same width. That is the usual ;;; starting point; from there you can shift it to line up with a feature, and ;;; the cut tiles rebalance as you go. ;;; ;;; WHAT WAS FIXED ;;; - The error handler was written (foreach a (err lay xlist ...) (setq a nil)) ;;; which calls ERR as a FUNCTION with fifteen arguments, rather than ;;; listing variables to clear. It failed the moment any error reached it - ;;; so an error while handling an error, leaving the layer, SNAPBASE and ;;; CMDECHO all as the routine had set them. ;;; - SNAPBASE was restored by setting it to the STRING "0,0" rather than to ;;; the point it had been. It is a point variable; a string is not a point, ;;; and it was not what the user had anyway. ;;; - It drew a scratch polyline and erased it just to read the current ;;; polyline width off the screen. ;;; - Every variable was global, and the whole file was written without spaces ;;; between tokens, which is why none of this was obvious. ;;; ;;; CEILGRID - lay a ceiling grid inside a room outline ;;; --------------------------------------------------------------------------- ;; The room's extents are read through the ActiveX bounding box, so Visual LISP ;; has to be loaded before anything here runs. (vl-load-com) (setq *Ceil:Tile* nil) (defun Ceil: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 c:CEILGRID ( / *error* vars vals sel ent obj tileX tileY ang lay v lo hi cen ss hatchWas ) (setq vars '("CMDECHO" "BLIPMODE" "OSMODE" "CLAYER" "SNAPBASE" "SNAPANG") vals (mapcar 'getvar vars)) (defun Ceil:Restore ( ) ;; SNAPBASE is a POINT variable. Putting a string into it is what the ;; original did and it is not a valid value. (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 ) (Ceil:Restore) (if (and msg (not (wcmatch (strcase msg t) "*break*,*cancel*,*exit*"))) (princ (strcat "\n** CEILGRID error: " msg " **"))) (princ) ) (setvar "CMDECHO" 0) (setvar "BLIPMODE" 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") (princ "\nThe room boundary must be a closed polyline.") (setq ent nil) (while (and (null ent) (setq sel (entsel "\nRoom boundary : "))) (setq v (entget (car sel))) (cond ((not (member (cdr (assoc 0 v)) '("LWPOLYLINE" "POLYLINE" "CIRCLE" "ELLIPSE"))) (princ (strcat "\n A " (cdr (assoc 0 v)) " cannot enclose a room."))) ((and (member (cdr (assoc 0 v)) '("LWPOLYLINE" "POLYLINE")) (/= 1 (logand 1 (cdr (assoc 70 v))))) (princ "\n That polyline is not closed.")) (t (setq ent (car sel))))) (if (null ent) (princ "\nCancelled.") (progn (setvar "OSMODE" 0) (initget 6) (setq tileX (getdist (strcat "\nTile size across" (if *Ceil:Tile* (strcat " <" (rtos *Ceil:Tile* 2 3) ">") "") ": "))) (if (null tileX) (setq tileX *Ceil:Tile*)) (if (null tileX) (princ "\nNo tile size given.") (progn (setq *Ceil:Tile* tileX) (initget 6) (setq tileY (getdist (strcat "\nTile size along <" (rtos tileX 2 3) ">: "))) (if (null tileY) (setq tileY tileX)) (setq ang (getangle "\nGrid rotation <0>: ")) (if (null ang) (setq ang 0.0)) ;; Centre of the boundary's extents - where a ceiling ;; contractor would start setting out. (setq obj (vlax-ename->vla-object ent)) (vla-getboundingbox obj 'lo 'hi) (setq lo (vlax-safearray->list lo) hi (vlax-safearray->list hi) cen (list (/ (+ (car lo) (car hi)) 2.0) (/ (+ (cadr lo) (cadr hi)) 2.0) 0.0)) (setq lay (Ceil:Layer "Ceiling-Grid" 8)) (setvar "CLAYER" lay) ;; The grid is two hatches at right angles. SNAPBASE is what ;; a user-defined hatch pattern measures its origin from, so ;; it is set to the centre and the lines fall symmetrically. (setvar "SNAPBASE" cen) (setvar "SNAPANG" ang) (setq hatchWas (entlast) ss (ssadd)) (command "_.-HATCH" "_Properties" "_User" (/ (* 180.0 ang) pi) tileY "_No" "_Select" ent "" "") (if (not (eq (entlast) hatchWas)) (ssadd (entlast) ss)) (setq hatchWas (entlast)) (command "_.-HATCH" "_Properties" "_User" (/ (* 180.0 (+ ang (/ pi 2.0))) pi) tileX "_No" "_Select" ent "" "") (if (not (eq (entlast) hatchWas)) (ssadd (entlast) ss)) (if (zerop (sslength ss)) (princ "\n** Nothing hatched - the boundary may not be closed. **") (progn ;; Let it be nudged into place, with the grid moving ;; as one. (initget "Yes No") (if (/= "No" (getkword "\nNudge the grid into position [Yes/No] : ")) (progn (setq v (getpoint cen "\n Move the grid from the room centre to: ")) (if v (command "_.MOVE" ss "" cen v)))) (princ (strcat "\n" (rtos tileX 2 3) " by " (rtos tileY 2 3) " grid laid on layer " lay ", centred on the room."))))))) ) (Ceil:Restore) (princ) ) (princ)