;Modify X, Y, and Z scale factors.  Each is specified individually allowing unequal scaling (or alternatively setting them equal). (uses UREAL)
;
;	AUTHOR: HENRY C. FRANCIS
;		425 N. ASHE ST.
;		SOUTHERN PINES, NC 28387
;              
;		All rights reserved without prejudice.
;
;	Copyright:	3-16-95
;	Edited:		3-16-95
;
(DEFUN C:XYSCL ( / tht tset tsln cntr tent edtw)
(princ "\nEnter scale factor 0 to make current scale factors positive. ")
(setq keep_sign (ukword 1 "Yes No" "Keep current sign of scale factors? (Yes No)" (if keep_sign keep_sign "Yes")))
(setq xscl (ureal 1 "U" "\nX scale factor or Unchanged" (if xscl xscl 1)))
(setq yscl (ureal 1 "U" "\nY scale factor or Unchanged" xscl))
(setq zscl (ureal 1 "U" "\nZ scale factor or Unchanged" xscl))
(prompt "\nSelect Block: ")
(setq tset (ssget '((0 . "INSERT"))))
(if tset
  (progn
    (setq tsln (sslength tset))
    (setq cntr 0)
  )
)
(while
  (if (and (< cntr tsln) tset)
    (setq tent (entget (ssname tset cntr)))
  );if
  (progn
    (setq edtw (entget (cdar tent)))
    (if (eq(cdr(assoc 0 edtw))"INSERT")
      (progn
        (if (eq xscl "Unchanged")
          NIL
          (setq edtw
            (subst (if(= xscl 0)(cons 41(abs(cdr(assoc 41 edtw))))(cons 41 (if(and(eq keep_sign "Yes")(<(cdr(assoc 41 edtw))0))(* -1 xscl)xscl)))
                   (assoc 41 edtw)
                   edtw
            )
          )
        )
        (if (eq yscl "Unchanged")
          NIL
          (setq edtw
            (subst (if(= yscl 0)(cons 42(abs(cdr(assoc 42 edtw))))(cons 42 (if(and(eq keep_sign "Yes")(<(cdr(assoc 42 edtw))0))(* -1 yscl)yscl)))
                   (assoc 42 edtw)
                   edtw
            )
          )
        )
        (if (eq zscl "Unchanged")
          NIL
          (setq edtw
            (subst (if(= zscl 0)(cons 43(abs(cdr(assoc 43 edtw))))(cons 43 (if(and(eq keep_sign "Yes")(<(cdr(assoc 43 edtw))0))(* -1 zscl)zscl)))
                   (assoc 43 edtw)
                   edtw
            )
          )
        )
        (entmod edtw)
      )
    )
    (setq cntr (1+ cntr))
  )
)
  (princ)
);DEFUN