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

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

Требуется помощь с циклом в лиспе

Ответ
Поиск в этой теме
Непрочитано 19.03.2009, 09:14 #1
Требуется помощь с циклом в лиспе
Composter
 
Отопление и вентиляция
 
Москва
Регистрация: 31.10.2008
Сообщений: 445

попытался сделать лисп который бы собирал текст из отдельно стоящих текстов и соединял в 1 .вот лисп. после 2 тыканья мышкой цикл почему то прерывается . объясните как правильно нужно сделать

;слияние текста
(defun c:Zod3 ()
(setq z "" zn "" x nil y nil)
(setq x (car(entsel)))
(setq zn (cdr(assoc 1 (entget x))))
(setq z zn)
(while (null y)
(setq y (car(entsel)))
(setq zn (cdr(assoc 1 (entget y))))
(setq z (strcat z " " zn))
);end while
(entmod (subst (cons 1 z) (assoc 1 (entget x)) (entget x)))
);end defun
Просмотров: 7376
 
Непрочитано 19.03.2009, 09:41
#2
Makson


 
Регистрация: 24.04.2008
Сообщений: 1,131


например так
(defun c:Zod3 ()
(setq z "" zn "" x nil y 1)
(setq x (car(entsel)))
(setq zn (cdr(assoc 1 (entget x))))
(setq z zn)
(while (/= y nil)
(setq y (car(entsel)))
(if (/= y nil)(setq zn (cdr(assoc 1 (entget y)))))
(if (/= y nil)(setq z (strcat z " " zn)))
);end while
(entmod (subst (cons 1 z) (assoc 1 (entget x)) (entget x)))
);end defun
Makson вне форума  
 
Непрочитано 19.03.2009, 09:42
#3
Makswell

Инженер-строитель
 
Регистрация: 15.08.2007
Киров
Сообщений: 2,204


Как вариант:
Код:
[Выделить все]
(defun c:Zod3 (/ z zn x y flag)
  (if (setq x (entsel))
    (progn
      (setq z (cdr (assoc 1 (entget (car x)))))
      (while (setq y (entsel))
	(setq zn   (cdr (assoc 1 (entget (car y))))
	      z	   (strcat z " " zn)
	      flag t
	)
      )
      (if flag
	(entmod (subst (cons 1 z) (assoc 1 (entget (car x))) (entget (car x))))
      )
    )
  )
  (princ)
)
Makswell вне форума  
 
Автор темы   Непрочитано 19.03.2009, 09:54
#4
Composter

Отопление и вентиляция
 
Регистрация: 31.10.2008
Москва
Сообщений: 445


всем спасибо ,оба варианта отлично работают.
Composter вне форума  
 
Непрочитано 19.03.2009, 09:55
#5
CB

Конструирование в области нефтеразведки
 
Регистрация: 10.02.2006
Гомель
Сообщений: 321


Можно так:
Код:
[Выделить все]
(defun c:Zod3 (/ x x_txt y y_txt)
  (if (setq x (car (entsel "\nИсходный текст")))
    (progn
      (setq x_txt (cdr (assoc 1 (entget x))))
      (setq y (car (entsel "\nТекст для слияния...")))
      (while y
        (setq y_txt (cdr (assoc 1 (entget y))))
        (entmod (subst (cons 1 (strcat x_txt y_txt))
                       (assoc 1 (entget x))
                       (entget x)
                ) ;_ end of subst
        ) ;_ end of entmod
        (setq x_txt (cdr (assoc 1 (entget x))))
        (setq y (car (entsel "\nТекст для слияния...")))
      ) ;_ end of while
    ) ;_ end of progn
  ) ;_ end of if
  (princ)
) ;_ end of defun
CB вне форума  
 
Автор темы   Непрочитано 19.03.2009, 10:14
#6
Composter

Отопление и вентиляция
 
Регистрация: 31.10.2008
Москва
Сообщений: 445


последний вариант вобще здоровский. а как сделать что бы не прерывался лисп при щелкании на пустом месте?
Composter вне форума  
 
Непрочитано 19.03.2009, 10:16
#7
Profan


 
Регистрация: 25.12.2005
Москва
Сообщений: 13,627


Последняя программа поинтереснее будет.
Изменить бы название темы на:
Как собрать несколько отдельных текстов в один текст?
Profan вне форума  
 
Непрочитано 19.03.2009, 11:12
#8
ShaggyDoc

Thượng Tá Quân Đội Nhân Dân Việt Nam
 
Регистрация: 14.03.2005
44d32'44"С, 33d26'51"В
Сообщений: 13,381


Цитата:
Сообщение от Composter Посмотреть сообщение
последний вариант вобще здоровский. а как сделать что бы не прерывался лисп при щелкании на пустом месте?
Например использовать вместо штатной entsel вот такую функцию:

