;;;  Written for Donal Pearce at Jay Kim Engineers
;;;
;;;  This routine scales up or down text and blocks for plotting out at a scale
;;;  different from the existing one.
;;;  Written by: Kanwar Anand,  KETIV Technologies, Fullerton  Aug. 1989
;;; ---------------------------------------------------------------------------
;;;
;;; Define a new error function here
;;;
 (setq olderr *error*)
 (defun *error*(m)
   (if (equal m "bad argument type")
     (progn
      (princ "\nYou did not select any objects, try again. ")
      (princ)
     )
     (progn
      (prompt m)
      (princ)
     )
    )
 )
 (setq lt (getvar "ltscale"))
 (setq tev(getvar "texteval"))
 (setvar "texteval" 1)
 (setq cmd (getvar "cmdecho"))
 (setvar "cmdecho" 0)
 (setq cl (getvar "clayer"))
 (setq newlay (strcase 
          (getstring "\nLayer name for new text <ENTER for current layer>: ")))
 (if (= newlay "")
   (setq newlay cl)
 )
 (prompt "\nExisting scale <")
 (princ lt) (princ)
 (setq oldscl (getreal ">: "))
 (if (= oldscl nil)
    (setq oldscl lt)
 )
 (setq newscl (getreal "\nNew scale: "))
 (setq conv (/ newscl oldscl))
 
 (if (= (tblsearch "layer" newlay) nil)
    (command "layer" "m" newlay "")
    (command "layer" "s" newlay "")
 )
 (setq choice (strcase 
             (getstring "\nPick objects / <Selection by Layer>: ")))
 (if (= choice "")
   (setq choice "L")
 )

 (if (= choice "P")
    (progn
     (prompt "Select the text and blocks to re-size: ")
     (setq setext (ssget))
    )
    (progn 
     (prompt  "\nLayer name of original objects <")
     (princ cl) (princ)
     (setq oldlay (strcase (getstring ">: ")))
     (if (= oldlay "")
         (setq oldlay cl)
     ) 
     (setq setext (ssget "X" (list (cons 8 oldlay)  (cons 0 "TEXT"))))
     (setq setins (ssget "X" (list (cons 8 oldlay) (cons 0 "INSERT"))))
   (if setins
     (setq sinslen (sslength setins))
     (setq sinslen 0)
   )
     (setq cntins 0)
   (if setext
    (progn
     (while (< cntins sinslen)
       (setq setext (ssadd (ssname setins cntins) setext))
       (setq cntins (+ 1 cntins))
     )
    )
     (setq setext setins)
   )     
   )
 )
 
 (setq count 0 count2 0 countb 0 sundry 0)
 (setq setlen (sslength setext))
 (while (< count setlen)
   (setq ent (entget (ssname setext count)))
   (setq entold ent)
   (if (= (cdr (assoc 0 ent)) "TEXT")
     (progn
      (setq entnam (cdr (assoc -1 ent)))
      (setq mdpt (cdr (assoc 11 ent)))
      (if (and (= (cadr mdpt) 0) (= (car mdpt) 0.0))
          (setq mdpt (cdr (assoc 10 ent)))
      )
      (setq texval (cdr (assoc 1 ent)))
  (if (/= newlay cl)
    (progn
      (command "copy" entnam "" "0,0" "")
      (command "chprop" entnam "" "la" newlay "")
    )
  )
      (command "scale" entnam "" mdpt conv)
      (setq count (+ 1 count))
      (setq count2 (+ 1 count2))
     )
   )


 (if  (= (cdr (assoc 0 ent)) "INSERT")
      (progn
         (setq count (+ 1 count) countb (+ 1 countb))
         (setq entnam (cdr (assoc -1 ent)))

     (if (and   (/= newlay cl) 
                (= (cdr (assoc 0 (entget (entnext entnam)))) "ATTRIB" )
         )
          (command "copy" entnam "" "0,0" "" "chprop" entnam "" "lay" newlay "")
         
       )
      
         (setq ent (entget entnam))
        (while (and (= (cdr (assoc 0 (entget (entnext entnam)))) "ATTRIB" )
                     (/= (cdr (assoc 0 (entget entnam))) "SEQEND" )
               )
          (setq entnamn (entnext entnam))
          (setq entn (entget entnamn))
         (setq new (cons '8  newlay))
          (setq ent (subst new (assoc 8 entn) entn))
          (setq ent (entmod ent))
          (setq entnam (entupd entnam))

         (setq oldh (cdr (assoc 40 ent)))
         (setq ne (* oldh conv)) 
         (setq newh (cons '40  ne))
          (setq ent (subst newh (assoc 40 ent) ent))
          (setq ent (entmod ent))
          (setq entnam (entupd entnam))

          (setq entnam (entnext entnam))
        )
       ; (setq count (+ count 1) countb (+ countb 1))
       )   
 )
 (if  (and (/= (cdr (assoc 0 entold)) "INSERT")
           (/= (cdr (assoc 0 entold)) "TEXT"))
       (setq sundry (+ 1 sundry) count (+ 1 count))
      
 )


);   END MAIN WHILE HERE

 (setvar "texteval" tev)
 (command "layer" "s" cl "")
 (setq *error* olderr) (princ)
 (setvar "cmdecho" cmd)
 (prompt "\n")
 (princ count2) (princ)  
 (prompt " peice(s) of text and ")
 (princ countb) (princ)
 (prompt " block(s) were re-sized and put on layer ")
 (princ newlay) (princ)