[Евгений]

Чертеж А0 жутко насыщен текстом (обозначения, наименования таблица и т.п) Весь текст находитмя на одном слое. Вопрос: как можно найти и соединить полилинией одинаковый текст? Может у кого лиспик для этого имеется? Откуда моно вытащить координаты расположения текста?

[Torino]

Лиспик сегодня не получится.
А координаты точки вставки находятся по коду 10.

[Лентяй]

Вопрос: как можно найти и соединить полилинией одинаковый текст?

Это в каком смысле? Если нарисовать общую рамку, так это легсевручную. А если соединить полилинией точки вставки текста - то это совсем другое дело. Хотя - это, опять же легче сделать вручную, потому как здесь играет роль эстетика и предпочтения, при изолированном слое текста с приязкой к точке вставки.

[ZZZ]

Не сильно понимаю зачем это автору нужно, наверноё для самоконтроля.
Состяпал тут что-то (чтобы навыки не потерять):

Код:

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

(defun c:test (/ ss ent_lst txt_pt_lst sorting_pt_lst)
;;;  Выбор тектовых объектов
  (setq ss (ssget '((0 . "TEXT"))))
  (while (and ss (/= (sslength ss) 0))
    (setq ent_lst (cons (ssname ss 0) ent_lst))
    (ssdel (ssname ss 0) ss)
    ) ;_ while
;;;  Нахождение текста и точек вставки
  (setq	txt_pt_lst
	 (mapcar '(lambda (ent)
		    (list (cdr (assoc 1 (entget ent)))
			  (cdr (assoc 10 (entget ent)))
			  ) ;_ list
		    ) ;_ lambda
		 ent_lst
		 ) ;_ mapcar
	) ;_ setq
;;;  Отсортировка по одинаковым текстам
  (while txt_pt_lst
    (setq sorting_pt_lst
	   (append
	     sorting_pt_lst
	     (list
	       (mapcar 'cadr
		       (vl-remove-if-not
			 '(lambda (a)
			    (= (car a) (caar txt_pt_lst))
			    ) ;_ lambda
			 txt_pt_lst
			 ) ;_ vl-remove-if-not
		       ) ;_ list
	       ) ;_ list
	     ) ;_ append
	  ) ;_ setq
    (setq txt_pt_lst
	   (vl-remove-if
	     '(lambda (a)
		(= (car a) (caar txt_pt_lst))
		) ;_ lambda
	     txt_pt_lst
	     ) ;_ vl-remove-if
	  ) ;_ setq
    ) ;_ while
;;;  Удаление точек одиночных текстов
  (setq	sorting_pt_lst
	 (vl-remove-if
	   '(lambda (a) (= (length a) 1))
	   sorting_pt_lst
	   ) ;_ vl-remove-if
	) ;_ setq
;;;  Сортировка слева на право и снизу вверх (возможен и другой способ)
  (setq	sorting_pt_lst
	 (mapcar
	   '(lambda (pt_lst)
	      (vl-sort pt_lst
		       '(lambda	(a b)
			  (or (< (car a) (car b))
			      (and (= (car a) (car b))
				   (< (cadr a) (cadr b))
				   ) ;_ and
			      ) ;_ or
			  ) ;_ lambda
		       ) ;_ vl-sort
	      ) ;_ lambda
	   sorting_pt_lst
	   ) ;_ mapcar
	) ;_ setq
;;;  Отрисовка полилиний
  (mapcar
    '(lambda (pt_lst)
       (entmake)
       (entmake '((0 . "POLYLINE") (62 . 1) (66 . 1)))
       (mapcar
	 '(lambda (pt) (entmake (list '(0 . "VERTEX") (cons 10 pt))))
	 pt_lst
	 ) ;_ mapcar
       (entmake '((0 . "SEQEND")))
       ) ;_ lambda
    sorting_pt_lst
    ) ;_ mapcar
  (princ)
  ) ;_ defun

Прогу можно доделать в отсортировке вешин полилиний(минимальной длины) и в отрисовке полилиний на нужном слоё цветом и типом линии.

[Евгений]

Спасибо большое! Записал! Чичас буду пробовать! Кстати в 2005том заработает? И не увидел где отрисовывается полилиния... А ситуевина такова. Сливалось несколько документов. Там много устройств с одинаковыми именами. (Перечень занимает 38 листов на А4) Написаны Мтекстом и Текстом. Но написаны в одном слое. Надо отследить расположение каждого, может и отредактировать. а команда Find неудобна для этой цели да и линий не рисует!

[ZZZ]

Для выбора МТЕКСТа замени строку
(setq ss (ssget '((0 . "TEXT"))))
на
(setq ss (ssget '((-4 . "<OR")(0 . "TEXT")(0 . "MTEXT")(-4 . "OR>"))))

С МТЕКСТом могут быть проблемки:
1)в мтексте есть ещё шрифты и форматирование, которых так особо не замечаешь;
2)При длинных строках хранит текст в DXF индексы 1 и 3, их необходимо сливать вместе;
3)Если в мтексте содержится несколько строк с именами то эта прога не найдет похожесть с одинаковым текстом содержащих отдельные именна.

Советик. Взрывай МТЕКСТ - избавишся от шрифтов, форматирования и разобъёт на одиночныё строки.