;;;;;;;;;;;;;;;;;;;;;;;RESCALB.LSP;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;     Purpose:  Rescales Blocks to Viewport scale or Dimscale value
;;     Author:   Herman Mayfarth, Tekton Construction Services
;;               h_mayfarth@tktn.com
;;     Version:  1.2
;;     Date:     2 May 00
;;
;;               Written for and tested with AutoCAD R14
;;
;;               Copyright (c) 1999,2000 by Herman Mayfarth
;;               Provided "as is." No warranty, express or implied.
;;               Permission granted to freely use and redistribute
;;               without fee, provided copyright notice and disclaimer
;;               of warranty remain intact. All other rights reserved.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;    Modification history:
;;    1.1 added (trans ) to (command "SCALE")
;;    function now works in UCS
;;    1.2 shut down/restore OSNAPS when calling (command "SCALE")
;;        fixed changed entity counter
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;  Usage: AutoCAD Release 14 & later, any platform
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;  Program Operation:
;;
;;  Rescales INSERT objects ("BLOCKS") about their insertion points
;;  to a "normalized" size based on the value of DIMTXT, scaled by:
;;
;;  1. Value of DIMSCALE, if in tiled model space,
;;  2. Viewport scale, if in a floating viewport,
;;  3. One, if in paper space,
;;  4. A scale factor relative to "normal" text size, for which the
;;     user is always prompted. The DIMTEXT value is considered to be
;;     the "normal" text size, and all size choices are relative to
;;     this value. Also allows the user to enter any arbitrary value
;;     (a relative value) for the rescaling factor.
;;
;;  The user is presented with a choice of pre-defined heights relative
;;  to the normal size, described by keywords, as well as the choice of
;;  typing any arbitrary scale factor. The sizes of the pre-defined heights
;;  may be changed by altering numerical values in an association list
;;  near the end of the file, which is assigned to the global variable
;;  NTEXTSCALES if it does not exist. It will not overwrite an existing
;;  value of this variable.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;  Usage Notes:
;;
;;  1. Users of NTEXT may already have the value of NTEXTSCALES initialized,
;;  if they have loaded that program in the current drawing session. If you use
;;  NTEXT, it should *always* be loaded before this program, since it
;;  unconditionally initializes the global variable NTEXTSCALES.
;;  Users of NTEXT who may wish to change the pre-defined heights must redefine
;;  those heights using that program in order for it to function properly.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
(defun C:RESCALB ( /
; local symbols
                   adj
                   epsilon
                   i
                   j
                   olderr
                   sadj
                   sf
                   ss1
; local functions
                   setscl
                   sing_pl
                   *lerror*
)

;;;--------------- Local Functions ---------------------------------
;;--------------------- setscl--------------------------------------
;;      Purpose: calculate scale factor
;;      Uses:    nothing
;;      Returns: sf
;;
;;  local variables
;;          curvpt  ;current viewport (integer - not saved by drawing)
;;-------------------------------------------------------------------
(defun setscl( / curvpt )
  (setq curvpt (getvar "CVPORT"))
  (cond ((= 1 (getvar "TILEMODE")) (setq sf (getvar "DIMSCALE")));tiled space
        ((= 1 curvpt) (setq sf 1.0));in paper space
     ;; in a viewport
        (T
          (setq sf (last (trans '(0 0 1.0) 3 2)));calc scale factor
        );end default
  );end cond
);end setscl

;;---------------------sing_pl---------------------------------------
;;      Purpose: supplies correct suffix for singular vs. plural noun
;;      Needs:   string for root of noun
;;               counter for quantity
;;      Returns: correct string for quantity referenced
(defun sing_pl(root i / )
  (if (/= i 1)
      (strcat (substr root 1 (- (strlen root) 1)) "ies")
	  (substr root 1 (strlen root))
  );if
);end sing_pl
;--------------------- lerror ---------------------------------------
;; local error handler
(defun *lerror* (msg)
  (if
    (or (= msg "Function cancelled")
        (= msg "quit / exit abort")
    )
    (princ)
    (princ (strcat "\nError: " msg))
  )
  (setq *error* olderr)
  (command "_.UNDO" "END")
  (setvar "CMDECHO" 1)
  (princ)
);*lerror*
;-----------------------------------------------------------------
(command "_.UNDO" "BEGIN")
(setvar "CMDECHO" 0)
(setq olderr *error*
      *error* *lerror*)
;; handle nonsense case of zero dimscale in tiled space
(if(and(= 0 (getvar "DIMSCALE"))(= 1 (getvar "TILEMODE")))
     (progn((alert "   Zero Dimension Scale\n   Set Tilemode = 0 or
                       Use a Non-Zero Dimension Scale")(exit))))
(setq epsilon 0.0001);used when comparing reals for equality
;;set the normal block scale
(setscl)
(setq adj nil);setup for while loop
(while (null adj)
 (initget 134 "Jumbo Medium Big Normal Small Tiny");arbitrary OK, no neg or 0
 ;;prompt for new block scale, relative to "normal" scale
 (setq adj (getkword "\nBlock Scale: Jumbo Big Medium <Normal> Small Tiny (or X Normal):"))
 (if (null adj) (setq adj "Normal")) ;user pressed "return"
;;trap arbitrary non-numerical input
 (if (and (not (member adj '("Jumbo" "Big" "Medium" "Normal" "Small" "Tiny")))
          (= (atof adj) 0.0)
     )
  (progn
    (princ "\nInvalid Input. Use Defined Keyword or Valid Numerical Scale Factor.")
    (setq adj nil)
  );progn
 );if
);while
(cond ((equal adj "Jumbo")  (setq sadj (cdr(assoc 'Jumbo NTEXTSCALES))))
      ((equal adj "Big")    (setq sadj (cdr(assoc 'Big NTEXTSCALES))))
      ((equal adj "Medium") (setq sadj (cdr(assoc 'Medium NTEXTSCALES))))
      ((equal adj "Normal") (setq sadj (cdr(assoc 'Normal NTEXTSCALES))))
      ((equal adj "Small")  (setq sadj (cdr(assoc 'Small NTEXTSCALES))))
      ((equal adj "Tiny")   (setq sadj (cdr(assoc 'Tiny NTEXTSCALES))))
      ( T (setq sadj (atof adj)))
);cond
;;adjust block scale to "normalized" value
(setq sf (* sf sadj))
;;get a selection set of INSERTs
        (princ "\nSelect Blocks to Rescale:   ")
         (while (null ss1)
          (setq ss1 (ssget  '((0 . "INSERT"))))
         )
;;process INSERTs
;;shut down OSNAPs before entering loop, & restore after loop ends
        (setvar "OSMODE" (logior (getvar "OSMODE") 16384))
        (setq i 0 j 0 )
        (repeat (sslength ss1)
          (setq ent (ssname ss1 i)
                curscl (cdr(assoc 41 (entget ent)));use x scale - no check for unequal scales
          )
          (command "_.SCALE" ent "" (trans(cdr(assoc 10 (entget ent)))0 1) (/ sf curscl))
          (setq i (1+ i));increment entity count
          (if (> (abs(- curscl sf)) epsilon);compare reals!
              (setq j (1+ j)));increment changed entity count
        );repeat
        (setvar "OSMODE" (logand (getvar "OSMODE") 16383))
;;report # entities processed, # changed, & selected scale
    (princ (strcat "\n" (itoa i) " " (sing_pl "Entity" i) " Processed, " (itoa j)
     " " (sing_pl "Entity" j) " Changed. Selected Scale is " (rtos sf 2 2)))
(setq *error* olderr)
(command "_.UNDO" "END")
(setvar "CMDECHO" 1)
        (princ)
);end rescalb

;;initialize NTEXTSCALES (global)
;;if it does not exist

(if (not NTEXTSCALES)
      (setq NTEXTSCALES (list '(JUMBO .  2.0  ) ;may change if you wish
                              '(BIG .    1.5  ) ;refer to Usage Notes
                              '(MEDIUM . 1.25 ) ;for co-operation with NTEXT
                              '(NORMAL . 1.0  )
                              '(SMALL .  0.75 )
                              '(TINY .   0.5  )
                        );list
      );setq
);if
;;load prompt
(princ "\nRESCALB V1.2 (c) 2000 by Herman Mayfarth...")
(princ)