Реклама i
Стань нашим партнером - зарабатывай с нами!
| Правила | Регистрация | Пользователи | Сообщения за день |  Справка по форуму | Файлообменник |

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Установить фиксированную высоту текста

Установить фиксированную высоту текста

Ответ
Поиск в этой теме
Непрочитано 21.01.2023, 09:51 #1
Установить фиксированную высоту текста
Konstr_pgs
 
Регистрация: 04.12.2022
Сообщений: 33

Лисп считает сумму текстов и выводит в чертеж значение суммы, перед этим запрашивает высоту (getreal "\nВведите высоту текста <250> : ")
Подскажите, плз, как установить фиксированную высоту текста (без запроса высоты).
Т.е. значение должно выводиться по умолчанию высотой 250.
Если просто удалить эту строку (getreal "\nВведите высоту текста <250> : "), выскакивает ошибка, значит надо что-то ещё подправить?
Код:
[Выделить все]
 ;|============= Команда SumT3 ================================== 
  Назначение:  Суммирование Тектса,Мтекста, Размеров указанием или рамкой.
               Угловые размеры игнорируются
  Особенности: Безразлична к разделителям точка или запятая. 
               Ввиду особенности работы atof стоки вида "22.3мама" 
               будут учтены как число 22.3
 
               При выводе результата число округляется в соответствии 
               с текущими установками переменной LUPREC. Команда _UNITS 
