Lisp.Изменение высоты и ширины MTEXTA (BoundMText)

[aerohost]

 Lisp.Изменение высоты и ширины MTEXTA (BoundMText)

Описание- Lisp позволяет изменить ширину и высоту полей MTEXTA под фактический размер самого текста, удобно для тех, кто использует функцию "Скрытие заднего фона"

 

Lisp умеет так же делать рамку вокруг MTEXTA , и делать заливку MTEXTA. Фон цвета может принимать, как различные цвет (ввод значения "1", по умолчанию применяется заливка фона белого цвета (255)), так по цвету чертежа( ввод значения "Да")

 

Спойлер

Адаптация Lisp под Nanocad 

 

Отдельное спасибо EdwardSt

 

BoundMText.lsp

[aerohost]

Подделал, для мультивыноски заливку, Можно в скопе выбрать группу объектов, лисп сам определить где выноска, где Мтекст  

BoundMText.lsp

Edited May 15 by aerohost

[kpblc]

Спойлер

 

Я бы на серьезных щщах задумался о том, чтобы запросы "Да/Нет" вытащить в отдельную функцию и использовал бы уже ее. Нечто типа:

(defun _kpblc-get-yesno (message default / res)
                        ;|
*    Запрашивает Да/Нет.
*    Параметры вызова:
  message  ; выводимое сообщение
  default  ; t - принять "по умолчанию" = "Да"; nil - "Нет"
*    Возвращает 1, если был выбран "Да", 0, если был выбран "Нет", и nil если был выполнен отказ
*    Примеры вызова:
(_kpblc-get-yesno "Проверка" t)
(_kpblc-get-yesno "Проверка" nil)
|;
  (if (not (vl-catch-all-error-p
             (vl-catch-all-apply (function (lambda (/)
                                             (initget "Да Нет Yes No _ Y N Y N")
                                             (setq res (getkword (strcat "\n"
                                                                         message
                                                                         " [Да/Нет] <"
                                                                         (if default
                                                                           "Да"
                                                                           "Нет"
                                                                         ) ;_ end of if
                                                                         "> : "
                                                                 ) ;_ end of strcat
                                                       ) ;_ end of getkword
                                             ) ;_ end of setq
                                             (setq res (if (not res)
                                                         default
                                                         (= res "Y")
                                                       ) ;_ end of if
                                             ) ;_ end of setq
                                           ) ;_ end of lambda
                                 ) ;_ end of function
             ) ;_ end of vl-catch-all-apply
           ) ;_ end of vl-catch-all-error-p
      ) ;_ end of not
    (if res
      1
      0
    ) ;_ end of if
  ) ;_ end of if
) ;_ end of defun

И тогда код основной команды становится немного более читабельным:

 (initget "Да Нет  0 1 2 3")
 (setq backgroundfill(getkword  "\n Заливка фон MTEXTa (Да,Нет) <Да>"))
 
(cond 
	((or (= backgroundfill nil) (= backgroundfill "Да") (= backgroundfill 3) )
	(setq backgroundfill 3)
	)
	
	((or (= backgroundfill 0) (= backgroundfill "Нет") (= backgroundfill "0"))
	(setq backgroundfill 0)
	)
	
	(T 
	(setq  backgroundfill  (atoi backgroundfill))
	)
)   

(cond 
 		((or(= backgroundfill 3)  (= backgroundfill 1)) 
		
			(initget "Да Нет 0 1")
			(setq contour(getkword  "\n Контур MTEXTa (Да,Нет) <Нет>"))
			
			(cond 
				((or (= contour nil) (= contour "Нет") (= contour "0") )
				(setq contour 0)
				)
				
				((or (= contour "1") (= contour "Да"))
				(setq contour 16)
				)
			)
									
			(setq fill (getreal "\n Масштаб заливки фона <1.1>:"))
			(if (= fill nil) (setq fill 1.1) (setq  fill fill))	
			
			)
		
		
				
		(T (princ "\n Без Заливки MTEXTa \n ")
			(setq  fill 0)
			(setq contour 0)
		)
		
)

(initget "Да Нет  0 1")
 (setq centr (getkword  "\n Центрировать текст (Да,Нет) <Да>"))

(cond 
((or (= centr nil) (= centr "Да") (= centr 1) )
	(setq centr 5)
	)
)

(initget "Да Нет  0 1 3")
 (setq VPU (getkword  "\n Заменить на ВПУ?(Да,Нет) <Нет>"))

(cond 
	((or (= VPU nil) (= VPU "Нет") (= VPU 0 ) )
	(setq VPU 0)
	
	)

	((or (= VPU 1) (= VPU "1"))
	(setq VPU 1)
	
	)

	((or (= VPU 3) (= VPU "3") )
	(setq VPU 3)
	
	)
)

заменится на

  (setq backgroundfill (_kpblc-get-yesno "Заливка фона MTEXT" t)
        centr (_kpblc-get-yesno "Центрировать тексты" t)
        vpu  (_kpblc-get-yesno "Заменить на ВПУ" nil)
  )

А потом уже преобразовывать ответы. А по-хорошему, наверное, стоило бы вообще делать примерно так:

  (if (and (setq backgroundfill (_kpblc-get-yesno "Заливка фона MTEXT" t))
           (setq centr (_kpblc-get-yesno "Центрировать тексты" t))
           (setq vpu  (_kpblc-get-yesno "Заменить на ВПУ" nil)))
    (progn
	;; И здесь основная логика
	)
	(princ "\nОтказ выполнения")
  )