; WALLS.LSP   [Article Figure 2]   (c)1990, Barry Bowen

; **********************************************************
; WALLS.LSP
; Copyright (c) Barry R. Bowen 1990
; ----------------------------------------------------------
; TOOLBOX Routines Used:
; (CKWALL)        Check for current wall thickness (Dec '90)
; (D90)             Converts 90 degrees to radians (Mar '89)
; *ERROR*                  Error handling routine (Sept '89)
; (LS) (RL)  Create new layer and restore original (Feb '90)
; (V1)             Saves original system variables (Feb '89)
; (V1R)         Restores original system variables (Feb '89)
; (V3)                            Start-up routine (Feb '89)
; (V4)                              Ending routine (Feb '89)
; (WSTART)      Statr-up routine for Wall programs (Dec '90)
; ----------------------------------------------------------
; Variables:
; ANG  = Angle between the begin point and the next point
; ANG1 = ANG plus 90 degrees
; ANG2 = ANG1 plus 180 degrees
; ANS  = Variable for questions
; CI   = Cleanup wall intersection variable
; DIST = Distance between PT1 and PT2
; EN   = Center Polyline for the wall
; EN1  = First offset polyline
; EN2  = Second offset polyline
; PT   = Point used for offset command
; PT1  = Wall line begin point
; PT2  = Next point from PT1
; PT3  = Point for offset on first side
; PT4  = Point for offset on second side
; SS1  = Selection-set for trimming beginning wall
; SS2  = Selection-set for trimming ending wall
; TPT1 = First trim selection point
; TPT2 = Second trim selection point
; WLTK = Current wall thickness [Global]
; ----------------------------------------------------------

(defun C:WALLS (/ ANG ANG1 ANG2 ANS CI DIST EN EN1 EN2 PT   ; 1
                PT1 PT2 PT3 PT4 OPT1 OPT2 SS1 SS2 TPT1 TPT2); 2
  (WSTART)                                                  ; 3
  (setq CI (strcase                                         ; 4
           (getstring "\nCleanup Intersections? <Y>: ")))   ; 5
  (if (or (= CI "") (= CI "Y")) (setq CI "T") (setq CI nil)); 6
  (setq ANS (getstring "\nBegin From Offset <Y>? "))        ; 7
  (if (or (= ANS "") (= ANS "Y"))                           ; 8
    (progn                                                  ; 9
      (setq OPT1 (getpoint "\nBegin Offset From: ")         ;10
            OPT2 (getpoint OPT1 "\nDistance/Angle: ")       ;11
             PT1 OPT2))                                     ;12
    (progn                                                  ;13
      (setq PT1 (getpoint "\nBegin Point: ")                ;14
           OPT2 PT1))                                       ;15
   )                                                        ;16
   (setq SS1 (ssget PT1))                                   ;17
   (if (/= SS1 nil)                                         ;18
     (progn (setq TPT1 PT1 SS1 nil))                        ;19
     (setq TPT1 nil)                                        ;20
   )                                                        ;21
   (setq PT2 (getpoint PT1 "\nNext Point: ")                ;22
         ANG (angle PT1 PT2)                                ;23
        DIST (distance PT1 PT2)                             ;24
          PT (polar PT1 ANG (/ DIST 2.0))                   ;25
        ANG1 (+ ANG (D90))                                  ;26
        ANG2 (+ ANG1 pi))                                   ;27
   (command "pline" PT1 "w" 0 0 PT2)                        ;28
   (while PT2                                               ;29
     (setq PT1 PT2)                                         ;30
     (command (setq PT2                                     ;31
              (getpoint PT1 "\nNext Point <Return>: ")))    ;32
   )                                                        ;33
   (setq EN (entlast))                                      ;34
   (command "erase" EN "")                                  ;35
   (setq PT3 (polar PT ANG1 WLTK)                           ;36
         PT4 (polar PT ANG2 WLTK)                           ;37
         SS2 (ssget PT1))                                   ;38
   (if (/= SS2 nil) (setq TPT2 PT1) (setq TPT2 nil))        ;39
   (command "oops" "offset" (/ WLTK 2.0) OPT2 PT3 "")       ;40
   (setq EN1 (entlast))                                     ;41
   (command  "offset" "" OPT2 PT4 "")                       ;42
   (setq EN2 (entlast))                                     ;43
   (entdel EN)                                              ;44
   (if (= CI "T")                                           ;45
     (progn                                                 ;46
      (if (/= OPT2 PT1) (progn                              ;47
       (cond                                                ;48
         ((and (/= TPT1 nil) (/= TPT2 nil))                 ;49
          (command "trim" EN1 EN2 "" TPT1 TPT2 ""))         ;50
         ((/= TPT1 nil) (command "trim" EN1 EN2 "" TPT1 ""));51
         ((/= TPT2 nil) (command "trim" EN1 EN2 "" TPT2 ""));52
       )))                                                  ;53
   ))                                                       ;54
  (command "explode" EN1 "explode" EN2)                     ;55
  (V1R)                                                     ;56
  (RL)                                                      ;57
  (V4)                                                      ;58
)                                                           ;59

; ------------------------- WSTART -------------------------
(defun WSTART ()
  (V3)
  (LS "WALL" "3" "")
  (CKWALL)
  (V1 '("snapmode" "osmode" "pickbox" "orthomode"))
  (setvar "osmode" 0)
  (setvar "pickbox" 1)
  (setvar "orthomode" 1)
)

; ------------------------ CKWALL --------------------------
(defun CKWALL ()
 (if (not WLTK) (setq WLTK (getdist "\nWall Thickness : ")))
  (prompt (strcat "\nCurrent Wall Thickness <"
    (rtos WLTK (getvar "lunits") (getvar "luprec")) "> \n"))
  (princ)
)

; ------------------------- WALLTK -------------------------
(defun C:WALLTK (/ THK)
  (if (not WLTK) (setq WLTK 0.0))
  (setq THK (getreal (strcat "\nWall Thickness : <"
     (rtos WLTK (getvar "lunits") (getvar "luprec")) "> ")))
  (if (/= THK nil) (setq WLTK THK))
  (prompt (strcat "\n\nCurrent Wall Thickness <"
      (rtos WLTK (getvar "lunits") (getvar "luprec")) "> "))
  (princ)
)