Lisp. Выделение нового в чертеже.

Lisp. Выделение нового в чертеже. · 17.04.2014, 08:49

Попробую сформулировать задачу :
Есть созданый готовый чертеж, считается что он готов и с этого момента ему присваивается версия ноль
Потом этот чертеж редактируется, разными людьми в разное время, и, наконец, считается, что можно присвоить ему версию "1"
Необходимо выделить облачками (REVCLOUD) в чертеже все изменения произошедшие с чертежом после создания версии "0" до "1".
Облачка эти помещаются на свой слой, с указанием номера версии, допустим "VER_1"
Аналогично создаются слои "VER_2" "VER_3" и т.д. при создании новых версий, при этом слои предыдущих версий замораживаются.

теперь по программированию:
При выпуске VER_0 в чертеж вставляется объект метка, в виде облачка на соот. слое. Время создания этого объекта и есть начало отсчета.
В базе чертежа

Код:

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

 (vla-get-modelspace(vla-get-activedocument(vlax-get-acad-object)))

несомненно есть данные о порядке создания объектов (как получить объекты в порядке создания?), нужно просто определить те из них, что созданы позже объекта метки. Но есть еще редактированные объекты, измененные позже времени их создания - можно ли их определить?
Функция выделения полученного набора объектов облачками - это отдельная песня, нужно как-то определять группы близко расположенных объектов, чтобы не выделять каждый в отдельности. Но для начала нужно понять - возможно ли вообще получить необходимый набор объектов.

Ну вот, собственно, прошу помощи

nolte · 19.04.2014, 21:50

Дима_,
ты прав, спасибо.
скажем название слоя "ABC" и "CBA" никто не запрещал. исправил.

Дима_ · 20.04.2014, 00:40

То notle, ну надеюсь Вы не обидчивый, но исправление Ваше ситуацию не исправило - показать коллизию на такой строке - уровенение на уровне 5-го класса (да даже не суть какого оно класса - вероятность возникновения коллизии на произвольных данных относительно очень высокая), VVA показал ссылку на MD5 - чем он Вас не устроил?? - не изобретайте велосипед.
з.ы. я честно говоря вообще обленился - и вытащил бы из .Net'а соответствующие классы хешей, но если хочется чистым лиспом (а если VVA до сих пор "системных" ActiveX не нашел - то считаем что их нет) - говорим спасибо LeeMac'у.
з.з.ы. Вдруг вспомнил, в ассемблере был популярный прием проверки условного CRC с не сильной коллизийностью, но достаточно быстрый и "подходящий для большинства задач" - последовательное XOR'ирование аккамулятора к последовательности - реализовывался в 5 строк (ассемблера! - то есть в пять команд процессора) и соответственно по скорости был практически на уровне простого чтения аналогичного массиваиз памяти - вот Вам вариант.

nolte · 20.04.2014, 04:05

Дима_,
и снова согласился. действительно можно довольно легко подобрать другую строку с тем же результатом, к примеру "wall" "rsfh" = 1501 "WALL" "rsx" = 1053 и не важно, что получается абра кадабра вполне может быть и чего то со смыслом, всех вариантов не просчитаешь. исправил.

VVA · 20.04.2014, 21:48

Взял алгоритм RS Hash Function отсюда General purpose hash function algorithms library
В конце выдает количество измененных примитивов. Особо не тестировал. За основу взял код nolte. Здесь криптостойкость не требуется, главное чтобы алгоритм был быстрый и с не сильной коллизийностью

Код:

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

