Тема: LISP. Отрисовка слова с прямоугольной рамкой.
;******** TRECT.LSP **************************************************
; Программа вставки слова в рамке в произвольном месте.
; Если используются шрифты Arial.ttf и Times New Roman.ttf,
; то стили должны иметь имена "ARIAL" и "TIMES" соответственно.
; Параметры подобраны опытным путем в предположении, что
; первая буква заглавная.
; Разработал Владимир Громов 2003 г.
;
(defun C:TRECT ( / hold ht tn text lt wr hr nr kr)
(setvar "cmdecho" 0)
(princ "\n Прежняя высота текста: ")
(setq hold (getvar "TEXTSIZE"))
(princ hold)
(initget 6)
(princ (strcat "\n РАЗМЕР (высота) текста <" (rtos hold 2) ">: ")) ;
(setq ht (getreal))
(if (= ht nil) (setq ht hold))
(setq tn 0)
(while tn
(setq tn (getpoint "\n Укажите ТОЧКУ (ENTER-Хватит): "))
(if tn
(progn
(setq text (getstring T "\n Введите текст: "))
(setq lt (strlen text))
(if (or (/= (getvar "textstyle") "ARIAL") (/= (getvar "textstyle") "TIMES"))
(setq wr (* ht lt 1.02) hr (* ht 1.7))
)
(if (or (= (getvar "textstyle") "ARIAL") (= (getvar "textstyle") "TIMES"))
(setq wr (* ht lt 0.85) hr (* ht 1.7))
)
(setq nr (list (- (car tn) (/ wr 2)) (- (cadr tn) (/ hr 2))))
(setq kr (list (+ (car tn) (/ wr 2)) (+ (cadr tn) (/ hr 2))))
(command "_RECTANG" nr kr)
(command "_TEXT" "_M" tn ht "0" text)
))
)
(princ "\n Конец. ")
(princ)
)Возможный макрос для кнопки или пункта меню:
^C^C^P(if (not C:TRECT) (load "trect")) TRECT
