Lisp_добавление текстовой строки под линию размера

Konstr_pgs · 10.01.2023, 12:25

Привет, всем!
Чтобы добавить текстовую строку под линию размера в AutoCad (2015 rus), то нужно в таблице свойств для текста в ячейке "Текстовая строка" вставить <>\Xтекст , но это немного долго.
Вот несколько программ и подпрограмм, которые добавляют текст в размер.
Вызовы команд не работают. И есть ли среди них программа добавления текстовой строки под линию размера, не могу определить, т.к. нигде нет <>\X. В общем, только это нужно.

Код:

[Выделить все]

 (defun C:DIMRW () (DIMADD "R/W WIDTH" "R/W" "") (princ) ) 
;DIMPAV = add PAVEMENT text to dimension 
(defun C:DIMPAV () (DIMADD "PAVEMENT" "PAVEMENT" "") (princ) ) 
;DIMFOC = add FOC TO FOC text to dimension 
(defun C:DIMFOC () (DIMADD "FOC TO FOC" "FOC\\PTO FOC" "\\P") (princ) ) 
;DIMFOC1 = add FOC TO FOC text to dimension 
(defun C:DIMFOC1 () (DIMADD "FOC TO FOC" "FOC TO FOC" "") (princ) ) ;DIMBS = add BUILDING SETBACK text to dimension 
(defun C:DIMBS () (DIMADD "BUILDING SETBACK" "BUILDING\\PSETBACK" "") (princ) ) 
;DIMDUE = add DRAINAGE & UTILITY EASEMENT text to dimension 
(defun C:DIMDUE () (DIMADD "DRAINAGE & UTILITY EASEMENT" "DRAINAGE &\\PUTILITY EASEMENT" "") (princ) ) 
;DIMADD = subroutine to add text to dimension ;DT1 is the text that tells the user what they are adding to the dimension ;DT2 is prefix for selected dimension 
;DT3 is suffix for selected dimension 
(defun DIMADD (DT1 DT2 DT3 / ES EG TT NT) (setq ES (entsel (strcat "\nSelect Dimension to add " DT1 " text ? "))) (while ES (setq EG (entget (car ES))) (if (= (cdr (assoc 0 EG)) "DIMENSION") (progn (setq TT (cdr (assoc 1 EG))) (if (= TT "") (setq NT (strcat DT3 "<> " DT2)) (setq NT (strcat TT " " DT2)) ) (setq EG (subst (cons 1 NT) (assoc 1 EG) EG)) (entmod EG) ) (princ (strcat "\nERROR - Entity selected is [" (cdr (assoc 0 EG)) "] and NOT a dimension.")) ) (setq ES (entsel (strcat "\nSelect Dimension to add " DT1 " text ? "))) ) 
(princ) )

Если загрузить всё вместе пишет в ком. строке "успешно загружено".
Команда: ; ошибка: лишняя закрывающая скобка на входе
Команда: DIMRW
; ошибка: no function definition: DIMADD
Подскажите, пожалуйста, где ошибка и есть ли программа добавления текстовой строки под линию размера.

Кулик Алексей aka kpblc · 10.01.2023, 13:14

Если код отформатировать то никаких ошибок нет. И ни одна из команд не вставит никакой текст "под" линию размера.

Konstr_pgs · 10.01.2023, 13:37

Цитата:

Сообщение от Кулик Алексей aka kpblc

Если код отформатировать то никаких ошибок нет. И ни одна из команд не вставит никакой текст "под" линию размера.

Как отформатировать код? И лисп для текста "под" линию размера нужен отдельный, может у кого есть?

Кулик Алексей aka kpblc · 10.01.2023, 14:02

Цитата:

Сообщение от Konstr_pgs

Как отформатировать код?

https://autolisp.ru/?s=%D0%BF%D0%BE%...82%D0%B8+vlide

Цитата:

Сообщение от Konstr_pgs

И лисп для текста "под" линию размера нужен отдельный, может у кого есть?

Попробуй сам написать, благо пример перед глазами - твой же пост.
Offtop: Хотя, если честно, я бы работал через ActiveX...

1958 · 10.01.2023, 14:23

Цитата:

Сообщение от Konstr_pgs

В общем, только это нужно.

Пробуйте. Не для дуговых размеров.

Кулик Алексей aka kpblc · 10.01.2023, 14:38

... и не заработает.

Konstr_pgs · 10.01.2023, 14:50

Цитата:

Сообщение от 1958

Пробуйте. Не для дуговых размеров

Спасибо, 1958, только строка добавляется над линией (как на 1-й миниатюре), а надо под (как на 2-й миниатюре)...
Наверное, в коде должно быть это "<>\X".

Кулик Алексей aka kpblc · 10.01.2023, 14:54

Я ж говорил.
Вариант без тестов, ибо работать лениво:

Код:

[Выделить все]

 (defun t1 (/ str dim vla_dim err)
  (if (and (= (type (setq str (vl-catch-all-apply (function (lambda () (getstring t "\nEnter text : "))))))
              'str
           ) ;_ end of =
           (= (type (setq dim (vl-catch-all-apply (function (lambda () (car (entsel "\nSelect dim : ")))))))
              'ename
           ) ;_ end of =
           (= (cdr (assoc 0 (entget dim))) "DIMENSION")
      ) ;_ end of and
    (if (vl-catch-all-error-p
          (setq err (vl-catch-all-apply
                      (function (lambda ()
                                  (setq vla_dim (vlax-ename->vla-object dim))
                                  (vla-put-textoverride
                                    vla_dim
                                    (strcat
                                      (cond
                                        ((= (vla-get-textoverride vla_dim) "")
                                         "<>\\X"
                                        )
                                        ((wcmatch (vla-get-textoverride vla_dim) "*\\X*")
                                         (strcat (vla-get-textoverride vla_dim) " ")
                                        )
                                        (t (strcat (vla-get-textoverride vla_dim) "\\X"))
                                      ) ;_ end of cond
                                      str
                                    ) ;_ end of strcat
                                  ) ;_ end of vla-put-textoverride
                                ) ;_ end of lambda
                      ) ;_ end of function
                    ) ;_ end of vl-catch-all-apply
          ) ;_ end of setq
        ) ;_ end of vl-catch-all-error-p
      (princ (strcat "\nError : " (vl-catch-all-error-message err)))
    ) ;_ end of if
  ) ;_ end of if
  (princ)
) ;_ end of defun