(defun RShash (lst / a b hash)
;;;http://vak.ru/doku.php/proj/hash/sources
  (setq b  378551
        a  63689
        hash  0
	lst (mapcar'(lambda(x)(if(eq (type (cdr x)) 'ename) '0 (cdr x))) lst)
  )
(foreach i (vl-string->list(vl-princ-to-string lst))
  (setq hash (+ (* a hash) i)
        a (* a b)
        )
  )
hash
)
;;;(RShash (cdr(entget(car(entsel)))))
(defun c:22 (/ i lst lst_new obj_set)
  (vl-load-com)
  (setq ech (getvar 'cmdecho))
  (setvar 'cmdecho 0)
  (repeat (setq i (sslength (setq obj_set (ssget "_X"))))
    (setq lst (cons (ssname obj_set (setq i (1- i))) lst))
  ) ;_ end of repeat
  (mapcar '(lambda (x / obj)
             (setq obj (vlax-ename->vla-object x))
             (if (vlax-ldata-get obj "SUM_ENT")
               (if (not (equal (vlax-ldata-get obj "SUM_ENT")
                               (RShash (cdr(entget x)))
                               0.0001
                        ) ;_ end of equal
                   ) ;_ end of not
                 (progn
                   (setq lst_new (cons x lst_new))
                   (mapcar '(lambda (a b)
                              (vlax-ldata-put obj a b)
                            ) ;_ end of lambda
                           (list "L_VER" "L_DATE" "RAB" "SUM_ENT")
                           (list
                             (+ 1
                                (if (vlax-ldata-get obj "L_VER")
                                  (vlax-ldata-get obj "L_VER")
                                  '0
                                ) ;_ end of if
                             ) ;_ end of +
                             (substr (rtos (getvar 'cdate) 2 10) 1 8)
                             (getenv "Username")
                             (RShash (cdr (entget x)))
                           ) ;_ end of list
                   ) ;_ end of mapcar
                 ) ;_ end of progn
               ) ;_ end of if
               (progn
                 (mapcar '(lambda (a b)
                            (vlax-ldata-put obj a b)
                          ) ;_ end of lambda
                         (list "L_ID" "L_VER" "L_DATE" "RAB" "SUM_ENT")
                         (list
                           (cdr(assoc 5(entget x)))
                           (+ 1
                              (if (vlax-ldata-get obj "L_VER")
                                (vlax-ldata-get obj "L_VER")
                                '0
                              ) ;_ end of if
                           ) ;_ end of +
                           (substr (rtos (getvar 'cdate) 2 10) 1 8)
                           (getenv "Username")
                           (RShash (cdr(entget x)))
                         ) ;_ end of list
                 ) ;_ end of mapcar
               ) ;_ end of progn
             ) ;_ end of if
           ) ;_ end of lambda
          lst
  ) ;_ end of mapcar
  (setvar 'cmdecho ech)
  (princ (strcat "\nИзмененные= " (itoa (length lst_new))))
  (princ)
) ;_ end of defun

BKDR Hash Function
без проверки

Код:

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

(defun BKDRhash (lst / seed hash)
;;;http://vak.ru/doku.php/proj/hash/sources
;;;https://www.programmingalgorithms.com/algorithm/bkdr-hash?lang=C%2B%2B
  (setq seed  13131 ;_ 31 131 1313 13131 131313 etc.. 
        hash  0
	lst (mapcar'(lambda(x)(if(eq (type (cdr x)) 'ename) '0 (cdr x))) lst)
  )
(foreach i (vl-string->list(vl-princ-to-string lst))
  (setq hash (+ (* seed hash) i))
  )
hash
)
;;;(BKDRhash (cdr(entget(car(entsel)))))

Apelsinov · 21.04.2014, 21:14

nolte, Дима_, VVA, Спасибо вам

код протестировать пока не могу

Цитата:

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

(list "L_ID" "L_VER" "L_DATE" "RAB" "SUM_ENT")

"L_ID" - думаю, лишнее. Если у объекта изменится ID, а ldata останутся, то контрольная сумма все равно изменится. Сейчас получается, что если я скопирую и вставлю объект с Ldata из буфера, то программа найдет его как отредактированный,
поменяет ldata, но оставит неактуальный ID.

"L_VER" и "SUM_ENT" - это минимально необходимое
"L_DATE" и "RAB" - ну в общем может пригодится при разборе полетов, но тут важно насколько это увеличивает время работы программы.

nolte · 21.04.2014, 22:00

Цитата:

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

"L_VER" и "SUM_ENT" - это минимально необходимое
"L_DATE" и "RAB" - ну в общем может пригодится при разборе полетов, но тут важно насколько это увеличивает время работы программы.

"L_DATE" и "RAB" - пригодятся для разборов полетов, для фильтрации изменений.
при копировании присваивается другой id, проверку добавил, добавил так же запись в файл ТХТ всех новых и измененных примитивов. пробовал ENTMAKE'ом восстанавливать из файла ТХТ - работает (на нескольких примитивах line polyline).

Код:

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

 
;;;=====================================================================================
(princ "\n------------------------------------------------")
(princ "\n\n\t\tA LIST OF COMMANDS THAT LISP")
;;;			ВАРИАНТ VVA
(defun RShash (lst / a b hash)
;;;http://vak.ru/doku.php/proj/hash/sources
  (setq b  378551
        a  63689
        hash  0
	lst (mapcar'(lambda(x)(if(eq (type (cdr x)) 'ename) '0 (cdr x))) lst)
  )
(foreach i (vl-string->list(vl-princ-to-string lst))
  (setq hash (+ (* a hash) i)
        a (* a b)
        )
  )
hash
)
;;;(RShash (cdr(entget(car(entsel)))))
(defun l-drw-control (/ i lst lst_new obj_set)
  (vl-load-com)
  (setq ech (getvar 'cmdecho))
  (setvar 'cmdecho 0)
  (repeat (setq i (sslength (setq obj_set (ssget "_X"))))
    (setq lst (cons (ssname obj_set (setq i (1- i))) lst))
  ) ;_ end of repeat
  (mapcar '(lambda (x / obj)
						(setq obj (vlax-ename->vla-object x))
            (if (vlax-ldata-get obj "L_ID")
							(if (or	(not (eq (vlax-ldata-get obj "L_ID") (cdr(assoc 5(entget x)))))
											(not (equal (vlax-ldata-get obj "SUM_ENT") (RShash (cdr(entget x))) 0.0001))
									)
									(progn
										(setq lst_new (cons x lst_new))
										(mapcar '(lambda (a b)
															(vlax-ldata-put obj a b)
                            ) ;_ end of lambda
												(list "L_ID" "L_VER" "L_DATE" "RAB" "SUM_ENT")
                        (list
													(cdr(assoc 5(entget x)))
                          (+ 1
														(if (vlax-ldata-get obj "L_VER")
															(vlax-ldata-get obj "L_VER")
                              '0
                            ) ;_ end of if
                          ) ;_ end of +
                          (substr (rtos (getvar 'cdate) 2 10) 1 8)
                          (getenv "Username")
                          (RShash (cdr(entget x)))
                        ) ;_ end of list
										) ;_ end of mapcar
									) ;_ end of progn
              ) ;_ end of if
							(progn
								(setq lst_new (cons x lst_new))
								(mapcar '(lambda (a b)
													(vlax-ldata-put obj a b)
												) ;_ end of lambda
											(list "L_ID" "L_VER" "L_DATE" "RAB" "SUM_ENT")
											(list
												(cdr(assoc 5(entget x)))
												(+ 1
													(if (vlax-ldata-get obj "L_VER")
														(vlax-ldata-get obj "L_VER")
														'0
													) ;_ end of if
												) ;_ end of +
												(substr (rtos (getvar 'cdate) 2 10) 1 8)
												(getenv "Username")
												(RShash (cdr(entget x)))
											) ;_ end of list
								) ;_ end of mapcar
							) ;_ end progn
						);_ end of if
          ) ;_ end of lambda
        lst
  ) ;_ end of mapcar
  (setvar 'cmdecho ech)
  (princ (strcat "\nИзмененные= " (itoa (length lst_new))))
  lst_new
) ;_ end of defun

;;;=========================================================================================================================
;;;		ДЕЙСТВИЯ С ПОЛУЧЕНЫМ СПИСКОМ ОБНАВЛЕННЫХ И ВНОВЬ СОЗДАННЫХ ПРИМИТИВОВ
;;;				1.	ЗАПИСЬ В ФАЙЛ TXT
(princ "\n\tLISP - DRAWING CONTROL \n\tCOMMAND : 21")
(defun c:21 (/ lst)
(setq ech (getvar 'cmdecho))
(setvar 'cmdecho 0)
(if (setq lst (l-drw-control)) (l-wr-lst-to-txtfl lst))
(setvar 'cmdecho ech)
(princ)
)
(defun l-wr-lst-to-txtfl (lst / pfl fl fl_r)
(vl-load-com)
(setq ech (getvar 'cmdecho))
(setvar 'cmdecho 0)

(if (not(findfile (setq fl_r(strcat (getvar 'dwgprefix) "data_" (vl-string-right-trim ".dwg" (getvar 'dwgname)) ".txt"))))
	(setq fl fl_r)
	(setq fl (strcat (getvar 'dwgprefix) "data_zm" ".txt"))
)
(setq pfl (open fl "w"))
(if (eq fl fl_r)
	(write-line (strcat "ID" "\t" "N ОБНОВЛЕНИЯ" "\t" "ДАТА" "\t" "ЧЕРТЕЖНИК" "\t" "ПРИМИТИВ") pfl)
)
(mapcar '(lambda (x)
					(prin1 x pfl) (princ "\n" pfl)
				)
		(mapcar '(lambda (a)
							(append
								(mapcar '(lambda (b)
													(vlax-ldata-get (vlax-ename->vla-object a) b)
												)
										(list "L_ID" "L_VER" "L_DATE" "RAB")
								)
								(list(vl-remove-if '(lambda (c) (= (cdr c) " ")) (vl-remove-if '(lambda (d) (= (type(cdr d)) 'ENAME)) (entget a))))
							)
						)
				lst
		)			
)										
(close pfl)
(if (not(eq fl fl_r))
	(progn
		(vl-file-copy fl fl_r T)
		(vl-file-delete fl)
	)
)
(setvar 'cmdecho ech)
(princ)
)
;;;==============================================================================================================================
;;;		УДАЛЕНИЕ ВСЕХ РАСШИРЕННЫХ ДАННЫХ
(princ "\n\tLISP - DELETE XDATA \n\tCOMMAND : ER21")
(defun c:er21 (/ lst i obj_set fl)
(repeat (setq i (sslength (setq obj_set (ssget "_X"))))
	(setq lst (cons (ssname obj_set (setq i (1- i))) lst))
) ;_ end of repeat
(mapcar '(lambda (x)
					(mapcar '(lambda (a)
										(vlax-ldata-delete x a)
									)
							(list "L_ID" "L_VER" "L_DATE" "RAB" "SUM_ENT")
					)
				)
		lst
)
(if (findfile (setq fl (strcat (getvar 'dwgprefix) "data_" (vl-string-right-trim ".dwg" (getvar 'dwgname)) ".txt"))) (vl-file-delete fl))
(princ)
)
(princ "\n------------------------------------------------\n")

----- добавлено через ~5 ч. -----
вопрос к знатокам.
пытаюсь восстановить чертеж из ТХТ файла, запись в файл осуществляется с помощью функции "21" поста 26. лисп стабильно считывает описание 544 примитивов из записанных в файл 1085 и восстанавливает их в том же файле автокада (предварительно все стерто с чертежа).
я так понял, что одна из проблем это замороженные и выключенные слои, где еще может быть зарыта собака.
конечная цель - полное восстановление чертежа в чистом, новом файле автокада из файла ТХТ.

лисп для восстановления:

Код:

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

 
;;;================================================================================================
;;;			ВОССТАНОВЛЕНИЕ ЧЕРТЕЖА				
(defun rec21 (/ fl pfl lst)
(setq fl (strcat (getvar 'dwgprefix) "data_" (vl-string-right-trim ".dwg" (getvar 'dwgname)) ".txt"))
(setq pfl (open fl "r"))
(while (read-line pfl)
	(setq lst (cons (read-line pfl) lst))
)
(close pfl)
lst
)
(defun rr2 (lst)
(mapcar '(lambda (x)
					(if (not(entmake (vl-remove-if '(lambda (a) (= (car a) 5)) x)))
						(entmake (vl-remove-if '(lambda (a) (= (car a) 5)) x))
					)
				)
		(vl-remove-if '(lambda (b) (= (cdr(assoc 0 b)) "VIEWPORT")) (mapcar 'last (mapcar 'read (cdr lst))))
)
(princ)
)

я его малость поломал, экспериментировал, но суть осталась.

Nikolay 2 · 25.04.2014, 16:24

Цитата:

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

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

nolte а как выделить (подсветить, изменить цвет) найденные таким способом примитивы в чертеже??

Дима_ · 25.04.2014, 16:53

см. (sssetfirst ...)

VVA · 25.04.2014, 20:13

Цитата:

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

где еще может быть зарыта собака.

AcDbZombieObject (в лиспе ACAD_PROXY_ENTITY)

nolte · 25.04.2014, 23:59

Цитата:

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

AcDbZombieObject

ежли это дело проверяется vla-get-objectname, то нет такого. Вот думается, что не восстанавливаются вложения блоков в блок.

Nikolay 2 · 26.04.2014, 00:07

Цитата:

Сообщение от Дима_

см. (sssetfirst ...)

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

Дима_ · 26.04.2014, 00:44

Сейчас не проверить - по моему так:

Код:

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

 (defun light-lst(lst)
  ((lambda(ss) (mapcar '(lambda(ent) (ssadd ent ss)) lst)
               (sssetfirst nil ss))
   (ssadd)))

Nikolay 2 · 26.04.2014, 01:02

не сработало
Команда: (light-lst)
; ошибка: слишком мало аргументов

Дима_ · 26.04.2014, 01:07

и не сработает - надо (light-lst список_примитивов_которые_надо_подсветить)

Nikolay 2 · 26.04.2014, 01:20

список вставить вместо (lst)?

Vov.Ka · 26.04.2014, 03:00

прямое сравнение хешев из (entget x) не будет работать
Entity name в разных сессиях будут разные
надо все пары, где есть Entity name, исключать

я бы рекомендовал сохранять "версию 1" в отдельный файл, а потом сравнивать с ней "версию N"

Apelsinov · 26.04.2014, 08:50

Vov.Ka, уже исключили

Цитата:

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

(RShash (cdr(entget x)))

Цитата:

Сообщение от Vov.Ka

я бы рекомендовал сохранять "версию 1" в отдельный файл, а потом сравнивать с ней "версию N"

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

VVA · 26.04.2014, 09:16

Цитата:

Сообщение от Vov.Ka

Entity name в разных сессиях будут разные
надо все пары, где есть Entity name, исключать

Цитата:

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

Vov.Ka, уже исключили

И здесь

Цитата:

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

lst (mapcar'(lambda(x)(if(eq (type (cdr x)) 'ename) '0 (cdr x))) lst)

На днях пришлось немного поиграться с RShash, так в некоторых случаях получал отрицательный результат. Возможно, придется полученную из entget'a строку делить на блоки по N байт для хеширования

nolte · 26.04.2014, 10:59

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

VVA · 26.04.2014, 12:30

Цитата:

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

это всмысле со знаком минус /возможно результат отрицательных координат/

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

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Lisp. Как выбрать три последних не удаленных примитива на чертеже используя ent*	Yura Agafonov	LISP	17	27.06.2012 01:25
LISP. Выделение блоков с динамическими свойствами	Composter	LISP	14	16.02.2012 22:42
LISP / AutoCAD2008 / Как программно снять выделение у примитивов, не используя sssetfirst	TararykovDG	LISP	7	14.01.2011 10:48
LISP. Автоматическое замораживание нового слоя на выбраных вьюпортах	Yuzer	LISP	2	25.12.2010 02:37
Произведение нескольких чисел на чертеже? Нужен Lisp по типу sum.lsp	UnAtom	LISP	2	24.11.2010 20:18

17.04.2014, 08:49
Lisp. Выделение нового в чертеже. Apelsinov Проектировщик ВК. LISP-любитель. Москва Регистрация: 15.12.2003 Сообщений: 1,189 Попробую сформулировать задачу : Есть созданый готовый чертеж, считается что он готов и с этого момента ему присваивается версия ноль Потом этот чертеж редактируется, разными людьми в разное время, и, наконец, считается, что можно присвоить ему версию "1" Необходимо выделить облачками (REVCLOUD) в чертеже все изменения произошедшие с чертежом после создания версии "0" до "1". Облачка эти помещаются на свой слой, с указанием номера версии, допустим "VER_1" Аналогично создаются слои "VER_2" "VER_3" и т.д. при создании новых версий, при этом слои предыдущих версий замораживаются. теперь по программированию: При выпуске VER_0 в чертеж вставляется объект метка, в виде облачка на соот. слое. Время создания этого объекта и есть начало отсчета. В базе чертежа Код: [Выделить все] (vla-get-modelspace(vla-get-activedocument(vlax-get-acad-object))) несомненно есть данные о порядке создания объектов (как получить объекты в порядке создания?), нужно просто определить те из них, что созданы позже объекта метки. Но есть еще редактированные объекты, измененные позже времени их создания - можно ли их определить? Функция выделения полученного набора объектов облачками - это отдельная песня, нужно как-то определять группы близко расположенных объектов, чтобы не выделять каждый в отдельности. Но для начала нужно понять - возможно ли вообще получить необходимый набор объектов. Ну вот, собственно, прошу помощи __________________ apel.fas
Просмотров: 9626

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