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

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

LISP бы для текста

Ответ
Поиск в этой теме
Непрочитано 23.11.2005, 19:01 #1
LISP бы для текста
Dym
 
Двинскъ
Регистрация: 27.09.2005
Сообщений: 595

маленький бы лиспик чайнику. суть такая - есть кучка разбросанного на поле текста, надо последовательно выделяя собрать в строку разделяя к примеру через "; ". вручную через буфер уже замучился, в архиве похожего не нашёл
Просмотров: 3656
 
Непрочитано 23.11.2005, 21:12
#2
vk

сисадмин
 
Регистрация: 26.08.2003
Самара
Сообщений: 1,022
<phrase 1=


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

Код:
[Выделить все]
;;; Сборка нескольких текстов в один
;;; Выбрать несколько 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)
vk вне форума  
 
Непрочитано 23.11.2005, 21:28
#3
Лентяй

Project Engineer
 
Регистрация: 05.01.2005
Лос Анджелес
Сообщений: 1,156


Держи аналогично с разделением простого текста и мультитекста.
Код:
[Выделить все]
(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
Лентяй вне форума  
 
Непрочитано 23.11.2005, 23:11
#4
vk

сисадмин
 
Регистрация: 26.08.2003
Самара
Сообщений: 1,022
<phrase 1=


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


ЗЫ: ничего личного
vk вне форума  
 
Непрочитано 23.11.2005, 23:40
#5
Лентяй

Project Engineer
 
Регистрация: 05.01.2005
Лос Анджелес
Сообщений: 1,156


Мне больше нравится
Код:
[Выделить все]
(vlax-release-object ass)
Лентяй вне форума  
 
Автор темы   Непрочитано 24.11.2005, 00:04
#6
Dym


 
Регистрация: 27.09.2005
Двинскъ
Сообщений: 595
Отправить сообщение для Dym с помощью Skype™


я в тихой радости. Спасибо!
Dym вне форума  
 
Непрочитано 29.11.2005, 14:15
#7
Jurasic


 
Регистрация: 10.01.2005
Москва
Сообщений: 89
<phrase 1=


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

(Печатается на правах рекламы)
Jurasic вне форума  
 
Автор темы   Непрочитано 29.11.2005, 16:19
#8
Dym


 
Регистрация: 27.09.2005
Двинскъ
Сообщений: 595
Отправить сообщение для Dym с помощью Skype™


каюсь, прощелкал сейчас пользую Лентяеву штучку( ещё раз спасибо), мне она удобнее-быстрее составлять кабельный журнал.
увязать бы её ещё с таблицей
Dym вне форума  
 
Непрочитано 29.11.2005, 16:59
#9
ki

Constructor
 
Регистрация: 28.09.2005
SPb
Сообщений: 695
<phrase 1= Отправить сообщение для ki с помощью Skype™


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

P.S. Это мне навеял сайт elite-game, там по игре Х2 есть тема "делимся скриптами" (игру можно модифицировать).
__________________
Для ухода за пожилым программистом требуется приятная женщина, говорящая на FОRTRАN, BАSIС и С++
ki вне форума  
 
Непрочитано 29.11.2005, 17:07
#10
Кулик Алексей aka kpblc
Moderator

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


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

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 29.11.2005, 18:09
#11
ki

Constructor
 
Регистрация: 28.09.2005
SPb
Сообщений: 695
<phrase 1= Отправить сообщение для ki с помощью Skype™


To kpblc
Я просто имел ввиду здесь сделать.
А то, что там есть - это здорово.
__________________
Для ухода за пожилым программистом требуется приятная женщина, говорящая на FОRTRАN, BАSIС и С++
ki вне форума  
 
Непрочитано 29.11.2005, 23:31
#12
Лентяй

Project Engineer
 
Регистрация: 05.01.2005
Лос Анджелес
Сообщений: 1,156


Цитата:
mitjaj: сейчас пользую Лентяеву штучку( ещё раз спасибо), мне она удобнее-быстрее составлять кабельный журнал.
Так она еще и работает! Не ожидал, но, тем не менее, душевно рад. Пользуйтесь на здоровье и не забывайте сугубо и трегубо благодарить меня за то, что есть.
Цитата:
увязать бы её ещё с таблицей
Киньте темплет таблицы - подумаю.
Лентяй вне форума  
 
Непрочитано 30.11.2005, 10:48
#13
{Smirnoff}

Инженер по системам безопасности
 
Регистрация: 23.11.2003
Рига
Сообщений: 1,099


>mitjaj

Есть ещё вот такая штука http://www.autocad.ru/cgi-bin/f1/board.cgi?t=21807yD . Не совсем то, но с таблицами работает.
{Smirnoff} вне форума  
 
Непрочитано 01.12.2005, 22:32
#14
Лентяй

Project Engineer
 
Регистрация: 05.01.2005
Лос Анджелес
Сообщений: 1,156


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
Лентяй вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > LISP бы для текста

Размещение рекламы
Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск