;=======================================================================
;    AR-Wall.Lsp                                    Jun 03, 2000
;    Build Walls For Accurender From PLINE Path
;================== Start Program ======================================
(princ "\nCopyright (C) 2000, Fabricated Designs, Inc.")
(princ "\nLoading AR-Wall v1.0 ")
(setq arw_ nil lsp_file "AR-Wall")

;================== Macros =============================================
(defun PDot ()(princ "."))

(PDot);++++++++++++ Set Modes & Error ++++++++++++++++++++++++++++++++++
(defun arw_smd ()
 (SetUndo)
 (setq oldlay (getvar "CLAYER")
       olderr *error*
      *error* (lambda (e)
                (while (> (getvar "CMDACTIVE") 0)
                       (command))
                (and (/= e "quit / exit abort")
                     (princ (strcat "\nError: *** " e " *** ")))
                (command "_.UNDO" "_END" "_.U")
                (arw_rmd))
       arw_var '(("CMDECHO"   . 0) ("MENUECHO"   . 0)
                ("MENUCTL"   . 0) ("MACROTRACE" . 0)
                ("OSMODE"    . 0) ("SORTENTS"   . 119)
                ("MODEMACRO" . ".")
                ("BLIPMODE"  . 0) ("EXPERT"     . 0)
                ("SNAPMODE"  . 1) ("PLINEWID"   . 0.0)
                ("ORTHOMODE" . 1) ("GRIDMODE"   . 0)
                ("ELEVATION" . 0) ("THICKNESS"  . 0)
                ("FILEDIA"   . 0) ("FILLMODE"   . 0)
                ("SPLFRAME"  . 0) ("UNITMODE"   . 0)
                ("TEXTEVAL"  . 0) ("ATTDIA"     . 0)
                ("AFLAGS"    . 0) ("ATTREQ"     . 1)
                ("ATTMODE"   . 1) ("UCSICON"    . 1)
                ("HIGHLIGHT" . 1) ("REGENMODE"  . 1)
                ("COORDS"    . 2) ("DRAGMODE"   . 2)
                ("DIMZIN"    . 1) ("PDMODE"     . 0)
                ("CECOLOR"   . "BYLAYER")
                ("CELTYPE"   . "BYLAYER")))
 (foreach v arw_var
      (setq arw_rst (cons (cons (car v) (getvar (car v))) arw_rst))
      (setvar (car v) (cdr v)))
 (princ (strcat (getvar "PLATFORM") " Release " (ver)
        " -  Development Routine ....\n"))
 (princ))

(PDot);++++++++++++ Return Modes & Error +++++++++++++++++++++++++++++++
(defun arw_rmd ()
  (SetLayer oldlay)
  (setq *error* olderr)
  (foreach v arw_rst (setvar (car v) (cdr v)))
  (command "_.UNDO" "_END")
  (prin1))

(PDot);++++++++++++ Set And Start An Undo Group ++++++++++++++++++++++++
(defun SetUndo ()
 (and (zerop (getvar "UNDOCTL"))
      (command "_.UNDO" "_ALL"))
 (and (= (logand (getvar "UNDOCTL") 2) 2)
      (command "_.UNDO" "_CONTROL" "_ALL"))
 (and (= (logand (getvar "UNDOCTL") 8) 8)
      (command "_.UNDO" "_END"))
 (command "_.UNDO" "_GROUP"))

(PDot);++++++++++++ Make Layer Current +++++++++++++++++++++++++++++++++
(defun SetLayer (name / ldef flag)
  (command "_.LAYER")
  (if (not (tblsearch "LAYER" name))
      (command "_Make" name)
      (progn
        (setq ldef (tblsearch "LAYER" name)
              flag (cdr (assoc 70 ldef)))
        (and (= (logand flag  1)  1)
             (command "_Thaw" name))
        (and (minusp (cdr (assoc 62 ldef)))
             (command "_On" name))
        (and (= (logand flag  4)  4)
             (command "_Unlock" name))
        (and (= (logand flag 16) 16)
             (princ "\nCannot Set To XRef Dependent Layer")
             (quit))
        (command "_Set" name)))
  (command "")
  name)

;++++++++++++ Get Entity Name +++++++++++++++++++++++++
(defun GetOne (/ st os)
 (setq os (getvar "SNAPMODE") s nil)
 (setvar "SNAPMODE" 0)
 (while (not st)
        (setq st (ssget))
        (and st
             (/= (sslength st) 1)
             (princ "\nOnly 1 At A Time Please\n")
             (setq st nil)))
 (setvar "SNAPMODE" os)
 (setq s (ssname st 0)))

(PDot);************ Main Program ***************************************
(defun arw_ (/ olderr oldlay arw_var arw_rst s pl vlist vlen wl tb gb)
  (arw_smd)
;  (*debug* 3 "arw_")
  (while (or (not pl)
             (/= "POLYLINE" (cdr (assoc 0 (entget pl))))
             (not (equal (cdr (assoc 210 (entget pl))) '(0 0 1))))
         (princ "\nSelect WCS Polyline Path:   ")
         (setq pl (GetOne)))

  (while (/= "SEQEND" (cdr (assoc 0 (entget (entnext pl)))))
         (setq pl (entnext pl)
            vlist (cons (cdr (assoc 10 (entget pl))) vlist)))
  (setq vlist (reverse vlist)
         vlen (length vlist))

;;;WALL LINE
  (command "_.COPY" s "" '(0 0) '(0 0))
  (setq wl (entlast))
  (command "_.PEDIT" (entlast) "_W" 0.125 "")

  (command "_.OFFSET" 0.25 (car vlist))
  (princ "\nOffset Side:   ")
  (command pause)
  (command "")

;;;GROUT BASE
  (setq gb (entlast))
  (command "_.PEDIT" (entlast) "_W" 0.375 "")

;;;TOE BASE
  (command "_.COPY" gb "" '(0 0) '(0 0))
  (setq tb (entlast))
  (command "_.PEDIT" (entlast) "_W" 0.375 "")

 (if (not (tblsearch "LAYER" "GROUT"))
     (command "_.LAYER" "_New" "GROUT" "_Color" 8 "GROUT" ""))
 (if (not (tblsearch "LAYER" "BASE"))
     (command "_.LAYER" "_New" "BASE" "_Color" 10 "BASE" ""))
 (if (not (tblsearch "LAYER" "3D-WALL"))
     (command "_.LAYER" "_New" "3D-WALL" "_Color" 7 "3D-WALL" ""))

 (command "_.CHANGE" wl "" "_P" "_LA" "3D-WALL" "_T" 108 "_E" 0 "")
 (command "_.CHANGE" gb "" "_P" "_LA" "GROUT" "_T" 0.25 "_E" 0 "")
 (command "_.CHANGE" tb "" "_P" "_LA" "BASE" "_T" 5.75 "_E" 0.25 "")

;  (*break*)
;  (*debug* 0 "arw_")
  (arw_rmd))

(PDot);************ Load Program ***************************************
(defun C:AR-Wall () (arw_))
(if arw_ (princ "\nAR-Wall Loaded\n"))
(prin1)
;|================== End Program =======================================