;;;Place engineering or architectural bar scales by dimscale.
;;;
;;;	Uses blocks named nBARS where n=dimscale as integer.
;;;	for Decimal (Engineering) linear units.
;;;
;;;	Creates the U.S. Army Corps of Engineers standard
;;;	bar scale for Architectural units based upon dimscale.
;;;
;;;>	Author:	Henry C. Francis
;;;>		425 N. Ashe St.
;;;>		Southern Pines, NC 28387
;;;>		http://paracadd.com
;;;>		All rights reserved.
;;;
;;;>		COPYRIGHT: 2-4-92
;;;>		   EDITED: 10-06-2005
;;;
(DEFUN C:BSCL ( / DIV4 DIV3 DIV2 DIV1 OFLTX PTRTX PTLTX PT1 SCLTX SCPTX TXDV4 TXDV3 TXDV2 TXOFL TXDV1 TXTR TXTL)
(setq old_osmode (getvar "osmode"))
(setvar "osmode" 0)
(setq untwist (*(/(- 0(getvar"viewtwist"))pi)180))
(setq txht  (GETVAR "textsize"))
(if c:mklayr nil (load "mklayr" "\nFile MKLAYR.LSP not loaded! "))
(c:svlayr)
(if(=(getvar"lunits")2)
  (progn
    (if dimscl nil (load "dimscl" "\nFile DIMSCL.LSP not found! "))
    (dimscl)
    (setq modf "SYMB"
          bars (rtos(float dimsc)2 0)
          bname (strcat bars "BARS")
          ofset (list 0 0 (* 1001 dimsc ))
    );setq
    (c:mklayr)
    (graphscr)
    (command ".insert" bname pause "" "" untwist ".move" "l" "" ofset "")
  );progn
(progn
(if txtsize nil (load "txtsize" "\nFile TXTSIZE.LSP not found! "))
(txtsize nil)
(SETVAR "TEXTSIZE" txtht)
(SETQ colr txcolr
      ltyp txltyp
)
(if mjrg nil (setq mjrg "G"))
(setq prod "BSCL")
(setq modf "NOTE")
(if (and(equal 0 (rem dimsc 4)0.0001)(= 4 (getvar"lunits"))mjrg prod)
(progn
  (c:mklayr)
  (setq oaln (* 3 dimsc))
  (setq ofln 12.00)
  (if (equal 0(rem(/ dimsc 8.0)1)0.00001)
    (setq div1 (/ oaln 2))
    (if (equal dimsc 12 0.00001)
      (setq div1 (/(* oaln 2)3))
    );if
  );if
  (cond
    ((>= dimsc 64)
      (setq div2 (/(* 3 div1)4))
      (setq div3 (/ div1 2))
      (setq div4 (/ div1 4)))
    ((equal dimsc 48 0.00001)
      (setq div2 (/(* 2 div1)3))
      (setq div3 (/ div2 2))
      (setq div4 nil))
    ((equal dimsc 32 0.00001)
      (setq div2 (/ div1 2))
      (setq div3 nil)
      (setq div4 nil))
    ((equal dimsc 24 0.00001)
      (setq div2 (/(* div1 2)3))
      (setq div3 nil)
      (setq div4 nil))
    ((>= dimsc 4)
      (setq div2 nil)
      (setq div3 nil)
      (setq div4 nil))
  );cond
  (setq pt1 (upoint 0 "" "Insertion point for barscale? " nil nil)
        pt1 (list(car pt1)(cadr pt1)(* dimsc 1001)))
  (setq scptx (polar pt1 (* pi 1.5)(+(/ dimsc 8.0)(* txtht 1.625)));(* 0.3125 dimsc))
        pttl (polar pt1 pi (/ oaln 2))
        ptls (polar pttl (* pi 1.5)(* txtht 0.625));(/ dimsc 16.0))
        ptltx (polar pttl (/ pi 2)(* txtht 0.625));(/ dimsc 16.0))
        txtl "0"
        pttr (polar pttl 0 oaln)
        ptls (polar pttr (* pi 1.5)(* txtht 0.625));(/ dimsc 16.0))
        ptrtx (polar pttr (/ pi 2)(* txtht 0.625));(/ dimsc 16.0))
        txtr (strcat (rtos (/ oaln 12) 2 0) "FT")
        ptbl (polar pttl (* pi 1.5)(/ dimsc 8.0))
        ptbr (polar ptbl 0 oaln)
        oflt (polar pttl 0 ofln)
        ofls (polar oflt (* pi 1.5)(* txtht 0.625));(/ dimsc 16.0))
        oflb (polar ptbl 0 ofln)  
        ofltx (if(<= dimsc 32)(polar oflt (/ pi 2)(* txtht 0.625)));(/ dimsc 16.0)))
        txofl (if(<= dimsc 32)"1" "")
  );setq
  (if (> dimsc 4)
    (setq dv1t (polar pttl 0 div1)
          dv1s (polar dv1t (* pi 1.5)(* txtht 0.625));(/ dimsc 16.0))
          dv1b (polar ptbl 0 div1)
          dv1tx (polar dv1t (/ pi 2)(* txtht 0.625));(/ dimsc 16.0))
          txdv1 (rtos (/ div1 12) 2 0)
    );setq
  );if
  (command ".pline" pttl pttr ptbr ptbl "c")
  (command ".line" dv1t dv1b "")
  (if (> dimsc 4)
    (progn
      (command ".text" "c" ptrtx txtht 0 txtr)
      (command ".text" "c" dv1tx txtht 0 txdv1)
    );progn
    (setq txofl "1FT")
  );if
  (if div2
    (progn
      (setq
        dv2t (polar pttl 0 div2)
        dv2s (polar dv2t (* pi 1.5)(* txtht 0.625));(/ dimsc 16.0))
        dv2b (polar ptbl 0 div2)
        dv2tx (polar dv2t (/ pi 2)(* txtht 0.625));(/ dimsc 16.0))
        txdv2 (rtos (/ div2 12) 2 0)
      );setq
      (command ".line" dv2t dv2b "")
      (command ".text" "c" dv2tx txtht 0 txdv2)
    );progn
  );if
  (if div3
    (progn
      (setq
        dv3t (polar pttl 0 div3)
        dv3s (polar dv3t (* pi 1.5)(* txtht 0.625));(/ dimsc 16.0))
        dv3b (polar ptbl 0 div3)
        dv3tx (polar dv3t (/ pi 2)(* txtht 0.625));(/ dimsc 16.0))
        txdv3 (rtos (/ div3 12) 2 0)
      );setq
      (command ".line" dv3t dv3b "")
      (command ".text" "c" dv3tx txtht 0 txdv3)
    );progn
  );if
  (if div4
    (progn
      (setq
        dv4t (polar pttl 0 div4)
        dv4s (polar dv4t (* pi 1.5)(* txtht 0.625));(/ dimsc 16.0))
        dv4b (polar ptbl 0 div4)
        dv4tx (polar dv4t (/ pi 2)(* txtht 0.625));(/ dimsc 16.0))
        txdv4 (rtos (/ div4 12) 2 0)
      );setq
      (command ".line" dv4t dv4b "")
      (command ".text" "c" dv4tx txtht 0 txdv4)
    );progn
  );if
  (setq scltx (strcat "SCALE: " (rtos (/ 12.00 dimsc) 4 8) " = 1'-0\""))
  (if (<= dimsc 32)
    (command ".text" "c" ofltx txtht 0 txofl)
  );if
  (if (> dimsc 4)
    (command ".line" oflt oflb "")
  );if
  (command ".text" "c" ptltx txtht 0 txtl)
  (command ".text" "c" scptx txtht 0 scltx)
  (if (> 96 dimsc)
  (progn
    (setq
      t1b (polar ptbl 0 (/ ofln 2))                   ;1/2 tick,
      t1t (polar t1b (/ pi 2)(/(* 3 dimsc)32))        ;@3/32" high.
      t1tx (polar t1b (/ pi 2)(/(* 3 dimsc)16))       ;6" text point.
    );setq
    (command ".line" t1b t1t "")
  );progn
  );if
  (if (> 64 dimsc)
  (progn
    (setq
      t2lb (polar ptbl 0 (/ ofln 4))                  ;1/4 tick,
      t2lt (polar t2lb (/ pi 2)(/(* 5 dimsc)64))      ;@5/64" high.
      t2ltx (polar t2lb (/ pi 2)(/(* 3 dimsc)16))     ;3" text point.
      t2rb (polar ptbl 0 (/(* 3 ofln)4))              ;3/4 tick,
      t2rt (polar t2rb (/ pi 2)(/(* 5 dimsc)64))      ;@5/64" high.
      t2rtx (polar t2rb (/ pi 2)(/(* 3 dimsc)16))     ;9" text point.
    );setq
    (command ".line" t2lb t2lt "")
    (command ".line" t2rb t2rt "")
  );progn
  );if
  (if (> 24 dimsc)
  (progn
    (setq
      t3lb (polar ptbl 0 (/ ofln 12))                ;1/12 tick,
      t3lt (polar t3lb (/ pi 2)(/ dimsc 16.0))         ;@1/16" high.
      t3rb (polar ptbl 0 (/ ofln 6))                 ;1/6 tick,
      t3rt (polar t3rb (/ pi 2)(/ dimsc 16.0))         ;@1/16" high.
    );setq
    (setq colr "1")
    (c:mklayr)
    (command ".line" t3lb t3lt "")
    (setq sst3 (ssadd (entlast)))
    (command ".line" t3rb t3rt "")
    (setq sst3 (ssadd (entlast) sst3))
    (command ".array" sst3 "" "r" 1 4 (/ ofln 4))
    (setq colr "6")
    (c:mklayr)
    (command ".text" "c" t1tx txtht 0 "6\"")
  );progn
  );if
  (if (> 12 dimsc)
  (progn
    (setq
      t4lb (polar ptbl 0 (/ ofln 24.000))                   ;1/24 tick,
      t4lt (polar t4lb (/ pi 2)(/(* 3 dimsc)64))            ;@3/64" high.
      t4cb (polar ptbl 0 (/ ofln 8.000))                    ;1/8 tick,
      t4ct (polar t4cb (/ pi 2)(/(* 3 dimsc)64))            ;@3/64" high.
      t4rb (polar ptbl 0 (/(* 5.00 ofln)24.000))            ;5/24 tick,
      t4rt (polar t4rb (/ pi 2)(/(* 3 dimsc)64))            ;@3/64" high.
    );setq
    (setq colr "1")
    (c:mklayr)
    (command ".line" t4lb t4lt "")
    (setq sst4 (ssadd (entlast)))
    (command ".line" t4cb t4ct "")
    (setq sst4 (ssadd (entlast) sst4))
    (command ".line" t4rb t4rt "")
    (setq sst4 (ssadd (entlast) sst4))
    (command ".array" sst4 "" "r" 1 4 (/ ofln 4))
    (setq colr "6")
    (c:mklayr)
    (command ".text" "c" t2ltx txtht 0 "3\"")
    (command ".text" "c" t2rtx txtht 0 "9\"")
  );progn
  );if
  (if (> 8 dimsc)
  (progn
    (setq
      t5lb (polar ptbl 0 (/ ofln 48.000))                ;1/48 tick,
      t5lt (polar t5lb (/ pi 2)(/ dimsc 32.0))             ;@1/32" high.
      t5rb (polar ptbl 0 (/ ofln 16.000))                ;1/16 tick,
      t5rt (polar t5rb (/ pi 2)(/ dimsc 32.0))             ;@1/32" high.
    );setq
    (setq colr "1")
    (c:mklayr)
    (command ".line" t5lb t5lt "")
    (setq sst5 (ssadd (entlast)))
    (command ".line" t5rb t5rt "")
    (setq sst5 (ssadd (entlast) sst5))
    (command ".array" sst5 "" "r" 1 12 (/ ofln 12))
  );progn
  );if
;  (setq sst3 (ssadd))
;  (setq sst4 (ssadd))
;  (setq sst5 (ssadd))
;  (command ".solid" pttr dv1t ptls dv1s "")
);progn
;       put civil scales here
(progn
  (if (not(equal 0 (rem dimsc 4) 0.0001))
    (progn
      (prompt (STRCAT "Scale is " (RTOS DIMSC 2 8) ", not Architectural.  "))
      (PROMPT (strcat "\nDIMSCALE = " (RTOS (GETVAR "DIMSCALE") 2 2)))
    )
  );if
  (if (/= 4 (getvar"lunits"))
    (prompt "Units are not Architectural.  ")
  );if
  (if (not (and mjrg llt prod (or colr colra)))
    (prompt "CLG Layer Name not set.  ")
  );if
);progn
);if
);progn
);if
(SETVAR "textsize" txht)
(setvar "osmode" old_osmode)
(princ)
);DEFUN