|;
(defun c:sumT3 (/ res res1 selset ins_pt txt_height blk obj ed *error*)
  (defun *error* (msg)
    (setvar "NOMUTT" 0) ;_ Восстанавливаем NOMUTT
    (princ msg)
  )
  (vl-load-com)
  (setq	res 0.
	res1 ""
  )
  (princ "\nВыберите тексты или размеры: ")
  (setvar "NOMUTT" 1) ;_ Отключаем NOMUTT
  (setq selset (ssget '((0 . "TEXT,MTEXT,*DIMENSION"))))
  (setvar "NOMUTT" 0) ;_ Восстанавливаем NOMUTT
  (if selset
    (foreach ent
	     (sort-list
	       (vl-remove-if 'listp (mapcar 'cadr (ssnamex selset)))
	     )
      (setq obj	(vlax-ename->vla-object ent)
	    ed	(entget ent)
      )
      (if (and (wcmatch (cdr (assoc 0 ed)) "*DIMENSION")
	       (or
		 (member '(100 . "AcDbAlignedDimension") ed) ;_Параллельный или линейный
		 (member '(100 . "AcDbDiametricDimension") ed) ;_Диаметр
		 (member '(100 . "AcDbRadialDimension") ed) ;_Радиус
		 (member '(100 . "AcDbArcDimension") ed) ;_Дуговой
	       )
	  )
	(progn
	  (setq	blk
		 (vla-item (vla-get-blocks
			     (vla-get-activedocument (vlax-get-acad-object))
			   ) ;_ end of vla-get-Blocks
			   (cdr (assoc 2 ed))
		 ) ;_ end of vla-item
	  ) ;_ end of setq
	  (vlax-for item blk
	    (if	(= (vla-get-objectname item) "AcDbMText")
	      (setq obj item)
	    )
	  )
	)
      )
      (if (vlax-property-available-p obj 'Textstring)
	(progn
	  (setq	str  (str-str-lst (vla-get-textstring obj) "\\P")
		str  (mapcar '(lambda (x) (mip_mtext_unformat x)) str)
		str  (mapcar '(lambda (x)
				(vl-string-translate
				  ","
				  "."
				  (vl-string-trim "%UuoOcC \t" x)
				)
			      )
			     str
		     )
		str  (mapcar '(lambda (x) (vl-string-trim "%UuoOcC \t" x))
			     str
		     )
		res1 (if (zerop res)
		       (car str)
		       (strcat res1 "+" (car str))
		     )
		res  (+ res (apply '+ (mapcar 'atof str)))
	  )
	)
      )
    ) ;_ end of foreach 
  ) ;_ end of if
  (setq res1 (strcat res1 "=" (rtos res 2)))
  (princ "\nРезультат=")
  (princ res1)
  (if (not (equal res 0. 1e-3))
    (progn
      (if (= (cdr (assoc 40 (tblsearch "STYLE" (getvar "TEXTSTYLE"))))
	     0.0
	  ) ;_ end of =
	(progn ;; нулевая высота текста
	       (if (not	(setq txt_height
			       (getreal "\nВведите высоту текста <250> : ")
			)
		   )
		 (setq txt_height 250)
	       )
	       (vl-cmdf "_.TEXT" "0,0" txt_height 0 res1)
	) ;_ end of progn
	(progn ;; фиксированнная высота
	       (vl-cmdf "_.TEXT" "0,0" 0 txt res1)
	) ;_ end of progn
      )
      (command "_.copybase"
	       "0,0"
	       (entlast)
	       ""
	       "_.erase"
	       (entlast)
	       ""
	       "_.pasteclip"
	       pause
      )
    ) ;_ end of progn 
  ) ;_ end of if 
  (princ)
)
(princ "\nНаберите в командной строке SumT")
(defun mip_MTEXT_Unformat (Mtext / text Str)
  (setq Text "")
  (while (/= Mtext "")
    (cond
      ((wcmatch (strcase (setq Str (substr Mtext 1 2))) "\\[\\{}]")
       (setq Mtext (substr Mtext 3)
	     Text  (strcat Text Str)
       )
      )
      ((wcmatch (substr Mtext 1 1) "[{}]")
       (setq Mtext (substr Mtext 2))
      )
      ((wcmatch (strcase (setq Str (substr Mtext 1 2))) "\\[LO`~]")
       (setq Mtext (substr Mtext 3))
      )
      ((wcmatch (strcase (substr Mtext 1 2)) "\\[ACFHQTW]")
       (setq Mtext (substr Mtext (+ 2 (vl-string-search ";" Mtext))))
      )
      ((wcmatch (strcase (substr Mtext 1 2)) "\\P")
       (if (or (= " " (substr Text (strlen Text)))
	       (= " " (substr Mtext 3 1))
	   )
	 (setq Mtext (substr Mtext 3))
	 (setq Mtext (substr Mtext 3)
	       Text  (strcat Text " ")
	 )
       )
      )
      ((wcmatch (strcase (substr Mtext 1 2)) "\\S")
       (setq Str   (substr Mtext 3 (- (vl-string-search ";" Mtext) 2))
	     Text  (strcat Text (vl-string-translate "#^\\" "/^\\" Str))
	     Mtext (substr Mtext (+ 4 (strlen Str)))
       )
      )
      (t
       (setq Text  (strcat Text (substr Mtext 1 1))
	     Mtext (substr Mtext 2)
       )
      )
    )
  )
  Text
)
 ;|
* Ф-ция str-str-lst
* Сервисная ф-ция извлечения из строки данных, разделенных
* каким либо символом или строкой символов
* Возвращает список строк
* Аргументы [Type]:
  str - строка для разбора [STRING]
  pat - разделитель [STRING]
*  Пример запуска
  (setq str "мы;изучаем;рекурсии" pat ";")
  (setq str "мы — изучаем — рекурсии" pat " — ")
  (str-str-lst str pat)
* Читать подробнее http://www.autocad.ru/cgi-bin/f1/board.cgi?t=25113OT
|;
(defun str-str-lst (str pat / i)
  (cond	((= str "") nil)
	((setq i (vl-string-search pat str))
	 (cons (substr str 1 i)
	       (str-str-lst (substr str (+ (strlen pat) 1 i)) pat)
	 ) ;_  cons
	)
	(t (list str))
  ) ;_  cond
) ;_  defun

(defun sort-list (lst)
  (vl-sort lst 'comp-fun)
)
(defun comp-fun	(A1 A2)
  (> (caddr (assoc 10 (entget A1)))
     (caddr (assoc 10 (entget A2)))
  )
)
Просмотров: 810
 
Непрочитано 21.01.2023, 10:19
#2
Сергей812


 
Регистрация: 10.08.2013
Сообщений: 11,040


программе без разницы - вернет ли значение запрос пользователя (getreal "\nВведите высоту текста <250> : ") либо просто будет число 250 стоять. По нормальному, конечно, вокруг надо проверки подчистить - пользователь ошибочное уже не может ввести)
Сергей812 вне форума  
 
Непрочитано 21.01.2023, 10:39
#3
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,842


Убери строки 90-93 и 95, должно хватить.
Offtop: Если высота текущего текстового стиля не будет равна 0, результат может быть очень забавным. Последствия командного создания текста.
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Автор темы   Непрочитано 21.01.2023, 11:01
#4
Konstr_pgs


 
Регистрация: 04.12.2022
Сообщений: 33


Цитата:
Сообщение от Кулик Алексей aka kpblc Посмотреть сообщение
Убери строки 90-93 и 95, должно хватить.
Алекс, спасибо, щаз займусь...
Да, хватило, уже не запрашивает высоту, а то поднадоело. Спасибо!

Последний раз редактировалось Konstr_pgs, 21.01.2023 в 11:08.
Konstr_pgs вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Установить фиксированную высоту текста

Размещение рекламы


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Как увеличить высоту текста, не меня при этом его ширину jimapwnz AutoCAD 5 28.09.2015 09:56
Высота многострочного текста не соответствует его высоте, заданной в "свойствах" granit201z AutoCAD 3 23.05.2015 20:39
Как в "основной надписи спдс" сделать одинаковый шрифт и высоту текста? Омская птица ПО от CSoft 1 02.04.2015 14:55
Поворот текста в пространстве katm___ Программирование 38 20.03.2013 22:22
Глюк редактирования текста в 2012 AutoCAD 2san AutoCAD 10 30.01.2012 14:56