Код:
[Выделить все]
(defun _ru-get-entsel-no-error (message / ent)
  ;; (_ru-get-entsel-no-error "Выбери объект, но не промахнись!")
  (setvar "errno" 0)
  (while
    (and
      (not (setq ent (entsel (strcat "\n" message))))
      (equal 7 (getvar "errno"))
    ) 
     (setvar "errno" 0)
  ) 
  (cond
    ((equal (getvar "errno") 52)
     nil
    )
    (t
     (list (car ent) (trans (cadr ent) 1 0))
    )
  ) 
)
Вообще-то её надо обернуть более высокоуровневой фукцией для обработки других ситуаций, но для простого применения и так пойдет.
ShaggyDoc вне форума  
 
Непрочитано 19.03.2009, 11:17
#9
Krieger

инженер (КМ)
 
Регистрация: 30.10.2004
Красноярск
Сообщений: 3,825


Цитата:
Сообщение от Composter Посмотреть сообщение
а как сделать что бы не прерывался лисп при щелкании на пустом месте?
Код:
[Выделить все]
;|Функция Kr_entsel
*** Автор Морозов С.В. aka Krieger ***
Еденичный выбор объекта, замена функции entsel
Возвращает entity name выбранного примитива или nil, точку указки запоминает в переменной LASTPOINT
Параметры:
promt - предложение выбрать объект (string)
filter - фильтр объектов для выбора вида '("LINE" "LWPOLYLINE")
entlist - список примитивов которые не надо выбирать (либо список entity name, либо PICKSET)

