;;;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
;;;>		http://paracadd.com
;;;>		All rights reserved.
;;;
;;;>		COPYRIGHT: 3-16-95
;;;>		   EDITED: 07-20-2005
;;;
(DEFUN C:XYSCL (/ tht tset tsln cntr tent edtw)
  (PRINC
    "\nEnter scale factor 0 to make current scale factors positive. "
  ) ;_ end of princ
  (IF ukword
    nil
    (LOAD "ukword" "\nFile UKWORD.LSP not loaded! ")
  ) ;_ end of if
  (IF ureal
    nil
    (LOAD "ureal" "\nFile UREAL.LSP not loaded! ")
  ) ;_ end of if
  (SETQ	keep_sign (ukword 1
			  "Yes No"
			  "Keep current sign of scale factors? (Yes No)"
			  (IF keep_sign
			    keep_sign
			    "Yes"
			  ) ;_ end of if
		  ) ;_ end of ukword
  ) ;_ end of setq
  (SETQ
    xscl (ureal	1
		"Unchanged"
		"\nX scale factor or Unchanged"
		(IF (AND xscl (OR (EQ (TYPE xscl) 'REAL) (EQ (TYPE xscl) 'INT)))
		  xscl
		  1
		) ;_ end of if
	 ) ;_ end of ureal
  ) ;_ end of setq
  (SETQ
    yscl (ureal	1
		"Unchanged"
		"\nY scale factor or Unchanged"
		(IF (AND yscl (OR (EQ (TYPE yscl) 'REAL) (EQ (TYPE yscl) 'INT)))
		  yscl
		  (IF (AND xscl (EQ (TYPE xscl) 'REAL))
		    xscl
		    1
		  ) ;_ end of if
		) ;_ end of if
	 ) ;_ end of ureal
  ) ;_ end of setq
  (SETQ
    zscl (ureal	1
		"Unchanged"
		"\nZ scale factor or Unchanged"
		(IF (AND zscl (OR (EQ (TYPE zscl) 'REAL) (EQ (TYPE zscl) 'INT)))
		  zscl
		  1
		) ;_ end of if
	 ) ;_ end of ureal
  ) ;_ end of setq
  (PROMPT "\nSelect Block: ")
  (SETQ tset (SSGET '((0 . "INSERT"))))
  (IF tset
    (PROGN
      (SETQ tsln (SSLENGTH tset))
      (SETQ cntr 0)
    ) ;_ end of progn
  ) ;_ end of if
  (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
			      ) ;_ end of if
			) ;_ end of cons
		      ) ;_ end of if
		      (ASSOC 41 edtw)
		      edtw
		    ) ;_ end of subst
	     ) ;_ end of setq
	   ) ;_ end of if
	   (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
			      ) ;_ end of if
			) ;_ end of cons
		      ) ;_ end of if
		      (ASSOC 42 edtw)
		      edtw
		    ) ;_ end of subst
	     ) ;_ end of setq
	   ) ;_ end of if
	   (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
			      ) ;_ end of if
			) ;_ end of cons
		      ) ;_ end of if
		      (ASSOC 43 edtw)
		      edtw
		    ) ;_ end of subst
	     ) ;_ end of setq
	   ) ;_ end of if
	   (ENTMOD edtw)
	 ) ;_ end of progn
       ) ;_ end of if
       (SETQ cntr (1+ cntr))
     ) ;_ end of progn
  ) ;_ end of while
  (PRINC)
)					;DEFUN
;|«Visual LISP© Format Options»
(84 2 40 2 T "end of " 60 9 2 0 0 T T nil T)
;*** DO NOT add text below the comment! ***|;