;;; --------------------------------------------------------------------------- ;;; FaceHole.lsp ;;; code compiled by YZ August 2026 ;;; --------------------------------------------------------------------------- ;;; PUNCH A RECTANGULAR OPENING THROUGH A 3D FACE ;;; ;;; PURPOSE ;;; Cuts a window or door opening in a wall built from 3D faces. Pick the ;;; face, pick two corners for the opening, and the face is replaced by four ;;; faces that surround the hole - so the wall still reads as solid, still ;;; hides what is behind it, and still shades, but now has a hole in it. ;;; ;;; Meant to go with HOUSESHELL, which builds the walls this cuts into. ;;; ;;; WHY FOUR FACES AND NOT ONE WITH A HOLE ;;; A 3D face is a flat triangle or quadrilateral and cannot have a hole in ;;; it. The only way to make an opening is to surround it - a face above, one ;;; below, and one each side. The joins between those four would normally ;;; show as lines across the wall, so the edges along each join are marked ;;; INVISIBLE and the wall reads as one surface again. ;;; ;;; Which edges those are is held in DXF group 70 as a bit per edge: 1 for the ;;; first, 2 for the second, 4 for the third, 8 for the fourth. The original ;;; face's own hidden edges are carried across to the new ones, so a wall ;;; already tidied up does not sprout lines where it used to be clean. ;;; ;;; WHAT WAS FIXED ;;; - Pressing Enter instead of picking a face gave (entget nil) and stopped ;;; with a bad argument, inside a loop with no way out but ESC. ;;; - It saved the current UCS under the name "temucs" and left that named UCS ;;; in the drawing every time it ran. UCS Previous does the same job and ;;; leaves nothing behind. ;;; - It finished with (setvar "cmdecho" 1) - setting the value to 1 rather ;;; than back to whatever it had been. Anyone working with command echo off ;;; had it switched on for them. ;;; - Every variable was global, including single letters. ;;; - It printed a copyright notice to the command line at LOAD time, so ;;; merely loading the file wrote to the screen. ;;; ;;; FACEHOLE - cut an opening through a 3D face ;;; --------------------------------------------------------------------------- ;;; --------------------------------------------------------------------------- ;;; SUPPORT ;;; --------------------------------------------------------------------------- ;;; The four corners of a 3D face. A triangular face repeats its third corner ;;; as the fourth, which the caller has to allow for. (defun Hole:Corners ( data ) (list (cdr (assoc 10 data)) (cdr (assoc 11 data)) (cdr (assoc 12 data)) (cdr (assoc 13 data))) ) ;;; Make a face. HIDE is a list of four flags saying whether each edge is ;;; invisible, which are folded into the single bit field group 70 wants. (defun Hole:Face ( p1 p2 p3 p4 hide layer / flags ) (setq flags 0) (if (nth 0 hide) (setq flags (+ flags 1))) (if (nth 1 hide) (setq flags (+ flags 2))) (if (nth 2 hide) (setq flags (+ flags 4))) (if (nth 3 hide) (setq flags (+ flags 8))) (entmake (list '(0 . "3DFACE") (cons 8 layer) (cons 10 p1) (cons 11 p2) (cons 12 p3) (cons 13 p4) (cons 70 flags))) ) ;;; Is edge N of the original face hidden? (defun Hole:Hidden ( invis n ) (= (expt 2 n) (logand (expt 2 n) invis))) ;;; --------------------------------------------------------------------------- ;;; MAIN COMMAND ;;; --------------------------------------------------------------------------- (defun c:FACEHOLE ( / *error* vars vals sel ent data corners d1 d2 d3 d4 invis layer p1 p2 f1 f2 f3 f4 pts n ucsSaved ) (setq vars '("CMDECHO" "BLIPMODE" "OSMODE") vals (mapcar 'getvar vars)) (defun Hole:Restore ( ) ;; Put the UCS back before anything else - the rest is meaningless if ;; the coordinate system is still sitting on the wall. (if ucsSaved (vl-catch-all-apply '(lambda ( ) (command "_.UCS" "_Previous")) '())) (setq ucsSaved nil) (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 ) (Hole:Restore) (if (and msg (not (wcmatch (strcase msg t) "*break*,*cancel*,*exit*"))) (princ (strcat "\n** FACEHOLE 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") ;; --- pick the wall ------------------------------------------------------ (setq ent nil) (while (and (null ent) (setq sel (entsel "\nWall face to cut through : "))) (if (= "3DFACE" (cdr (assoc 0 (entget (car sel))))) (setq ent (car sel)) (princ (strcat "\n That is a " (cdr (assoc 0 (entget (car sel)))) ", not a 3D face.")))) (if (null ent) (princ "\nCancelled.") (progn (setq data (entget ent) corners (Hole:Corners data) d1 (nth 0 corners) d2 (nth 1 corners) d3 (nth 2 corners) d4 (nth 3 corners) invis (cond ((cdr (assoc 70 data))) (t 0)) layer (cdr (assoc 8 data))) (if (equal d3 d4 1e-9) (princ "\n** That face is a triangle. This needs a four-sided one. **") (progn (redraw ent 3) ;; Work in the plane of the wall, so the opening can be ;; picked flat on rather than in space. (command "_.UCS" "_3point" d1 d2 d3) (setq ucsSaved t) (setvar "OSMODE" 0) (setq p1 (getpoint "\nOne corner of the opening: ")) (if p1 (setq p2 (getcorner p1 "\nOpposite corner: "))) (if (or (null p1) (null p2)) (princ "\nCancelled.") (progn ;; Four corners of the opening, in the wall's own ;; plane, then back to world coordinates. (setq pts (list (trans p1 1 0) (trans (list (car p2) (cadr p1) (caddr p1)) 1 0) (trans p2 1 0) (trans (list (car p1) (cadr p2) (caddr p2)) 1 0))) ;; Match each opening corner to the wall corner it ;; belongs beside. Sorting by nearest is what keeps ;; the four surrounding faces from crossing over ;; each other when the wall is picked from behind. (setq f1 (car (vl-sort pts '(lambda ( a b ) (< (distance d1 a) (distance d1 b))))) pts (vl-remove f1 pts)) (setq f2 (car (vl-sort pts '(lambda ( a b ) (< (distance d2 a) (distance d2 b))))) pts (vl-remove f2 pts)) (setq f3 (car (vl-sort pts '(lambda ( a b ) (< (distance d3 a) (distance d3 b))))) pts (vl-remove f3 pts)) (setq f4 (car pts)) (command "_.UCS" "_Previous") (setq ucsSaved nil) ;; Four faces round the hole. On each, the two edges ;; running into the opening are hidden, and so is ;; the edge along the opening itself; the outer edge ;; keeps whatever the original had. (Hole:Face d1 d2 f2 f1 (list (Hole:Hidden invis 0) t t t) layer) (Hole:Face d2 d3 f3 f2 (list (Hole:Hidden invis 1) t t t) layer) (Hole:Face d3 d4 f4 f3 (list (Hole:Hidden invis 2) t t t) layer) (Hole:Face d4 d1 f1 f4 (list (Hole:Hidden invis 3) t t t) layer) (entdel ent) (princ "\nOpening cut - the wall is now four faces with the joins hidden.") ) ) ) ) ) ) (Hole:Restore) (princ) ) (princ)