;;;---------------------------------------------------------------------------; ;;; FILENAME: CHTS.lsp ;;; ;;; Copyright (C) February 2000 by John Atkinson ;;; ;;; ;;; THIS SOFTWARE IS PROVIDED "AS IS" WITHOUT EXPRESS OR IMPLIED WARRANTY. ;;; ALL IMPLIED WARRANTIES OF FITNESS FOR ANY PARTICULAR PURPOSE AND OF ;;; MERCHANTABILITY ARE HEREBY DISCLAIMED. ;;; ;;; By: John Atkinson - Senior CAD Technician ;;; ;;; Date: 01/10/99 ;;; ;;;---------------------------------------------------------------------------; ;;; MODIFICATION HISTORY ;;; V1.0 ;;; ;;;---------------------------------------------------------------------------; ;;; DESCRIPTION ;;; Routine will ask user to select required text to change height of. ;;; It will then ask for the first line of text to be amended and change the ;;; height and spacing of selected text. ;;; ;;; This toutine will only work for rows of text in the same column, not for ;;; text located all over the drawing. ;;;---------------------------------------------------------------------------; (defun check1 (/) (if (= lt1 nil)(alert "\nNothing selected!")) (setq lt1 (entsel "\nSelect first line of text to change..")) (princ) ) (defun check (/) (setq lt1 (entsel "\nSelect first line of text to change..")) (while (= lt1 nil)(check1) ) (setq lte5 (car lt1)) (setq lte6 (entget lte5)) (setq test (assoc 0 lte6)) (setq test1 (cdr test)) (if (/= test1 "TEXT")(alert "Text entity not selected!")) (princ) ) (defun c:chts (/ ss1 sn1 lt1 lte1 lte2 lte3 lte4 lte5 lte6 lte7 lte8 xp1 xp2 yp1 yp2 th1 th2 th3 th4 scp1 sc1 test1) (setq test1 nil) (setq lt1 nil) (princ "\nText entities must follow each other!") (prompt "\nSelect text entities to change...") (setq ss1 (ssget (list (cons 0 "text")))) (setq sn1 (sslength ss1)) (while (/= test1 "TEXT")(check) ) ; (setq lt1 (entsel "\nSelect first line of text to change..")) ; (setq lte5 (car lt1)) ; (setq lte6 (entget lte5)) ; (setq test (assoc 0 lte6)) ; (setq test1 (cdr test)) ; (if (/= test1 "TEXT")(alert "Text entity not selected!")) (setq lte7 (assoc 10 lte6)) (setq th1 (assoc 40 lte6)) (setq th3 (cdr th1)) (setq lte8 (cdr lte7)) (setq xp2 (car lte8) yp2 (cadr lte8)) (setq scp1 (list xp2 yp2)) (setq count 0) (setq th4 2.5) (repeat sn1 (setq tx1 (ssname ss1 count)) (setq lte2 (entget tx1)) (setq th2 (assoc 40 lte2)) (setq th4 (cdr th2)) (if (/= th3 th4)((alert "Program Terminating \n \nText heights differ!")(exit))) (setq count (1+ count)) ) (setq nht (getreal "\nEnter required text height for text: ")) (setq sc1 (/ nht th3)) (command "scale" ss1 "" scp1 sc1) (princ) )