[Dym]

маленький бы лиспик чайнику. суть такая - есть кучка разбросанного на поле текста, надо последовательно выделяя собрать в строку разделяя к примеру через "; ". вручную через буфер уже замучился, в архиве похожего не нашёл

[vk]

Что то вроде этого?

Код:

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

;;; Сборка нескольких текстов в один
;;; Выбрать несколько TEXT'ов
;;; Все последующие TEXT'ы будут прилеплены к первому
;;; в порядке выбора

(defun c:addstrings (/ ss str ent1 ent)
  (setq ss (ssget '((0 . "TEXT"))))
  (setq ent1 (ssname ss 0))
  (setq str (cdr (assoc 1 (entget ent1))))
  (ssdel ent1 ss)
  
  (while (> (sslength ss) 0)
    (setq ent (ssname ss 0)) 
    (setq str (strcat str "; " (cdr (assoc 1 (entget ent)))))
;;;    (entdel ent) ;_ удаление текста
    (ssdel ent ss)
  )
  (vla-put-textstring (vlax-ename->vla-object ent1) str)
  (princ)
)
(vl-load-com)

;;;(c:addstrings)

[Лентяй]

Держи аналогично с разделением простого текста и мультитекста.

Код:

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

(defun C:TxtComb ( / strd strm ht pt wth)
  (prompt "\Select Text Srings to Combine: ")
  (ssget)
  (setq adoc (vla-get-ActiveDocument (vlax-get-acad-object))
	ass (vla-get-ActiveSelectionSet adoc)
	util (vla-get-utility adoc))
  (vlax-for txt ass
    (cond ((= (vla-get-ObjectName txt) "AcDbText")
	   (if (null strd)
	     (setq csp (vla-ObjectIDToObject adoc (vla-get-OwnerID txt))
		   strd (vla-get-TextString txt)
		   ht (vla-get-height txt))
	     (setq strd (strcat strd "; " (vla-get-TextString txt)))));text
	  ((= (vla-get-ObjectName txt) "AcDbMText")
	   (if (null strm)
	     (setq csp (vla-ObjectIDToObject adoc (vla-get-OwnerID txt))
		   strm (vla-get-TextString txt))
	     (setq strm (strcat strm "\\p " (vla-get-TextString txt)))));MText
    ));vlax-for
  (cond (strd (prompt "\nEnter Insertion Point for Combined Text: ")
	 (vla-addText csp strd (vla-getpoint util) ht))
	(strm (prompt "\nEnter Insertion Point and Width for Combined MText: ")
	 (setq pt (vla-getpoint util) wth (vla-getDistance util pt))
	 (vla-addMText csp pt wth strm)));cond
);end

[vk]

Сообщение от Лентяй Код: [Выделить все] .......... (vlax-for txt [b]ass[/b] ..............

ЗЫ: ничего личного

[Лентяй]

Мне больше нравится

Код:

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

(vlax-release-object ass)

[Dym]

я в тихой радости. Спасибо!

[Jurasic]

Враки!!!! Есть такая программка в Download!!!!
http://dwg.ru/dwl/247 "Копирование содержания текста" называется.
Описание я там корявое, непонятное сделал, это да... Но делает она как раз то, что вам нужно.... Описание поправил....

(Печатается на правах рекламы)

[Dym]

каюсь, прощелкал сейчас пользую Лентяеву штучку( ещё раз спасибо), мне она удобнее-быстрее составлять кабельный журнал.
увязать бы её ещё с таблицей

[ki]

Всем привет.
У меня есть предложение: давайте сделаем тему LISP для чайников и профи.
Вэтой теме можно было бы задавать вопросы по лиспу, приводить примеры, выкладывать ссылки для скачивания того, что не жалко выложить, давать примеры с описанием что-зачем-почему-так-сделано, ну и так далее. Ну, т.е. сделать один большой ощий хелп по програмированию в среде ACAD.
Было бы здорово.

P.S. Это мне навеял сайт elite-game, там по игре Х2 есть тема "делимся скриптами" (игру можно модифицировать).

[Кулик Алексей aka kpblc]

> ki : можно заодно посмотреть на http://www.autocad.ru/cgi-bin/f1/board.cgi?p=44 - там полно всякого кода лежит.

[ki]

To kpblc
Я просто имел ввиду здесь сделать.
А то, что там есть - это здорово.

[Лентяй]

mitjaj: сейчас пользую Лентяеву штучку( ещё раз спасибо), мне она удобнее-быстрее составлять кабельный журнал.

Так она еще и работает! Не ожидал, но, тем не менее, душевно рад. Пользуйтесь на здоровье и не забывайте сугубо и трегубо благодарить меня за то, что есть.

увязать бы её ещё с таблицей

Киньте темплет таблицы - подумаю.

[{Smirnoff}]

>mitjaj

Есть ещё вот такая штука http://www.autocad.ru/cgi-bin/f1/board.cgi?t=21807yD . Не совсем то, но с таблицами работает.

[Лентяй]

mitjaj, Вы хочите заполнения таблиц - их есть у меня! Держите прогу и будет вам щастье.

Код:

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

(defun C:TxtComb ( / strd strm ht pt wth tbl Row Column PstStr) 
  (prompt "\nSelect Text Srings to Put Together: ") 
  (ssget) 
  (setq adoc (vla-get-ActiveDocument (vlax-get-acad-object))
        ass (vla-get-ActiveSelectionSet adoc)
        util (vla-get-utility adoc)) 
  (vlax-for txt ass 
    (cond ((= (vla-get-ObjectName txt) "AcDbText") 
      (if (null strd) (setq csp (vla-ObjectIDToObject adoc (vla-get-OwnerID txt))
                            strd (vla-get-TextString txt)
                            ht (vla-get-height txt)) 
        (setq strd (strcat strd ";" (vla-get-TextString txt)))));text 
     ((= (vla-get-ObjectName txt) "AcDbMText") 
      (if (null strm) (setq csp (vla-ObjectIDToObject adoc (vla-get-OwnerID txt))
                            strm (vla-get-TextString txt)) 
        (setq strm (strcat strm "\\p " (vla-get-TextString txt)))));MText 
    ));vlax-for
  (vla-InitializeUserInput util 128 "Yes No")
  (setq kw (vla-getKeyWord util "Fill the Table [Yes/No]: ? <Yes>"))
  (if (= kw "") (setq kw "Yes"))
  (if (= kw "Yes")
    (progn (prompt "\nSelect Cell to Start Filling From: ")
      (setq pt (vla-getpoint util)
	    pta (vlax-safearray->list (vlax-variant-value pt)))
      (vlax-for tbl csp
	(if (= (vla-get-objectname tbl) "AcDbTable")
	  (progn (vla-getboundingbox tbl 'mn 'mx)
	    (setq ptl (mapcar 'vlax-safearray->list (list mn mx)))
	    (if (and (< (caar ptl) (car pta) (caadr ptl))
		     (< (cadar plt) (cadr pta) (cadadr ptl)));and
	      (progn
		(setq HitRes (vla-HitTest tbl pt (vlax-3D-Point '(0.0 0.0 1.0)) 'Row 'Column))
		(if (= HitRes :vlax-true)
		  (progn (while (and strd (< Row (vla-get-Rows tbl)))
                     (if (= (substr strd 1 1) ";") (setq strd (substr strd 2)))
                     (setq PstStr (substr strd 1 (vl-string-search ";" strd)))
                     (vla-SetText tbl Row Column PstStr)
                     (setq strd (vl-string-left-trim PstStr strd) Row (1+ Row)));while
		  (if (/= strd "") (alert "Not Enough Rows! Upgrade the Table"))))))))));progn
    (cond (strd (prompt "\nEnter Insertion Point for Combined Text: ")
           (vla-addText csp strd (vla-getpoint util) ht))
          (strm (prompt "\nEnter Insertion Point and Width for Combined MText: ")
           (setq pt (vla-getpoint util) wth (vla-getDistance util pt))
           (vla-addMText csp pt wth strm)));cond
);end