1958 · 10.01.2023, 15:04

Класс!

Konstr_pgs · 10.01.2023, 15:04

Цитата:

Сообщение от Кулик Алексей aka kpblc

Вариант без тестов

Алексей, спасибо, отлично работает!

Кулик Алексей aka kpblc · 10.01.2023, 15:05

Это - не команда. Это - функция. Вызывать со скобками.

1958 · 10.01.2023, 15:09

Цитата:

Сообщение от Konstr_pgs

Алексей, спасибо, но в ком. строке сообщение
Команда: ; ошибка: синтаксическая ошибка

У меня в AC2021 всё отлично, ни каких ошибок.

Konstr_pgs · 10.01.2023, 15:19

Цитата:

Сообщение от 1958

Команда: ; ошибка: синтаксическая ошибка

Нет всё нормально, Алексей, как быстро! За 4 мин? Супер!

Konstr_pgs · 15.01.2023, 11:34

Алексей, а можно так подправить код #8, чтобы не писать текст в ком. строке (nEnter text) , а
1) сначала выделить размер, а потом в редакторе текста этого размера писать нужный текст под линией;
2) или, например, выбрать размер, а текст (можно слово "текст") сам вставится под линию;
3) или, хотя бы, чтобы запоминался текст, который ввели первый раз при выборе.
Спасибо!

Кулик Алексей aka kpblc · 15.01.2023, 20:24

1. Смысла делать не вижу. Тут проще будет напрямую в свойствах писать необходимый результат
2. И откуда брать этот несчастный "текст"?
3. Можно. Загнать текст в глобальную переменную и работать дальше.

P.S. Для приколу: https://autolisp.ru/2023/01/15/about-code-refactor/

koMon · 15.01.2023, 23:08

1,2,3

Код:

[Выделить все]

 
(defun c:dim_under_text (/ override dename stop_picking_dimension dim_single_sset text_under)
  	(while (not stop_picking_dimension)
  		  (if (or
  			 	 (null dim_overridden)
  			 	 (= "" (setq override (if (vlax-erased-p dim_overridden) "<>\\XUNDER_TEXT" (vla-get-textoverride dim_overridden))))
  		         (= "<>\\X" override)
  		      )
  			      (if (= 6 (acet-ui-message "Текст под размерную линию\nне определён, определить?" "Внимание!" 4))
  			        	(setq override (strcat "<>\\X" (if (vl-catch-all-error-p (setq text_under (vl-catch-all-apply 'getstring (list "\nТекст под размерную линию:" t)))) "" text_under)))
  						(setq override "")
  			      )
  		  )
  	      (setq dim_single_sset (vl-catch-all-apply 'ssget (list "_+.:S" '((0 . "*dimension*")))))
  		  (cond
  		    	(
  			 		(vl-catch-all-error-p dim_single_sset)
  			 			(princ "\nОтмена команды")
						(setq stop_picking_dimension t)
  				)
  				(
  				 	(null dim_single_sset)
  				)
  				(
  				 	t
  						(setq dename (ssname dim_single_sset 0))
  						(setq dim_overridden (vlax-ename->vla-object dename))
  						(vla-put-textoverride dim_overridden override)
  						(command-s "_textedit" "_m" "_s" dename)
  				)
  		  )
  	)
    (princ)
)

Ingpro · 16.01.2023, 10:33

koMon, спасибо, но чё-то не работает, выскакивает окошко "Текст под размерную линию не определён, определить?".
Жму "да" пишу текст, enter, Отмена команды...

Konstr_pgs · 16.01.2023, 10:42

Цитата:

Сообщение от Кулик Алексей aka kpblc

2. И откуда брать этот несчастный "текст"?

Слово "текст" просто может быть в лиспе (по умолчанию), вызываем команду, выбираем размер и слово "текст" уже под линией размера..
Но если не хотите возиться, пойму, лисп и так хороший.

koMon · 16.01.2023, 11:11

Цитата:

Сообщение от Ingpro

чё-то не работает

Нажмите на изображение для увеличения
Название: DUT.gif
Просмотров: 54
Размер: 1,002.2 Кб
ID: 252629

Ingpro · 16.01.2023, 11:38

koMon, у Вас красиво работает, может дело в рус-версии AutoCad 2015?
пишу текст, enter,
Отмена команды...

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
AutoCAD 2013: нужно наклонить выносную линию размера	Creator	AutoCAD	6	27.04.2015 13:27
При удлинении линии вводом размера, делает линию именно этого размера, почему?	erikbond	AutoCAD	30	02.07.2013 17:13
Быстрый выбор повернутых/параллельных размеров без текстовой строки	CHILD_11	AutoCAD	6	11.12.2012 10:16
Как изменить размер букв при вводе после создания новой текстовой строки?	pabra	AutoCAD	4	22.10.2012 12:06
Извлечение текстовой строки из примитива	ShaggyDoc	Программирование	6	14.12.2008 17:02