;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;幕匠LISP实验室;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;程序功能：修改文字的高宽比  [备注：修改文字的高宽比]
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun *error*(st)
  (princ (strcat "Error: " st))
  (princ)
)

(DEFUN C:MJ146 ();/ test ss len n en1 a oldr newr ent oldf nn)
  (setvar "CMDECHO" 0)
  (setq test T nn 0)
  (while test
    (setq ss (ssadd))
    (setq ss (ssget))
    (if (= nil ss)
      (setq test nil)
      (progn
	(setq len (sslength ss))
	(setq n 1 s 1)
	(while (<= n len)
	  (setq en1 (ssname ss (1- n)))
	  (setq a (entget en1))
	  (if  (= "TEXT" (cdr (assoc 0 a)))
	    (progn
	      (if (= s 1)
		(progn
		  (setq oldr (cdr (assoc 41 a)))
                  (setq newr (getreal (strcat "\nNew width:high <" (rtos oldr 2 2) ">:")))
		  (if (= newr nil) (setq newr oldr))
		  (setq s nil)
		)
	      )
	      (setq ent (subst (cons 41 newr) (assoc 41 a) a))
              (setq ent (subst (cons 72 0) (assoc 72 ent) ent))
	      (entmod ent)
              (setq nn (1+ nn))
	    )
	  )
	  (setq n (1+ n))
	)
      )
    )
  )
  (princ (strcat (itoa nn) " changed !"))
  (princ)
)