Примеры:
(Kr_entsel "\nВыберите объекты" '("LINE" "LWPOLYLINE") nil)
(Kr_entsel "\nВыберите объекты" nil nil)
(setq aa nil) (Kr_entsel "\nВыберите объекты" '("LINE" "LWPOLYLINE") (while (setq a (car (entsel))) (setq aa (append aa (list a)))))
(Kr_entsel "\nВыберите объекты" '("LINE" "LWPOLYLINE") (ssget))

|;

(defun Kr_entsel (promt filter entlist / key n newentlist ent_point promt)
  
  (setq key T n 0 newentlist nil)
  (if (eq (type entlist) 'PICKSET)
    (progn
        (while (setq a (ssname entlist n)) (setq newentlist (append newentlist (list a)) n (1+ n)))
        (setq entlist newentlist)
    );progn
   );if
    (while key
        (if (or (setq ent_point (entsel promt)) (= (getvar "ERRNO") 7))
          (if (or (eq (type ent_point) 'LIST) (not ent_point))
          (if ent_point
            (if (member (setq ent (car ent_point)) entlist)
              (princ "\nПримитив уже выбран")
              (if filter
                  (if (not (member (cdr (assoc 0 (entget ent))) filter))
                (progn (setq str "\nНе верный выбор, выберите: ")
                  (princ (substr (setq str (foreach n filter (setq str (strcat str n ", ")))) 1 (- (strlen str) 2)))
                );progn
                (setq key nil)
                  );if
                (setq key nil)
            );if
            );if
            (setq key T)
          );if
            (setq key nil)
        );if
      (setq key nil)
          );if
     );while
  (if (eq (type ent_point) 'LIST)
    (progn (setvar "LASTPOINT" (cadr ent_point)) ent)
    ent_point
  );if
);defun
__________________
Делай хорошо, плохо само получится.
Krieger вне форума  
 
Непрочитано 19.03.2009, 12:22
#10
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,990
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Цитата:
Сообщение от Composter Посмотреть сообщение
последний вариант вобще здоровский. а как сделать что бы не прерывался лисп при щелкании на пустом месте?
В общем все эти примеры сводятся к анализу типа выбранного объекта (чего нет в Zod3) и анализу переменной ERRNO. (если промахнешься выбором код будет 7, если нажмешь клавишу ввод - 52)
*** Добавлено Проверка типа
Код:
[Выделить все]
(defun c:Zod3 (/ x x_txt y y_txt)
  (if (setq x (car (entsel "\nИсходный текст :")))
    (progn
      (setvar "errno" 0)
      (setq x_txt (cdr (assoc 1 (entget x))))
      (while (not (equal (getvar "errno") 52))
        (setq y (car (entsel "\rТекст для слияния...")))
        (if (and y (wcmatch (cdr (assoc 0 (entget y))) "*TEXT"))
          (progn
            (setq y_txt (cdr (assoc 1 (entget y))))
            (entmod (subst (cons 1 (strcat x_txt y_txt))
                           (assoc 1 (entget x))
                           (entget x)
                    ) ;_ end of subst
            ) ;_ end of entmod
            (setq x_txt (cdr (assoc 1 (entget x))))
          ) ;_ end of progn
        ) ;_ end of if
      ) ;_ end of while
    ) ;_ end of progn
  ) ;_ end of if
  (princ)
  )
__________________
Как использовать код на Лиспе читаем здесь

Последний раз редактировалось VVA, 19.03.2009 в 13:20. Причина: Добавил проверку типа
VVA вне форума  
 
Непрочитано 19.03.2009, 12:25
#11
CB

Конструирование в области нефтеразведки
 
Регистрация: 10.02.2006
Гомель
Сообщений: 321


Почти тоже, что и VVA...
Код:
[Выделить все]
(defun c:Zod3 (/ x x_txt y y_txt)
  (if (setq x (car (entsel "\nИсходный текст :")))
    (progn
      (setvar "errno" 0)
      (setq x_txt (cdr (assoc 1 (entget x))))
      (while (not (equal (getvar "errno") 52))
        (setq y (car (entsel "\rТекст для слияния...")))
        (if y
          (progn
            (setq y_txt (cdr (assoc 1 (entget y))))
            (entmod (subst (cons 1 (strcat x_txt y_txt))
                           (assoc 1 (entget x))
                           (entget x)
                    ) ;_ end of subst
            ) ;_ end of entmod
            (setq x_txt (cdr (assoc 1 (entget x))))
          ) ;_ end of progn
        ) ;_ end of if
      ) ;_ end of while
    ) ;_ end of progn
  ) ;_ end of if
  (princ)
) ;_ end of defun
CB вне форума  
 
Автор темы   Непрочитано 19.03.2009, 14:14
#12
Composter

Отопление и вентиляция
 
Регистрация: 31.10.2008
Москва
Сообщений: 445


быстро тема разрослась.а как можно извлечь содержимое текста из атрибута блока ?
Composter вне форума  
 
Автор темы   Непрочитано 06.05.2009, 12:41
#13
Composter

Отопление и вентиляция
 
Регистрация: 31.10.2008
Москва
Сообщений: 445


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

Код:
[Выделить все]
(defun c:Zod3 ()

(if (setq x1 (nentsel "\nИсходный текст"))
	(progn
		(setq x (car x1))
		(setvar "errno" 0)
      		(setq x_txt (vla-get-textstring(vlax-ename->vla-object x)))
         	(while (not (equal (getvar "errno") 52))
        		(setq y (car (nentsel "\nТекст для слияния...")))
				(if (and 
					y
					(not(equal x y))
					(vlax-property-available-p (vlax-ename->vla-object y) 'textstring)
				     )
				(progn
					(setq y_txt (vla-get-textstring(vlax-ename->vla-object y)))
					(entdel y)
        				(vla-put-textstring(vlax-ename->vla-object x)(strcat x_txt " " y_txt))
        				(setq x_txt (vla-get-textstring(vlax-ename->vla-object x)))
					(if (= (length x1) 4) (entupd (car(cadddr x1))))
				);_ end of progn
			);_ end of if
		) ;_ end of while
	) ;_ end of progn
) ;_ end of if
(princ)
) ;_ end of defun
Composter вне форума  
 
Непрочитано 06.05.2009, 13:09
#14
Кулик Алексей aka kpblc
Moderator

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


1. Забыл про возможность блокирования слоя примитива-получателя.
2. Не отслеживается возможность указания текстового примитива внешней ссылки.
3. Не отслеживается вариант указания не текста.
4. Для снятия форматирования многострочного текста см. http://forum.dwg.ru/showthread.php?t=24790
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Автор темы   Непрочитано 06.05.2009, 14:06
#15
Composter

Отопление и вентиляция
 
Регистрация: 31.10.2008
Москва
Сообщений: 445


прошу объяснить пункты моих недоработок.
1.доработаю.
2.текст из внешних ссылок вроде тягает.
3.на счет не текста вроде проверка есть в строке
(vlax-property-available-p (vlax-ename->vla-object y) 'textstring)
за 4 пункт спасибо.
Composter вне форума  
 
Непрочитано 06.05.2009, 14:38
#16
Кулик Алексей aka kpblc
Moderator

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


2. Я говорил не про то, чтобы "тягать" - тут-то как раз все нормально. Но я в качестве объекта слияния (то есть получателя) могу указать текст, лежащий внутри внешней ссылки - мне такое не запрещено
3. А про проверку объекта x1 (и следом про получение из него строки) забыл
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Автор темы   Непрочитано 06.05.2009, 15:25
#17
Composter

Отопление и вентиляция
 
Регистрация: 31.10.2008
Москва
Сообщений: 445


на счет объектов внешних ссылок все нормально получается.по крайней мере у меня ,я использовал в качестве внешней ссылки dwg файл.
3 пункт доработал.а вот с 1 неполучается до конца.подскажи.
я вначале узнаю является ли слой объекта заблокированым,если да то разблокирую и запоминаю значение до разблокирования.а в конце лиспа хочу обратно слой объекта заблокировать.но я так понимаю что после окончания while он работать не хочет,как ето осуществить?и еще вопрос если примитив можно обновить через entupd, то со слоем это не прокатывает,можно ли так сделать что когда отключается блокирование слоя это было видно визуально?

Код:
[Выделить все]
(defun c:Zod3()

(if (and (setq x1 (nentsel "\nИсходный текст"))
	(vlax-property-available-p (vlax-ename->vla-object(car x1)) 'textstring)
    )
	(progn
		
		(setq x (car x1))
		(setvar "errno" 0)
      		(setq x_txt (vla-get-textstring(vlax-ename->vla-object x)))
		(setq la_x (tblobjname "layer" (cdr(assoc 8(entget(car x1))))))
		(setq old_block (assoc 70 (entget la_x)))
		(if (= (cdr(assoc 70 (entget la_x))) 4)
				(entmod(subst '(70 . 0)(assoc 70 (entget la_x)) (entget la_x))) 
		)

         	(while (not (equal (getvar "errno") 52))
        		(setq y (car (nentsel "\nТекст для слияния...")))
				(if (and 
					y
					(not(equal x y))
					(vlax-property-available-p (vlax-ename->vla-object y) 'textstring)
				     )
				(progn
					(setq y_txt (vla-get-textstring(vlax-ename->vla-object y)))
					(entdel y)
        				(vla-put-textstring(vlax-ename->vla-object x)(strcat x_txt " " y_txt))
        				(setq x_txt (vla-get-textstring(vlax-ename->vla-object x)))
					(if (= (length x1) 4) (entupd (car(cadddr x1))))
				);_ end of progn
			);_ end of if
		) ;_ end of while
	) ;_ end of progn
) ;_ end of if
(entmod(subst old_block (assoc 70 (entget la_x)) (entget la_x)))
(princ)
) ;_ end of defun
Composter вне форума  
 
Непрочитано 06.05.2009, 15:31
#18
Кулик Алексей aka kpblc
Moderator

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


В качестве объекта у укажи текст, который лежит внутри внешней ссылки. Сохрани файл. Выйди из него. Снова открой. Проверь - внеслись ли изменения. У меня в версиях от 2005 до 2008 включительно изменения не сохранялись (что более чем ожидаемо).
Насчет блокирования слоя... Запомни состояние слоя объекта-получателя, сними блокировку; меняешь как сделано; восстанавливаешь состояние слоя. Достаточно просто.
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Автор темы   Непрочитано 06.05.2009, 15:56
#19
Composter

Отопление и вентиляция
 
Регистрация: 31.10.2008
Москва
Сообщений: 445


с разблокировкой все вышло.а что делать делать с внешней ссылкой что бы она сохранилась не знаю.подскажи.
Composter вне форума  
 
Непрочитано 06.05.2009, 16:40
#20
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,990
<phrase 1= Отправить сообщение для VVA с помощью Skype™


По п.3 имеется ввиду
Код:
[Выделить все]
(if (setq x1 (nentsel "\nИсходный текст"))
здесь проверки нет.
По поводу проверки блокирови слоя можно анализировать, доступен ли объект по записи, т.е
Код:
[Выделить все]
(if (vlax-write-enabled-p (vlax-ename->vla-object(car(entsel "\nВыберите объект"))))
  (alert "Нормально")
  (alert "Блокирован слой")
  )
*** Добавлено
Цитата:
с разблокировкой все вышло.а что делать делать с внешней ссылкой что бы она сохранилась не знаю.подскажи.
Лучше запретить выбор текста-приемника внешней ссылки

*** Добавлено2
1. Можно анализировать имя блока-родителя, если в имени есть символ "|" - значит это XREF,
2. Можно отсекать XREF snvalid'ом (имя стиля будет тоже с "|")
Код:
[Выделить все]
(if (and (setq x1 (nentsel "\nИсходный текст"))
	 (setq vla-obj (vlax-ename->vla-object(car x1)))
	(vlax-write-enabled-p vla-obj)  ;_Слой не блокирован 
	(vlax-property-available-p vla-obj  'textstring) ;_Текст
	 (snvalid (vla-get-StyleName vla-obj))           ;_Не внешняя ссылка
    )
  ....
__________________
Как использовать код на Лиспе читаем здесь

Последний раз редактировалось VVA, 06.05.2009 в 16:56.
VVA вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Требуется помощь с циклом в лиспе

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

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


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Требуется помощь, дабы написать на лиспе программу проверяющую топологию WeMaN LISP 23 26.01.2011 01:26
требуется помощь kristi Программирование 1 03.03.2005 05:55
Требуется помощь!!! ElenaU Прочее. Архитектура и строительство 5 02.03.2005 15:09