;------------------------------------------------
; PENET.LSP
; By Roger Rapp
;    Rappid Developments
;
; Description: This sloppy little routine creates four 3DFaces around a desired
; rectangular penetration in an existing surface.  This routine does not
; remove any existing face(s), nor set up the required ucs.  You should do
; this advance work, if needed.  The routine will simply prompt you for four
; points; lower left and upper right of the outer surface boundaries, and lower
; left and upper right of the desired penetration.  Then the routine creates
; the four new 3dfaces.
;
; Disclaimer: This thing was whipped over the Christmas weekend to help me do
; a tedious job faster.  If it helps you, great, if not, well, it's still free.
; There are no variable re-sets, no local variables, a shameless mis-use of
; the variables that I have defined, and there's none of the other stuff that
; would be included if I'd taken more time, or asked for money. <grin>
;------------------------------------------------
(defun C:PENET ()
   (setvar  "FLATLAND"  0)
   (setvar  "LUPREC"    4)
   (setvar  "CMDECHO"   0)
   (command "UCSICON"  "ON")
   (command "UCSICON"  "OR")
   (setvar  "HIGHLIGHT" 1)
   (Getem)
   (princ)
)
;------------------------------------------------
(defun Getem ()
      (setq p1 (getpoint "\nLower Left Wall Corner:"))
      (setq p2 (getpoint "\nUpper Right Wall Corner:"))
      (setq p3 (getpoint "\nLower Left  Opening Corner:"))
      (setq p4 (getpoint "\nUpper Right Opening Corner:"))
      (Doit)
)
;------------------------------------------------
(defun Doit ()
   ;set up x,y of points for wall
   (setq x11 (car  p1)
         y11 (cadr p1)
         x12 (car  p2)
         y12 (cadr p1)
         x13 (car  p2)
         y13 (cadr p2)
         x14 (car  p1)
         y14 (cadr p2)
   ;set up x,y of points for opening
         x21 (car  p3)
         y21 (cadr p3)
         x22 (car  p4)
         y22 (cadr p3)
         x23 (car  p4)
         y23 (cadr p4)
         x24 (car  p3)
         y24 (cadr p4)
   ;set up faces
         f1ll (list x11  y24  0)
         f1lr (list x13  y23  0)
         f1ur (list x13  y13  0)
         f1ul (list x14  y14  0)
         f2ll (list x11  y11  0)
         f2lr (list x21  y11  0)
         f2ur (list x24  y24  0)
         f2ul (list x11  y24  0)
         f3ll (list x22  y11  0)
         f3lr (list x12  y11  0)
         f3ur (list x12  y23  0)
         f3ul (list x22  y23  0)
         f4ll (list x21  y11  0)
         f4lr (list x22  y11  0)
         f4ur (list x23  y21  0)
         f4ul (list x21  y21  0)
   )
   (command "3DFACE" f1ll f1lr f1ur f1ul "")
   (command "3DFACE" f2ll f2lr f2ur f2ul "")
   (command "3DFACE" f3ll f3lr f3ur f3ul "")
   (command "3DFACE" f4ll f4lr f4ur f4ul "")
)
;------------------------------------------------