LISP. Не удается корректно отсортировать объекты

tujn08 · 19.07.2016, 09:57

Привет!
Не могу понять в чем дело.

Хочу сделать так:
Набрать список ID + координаты вставки от объектов в наборе.
Дальше отсортировать список по Y в нужной последовательности.
И переключаться по ID и заполнять свойства.

У меня получается так, что свойства меняется в одном блоке, а остальные не хотят. При этом ошибок не выдает.

Код:

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

 (progn
(defun zxc_1 () ; непосредственная нумерация после zxc_0
	;(setq ccord_1 (assoc '10 (entget a1)))	
	(setq a1 (entnext ent)) ; зашли в атрибуты	; координаты вставки форматки
	(setq b1 (cdr (assoc '2 (entget a1))))
	(while b1
		(if (equal b1 "ШИФР2")															; проверяем атрибуты перед вставкой
			(progn 
				(setq b1 (subst (cons 1 s_sh) (assoc '1 (entget a1)) (entget a1) ))		; записали
				(entmod b1)	(entupd a1)													; перерисовали
				(setq D0 T)
			)
		)			
		(if (equal b1 "ШИФР")															; проверяем атрибуты перед вставкой
			(progn 
				(setq b1 (subst (cons 1 s_sh) (assoc '1 (entget a1)) (entget a1) ))		; записали
				(entmod b1)	(entupd a1)													; перерисовали
				(setq D1 T)
			)
		)
		(if (equal b1 "СТАДИЯ")															; проверяем атрибуты перед вставкой
			(progn 
				(setq b1 (subst (cons 1 s_st) (assoc '1 (entget a1)) (entget a1) ))		; записали
				(entmod b1)	(entupd a1)													; перерисовали
				(setq D2 T)
			)
		)
		(setq a1 (entnext a1))
	  	(setq b1 (cdr (assoc '2 (entget a1)))); следующий атрибут
		(if
			(and (equal D0 T) (equal D1 T) (equal D2 T))
			(setq b1 nil)
		)
	)
)


(vl-load-com)

(initget 7) 																						; стр 83
	(setq s_sh (getstring "Введите шифр общий для всех чертежей (без ' - ' вконце)..."))
	(terpri)
	(initget 7) 																						; стр 83
	(setq s_st (getstring "Введите стадию проекта (П / Р)..."))
	(terpri)
(setq f_list nil)
(setq nab (ssget "_X"(list (cons 8 "Форматка_штамп") (cons 0 "INSERT"))))							; создали набор форматок
	(setq b (sslength nab)) 																			; всего в наборе
	;(alert (strcat "Найдено  форматок: " (itoa b) "   ")) 												; сообщение
	(setq i 0) 																					; счетчик перебора набора. Взяли из конца набора
  	(repeat b 																							; цикл по набору
		(setq a1 (ssname nab i)) 																		; взяли первый из набора
		(setq ccord (assoc '10 (entget a1)))															; координаты вставки форматки
		(setq obj (vlax-ename->vla-object a1))
		(setq n (vla-get-ObjectID obj))
		(if f_list
			(progn (setq f_list (cons (list n ccord) f_list)))
			(progn (setq f_list (list (list n ccord))))
		)
		(setq i (+ i 1))
	)
	(princ f_list)

		
		
(defun select-id(id)
	((lambda (ent)
		(if ent 
		(progn
			(zxc_1)
			;(sssetfirst nil (ssadd ent)) ; подсветить объект
			;(setq a1 (entnext ent)) ; зашли в атрибуты
			;(setq b1 (cdr (assoc '2 (entget a1)))) ; имя атрибута
		)
             (princ "Не найден объект"))
		(princ))
	(car (vl-remove-if '(lambda (x) (or (listp x)
                                       (not (equal id (vla-get-objectid (vlax-ename->vla-object x))))))
                      (mapcar 'cadr (ssnamex (ssget "_a"))))))
)
	(setq b (length f_list)) ; всего в списке
	(setq i 0)
	(repeat b
	  (setq a (car (nth i f_list)))
		(select-id a)
	  (terpri)
	  (princ a)(terpri)
  		(setq i (+ i 1))
	)

)

----- добавлено через ~19 мин. -----
Я подумал и решил обойтись номерами из набора. Так будет проще всего.

Кулик Алексей aka kpblc · 19.07.2016, 13:09

Что значит "в нужной последовательности"? По какому критерию будешь сортировать? По точке вставки? По значению атрибута?
Если по точке вставки, то посмотри нечто типа:

Код:

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

 (if (= (type
         (setq selset (vl-catch-all-apply (function (lambda () (ssget '((0 . "INSERT") (8 . "Форматка_штамп")))))))
         ) ;_ end of type
       'pickset
       ) ;_ end of =
(foreach ent  (vl-sort ((lambda (/ tab item)
              (repeat (setq tab  nil
                            item (sslength selset)
                            ) ;_ end setq
                (setq tab (cons (ssname selset (setq item (1- item))) tab))
                ) ;_ end of repeat
              tab
              ) ;_ end of lambda
            )
           (function (lambda (a b) (< (caddr (assoc 10 (entget a))) (caddr (assoc 10 (entget b))))))
           ) ;_ end of vl-sort
;; Здесь че-то делаешь
)
  ) ;_ end of if

P.S. "Номера из набора" в твоем случае вряд ли дадут гарантированное решение.

tujn08 · 19.07.2016, 14:28

Цитата:

Сообщение от Кулик Алексей aka kpblc

По какому критерию будешь сортировать?

Y-координата все, что выше в начало списка.

Кулик Алексей aka kpblc · 19.07.2016, 14:43

Ну так вперед, пример есть. Вообще-то тема опять свернула в оффтоп.

tujn08 · 19.07.2016, 15:06

И ошибку нашел с своем коде.

Кулик Алексей aka kpblc · 19.07.2016, 16:11

В моем? Может быть, писал практически насухую и без проверок.

tujn08 · 19.07.2016, 17:54

Цитата:

Сообщение от Кулик Алексей aka kpblc

В моем?

нет - в моем. Собственно нашел ошибку и первоначальный вопрос отпал даже.

----- добавлено через 16 сек. -----
Спасибо за скорые ответы!

tujn08 · 25.07.2016, 09:07

Я все же свой код решил использовать т.к. по ходу еще манипуляции надо делать.

И столкнулся с проблемой:

Код:

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

 (princ f_list)
(18819.4 18829.4 19522.3 21004.3 21014.3 20330.9 20340.9 20638.6 20648.6 19897.9 19907.9 19234.5 19532.3 19542.3 18531.7 18541.7 18839.4 18849.4)
(vl-sort-i f_list '>)
(4 3 8 7 6 5 10 9 13 12 2 11 17 16 1 0 15 14)

vl-sort-i - сортирует неправильно! При чем когда как. Пару дней назад все отлично работало. Изменил код и все сломалось.
Почему сортировка неправильная?

Кулик Алексей aka kpblc · 25.07.2016, 09:09

Ты попробуй просто vl-sort, посмотри на результат.

tujn08 · 25.07.2016, 09:13

Сортировка слетает после того как:
вставляю еще один примитив ->
создаю новый набор ->
запускаю сортировку. - сортировка неправильная

Если удаляю этот примитив, то сортировка правильная

Кулик Алексей aka kpblc · 25.07.2016, 09:13

Ты хоть что сортируешь?

tujn08 · 25.07.2016, 09:15

Команда: (vl-sort f_list '>)
(21014.3 21004.3 20648.6 20638.6 20340.9 20330.9 20320.9 20310.9 19907.9 19897.9 19542.3 19532.3 19522.3 19512.3 19502.3 19234.5 18849.4 18839.4 18541.7 18531.7)

Всегда правильно.

----- добавлено через ~4 мин. -----

Цитата:

Сообщение от Кулик Алексей aka kpblc

Ты хоть что сортируешь?

динамические блоки- точнее их координаты.
Создаю набор, создаю список координат, переворачиваю список, сортирую-получаю i . По i из набора в нужной последовательности работаю с блоками (меняю значения атрибутов и другое)

Код:

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

 (setq nab (ssget "_X"(list (cons 8 "Форматка_штамп") (cons 0 "INSERT"))))
(setq b (sslength nab)) 																			; всего в наборе
	;(alert (strcat "Найдено  форматок: " (itoa b) "   ")) 												; сообщение
	(setq i 0) 																							; счетчик перебора набора. Взяли из конца набора
  	(repeat b 																							; цикл по набору
		(setq a1 (ssname nab i)) 																		; взяли первый из набора
		(setq ccord (nth 2 (assoc '10 (entget a1))))															; координаты вставки форматки
		(if f_list
			(progn (setq f_list (cons ccord f_list)))
			(progn (setq f_list (list ccord)))
		)
		(setq i (+ i 1))
	)
	(setq f_list (reverse f_list))
	(setq s (vl-sort-i f_list '>))
  	(princ s)
	(setq i 0)
	(setq i_nab (vl-position i s)) 																	; номер который обработать(присвоить шифр) первым
	(setq a1 (ssname nab i_nab)) 																	; взяли первый из набора
	(setq ccord_1 (nth 2 (assoc '10 (entget a1))))

----- добавлено через ~13 мин. -----
Забавно:
(vl-sort f_list '>) - всегда правильно
(vl-sort-i f_list '>) - всегда НЕправильно

Кулик Алексей aka kpblc · 25.07.2016, 09:34

Может, проще стоит работать?

tujn08 · 25.07.2016, 10:14

Цитата:

Сообщение от Кулик Алексей aka kpblc

Может, проще стоит работать?

Да неет... Не совсем то.

Кулик Алексей aka kpblc · 25.07.2016, 10:42

Ты указывал только сортировку по оси Оу - так и получаешь ее, чего не нравится? Поменяй направление сортировки - и все будет вполне нормально.
P.S. Потом покажи, что получилось - я хочу посмотреть и сравнить скорость выполнения.

tujn08 · 25.07.2016, 11:42

----- добавлено через ~35 мин. -----
Вот результат который мне нужен был (изменил строки 113,118,147):

Код:

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

 (progn ;defun c:zxc () ; функция нумерации шифра для стадии П
(vl-load-com)
(textscr)
  (setq	f_list nil)
  (setq nab_T nil)
(defun zxc_1 () 																		; непосредственная нумерация
  	(setq
  		D0 nil
		D1 nil
		D2 nil
		o nil
  	)
	(setq a1 (entnext a1)) 																; зашли в атрибуты
  	(setq b1 (cdr (assoc '2 (entget a1))))
	(while b1
		(if (equal b1 "ШИФР2")															; проверяем атрибуты перед вставкой
			(progn 
				(setq b1 (subst (cons 1 s_sh) (assoc '1 (entget a1)) (entget a1) ))		; записали
				(entmod b1)	(entupd a1)													; перерисовали
				(setq D0 T)
				(setq a1 (entnext a1))
				(setq b1 (cdr (assoc '2 (entget a1))))									; следующий атрибут
			)
		)			
		(if (equal b1 "ШИФР")															; проверяем атрибуты перед вставкой
			(progn 
				(setq b1 (subst (cons 1 s_sh) (assoc '1 (entget a1)) (entget a1) ))		; записали
				(entmod b1)	(entupd a1)													; перерисовали
				(setq D1 T)
				(setq a1 (entnext a1))
				(setq b1 (cdr (assoc '2 (entget a1))))									; следующий атрибут
			)
		)
		(if (equal b1 "СТАДИЯ")															; проверяем атрибуты перед вставкой
			(progn 
				(setq b1 (subst (cons 1 s_st) (assoc '1 (entget a1)) (entget a1) ))		; записали
				(entmod b1)	(entupd a1)													; перерисовали
				(setq D2 T)
				(setq a1 (entnext a1))
				(setq b1 (cdr (assoc '2 (entget a1))))									; следующий атрибут
			)
		)
		(setq a1 (entnext a1))
		(setq b1 (cdr (assoc '2 (entget a1))))											; следующий атрибут
		(if
			(and (equal D0 T) (equal D1 T) (equal D2 T))
			(setq b1 nil)
		)
	)
)
(defun zxc_0 () 
	(if o
		(progn 	в строке																									; ничего не делаем, курим в сторонке
		
		)	
		(progn
			(setq nab_T nil)
		  	(setq blkx (vlax-ename->vla-object a1)) 																; вася
			(vla-GetBoundingBox blkx 'minp 'maxp)  																	; ищи комментарий ; вася
			(setq pt1 (vlax-safearray->list minp))
			(setq pt2 (vlax-safearray->list maxp))
			(setq nab_T (ssget "_W" pt1 pt2 (list (cons 8 "Форматка_штамп") (cons 0 "MTEXT"))))							; создали набор текста
		;)
	  ;)
		  	(if nab_T
				(progn
					(setq a2 (ssname nab_T 0)) 
					(setq txt (cdr (assoc '1 (entget a2)))) ; -Ч-  -СХ-
				  	(setq blka (vlax-ename->vla-object a2))
					(vla-Delete blka)
				)
				(progn
					(setq txt "-Ч-")
				)
			)
		)	
	)
	(if (>= n 10)
		(progn
			(setq d "0")
		)
		(progn
			(setq d "00")
		)	
	)
	(setq nn (strcat txt d (itoa n)))
	(setq s_sh (strcat s_sh1 nn))
	(setq n (+ n 1))
)
;;;	(initget 7) 																						; стр 83
;;;	(setq s_sh1 (getstring "Введите шифр общий для всех чертежей (без ' - ' вконце)..."))
;;;	(terpri)
;;;	(initget 7) 																						; стр 83
;;;	(setq s_st (getstring "Введите стадию проекта (П / Р)..."))
;;;	(terpri)
	(setq s_sh1 "1980610/000Д-П-00000-ИОС2-01")
	(setq s_st "П")
	(setq n 1)
	(setq nab (ssget "_X"(list (cons 8 "Форматка_штамп") (cons 0 "INSERT"))))							; создали набор форматок
	(setq b (sslength nab)) 																			; всего в наборе
	;(alert (strcat "Найдено  форматок: " (itoa b) "   ")) 												; сообщение
	(setq i 0) 																							; счетчик перебора набора. Взяли из конца набора
  	(repeat b 																							; цикл по набору
		(setq a1 (ssname nab i)) 																		; взяли первый из набора
		(setq ccord (nth 2 (assoc '10 (entget a1))))															; координаты вставки форматки
		(if f_list
			(progn (setq f_list (cons ccord f_list)))
			(progn (setq f_list (list ccord)))
		)
		(setq i (+ i 1))
	)
	(setq f_list (reverse f_list))
	(setq s (vl-sort f_list '>))
  	(princ s) 
	(princ f_list)
	(setq i 0)
	;(setq i_nab (vl-position i s)) 																	; номер который обработать(присвоить шифр) первым
	(setq i_nab (vl-position (nth 0 s) f_list))
	(setq a1 (ssname nab i_nab)) 																	; взяли первый из набора
	(setq ccord_1 (nth 2 (assoc '10 (entget a1))))													; координаты вставки форматки
	(setq o T)
	(progn
			(setq nab_T nil)
		  	(setq blkx (vlax-ename->vla-object a1)) 																; вася
			(vla-GetBoundingBox blkx 'minp 'maxp)  																	; ищи комментарий ; вася
			(setq pt1 (vlax-safearray->list minp))
			(setq pt2 (vlax-safearray->list maxp))
			(setq nab_T (ssget "_W" pt1 pt2 (list (cons 8 "Форматка_штамп") (cons 0 "MTEXT"))))							; создали набор текста
		;)
	  ;)
		  	(if nab_T
				(progn
					(setq a2 (ssname nab_T 0)) 
					(setq txt (cdr (assoc '1 (entget a2)))) ; -Ч-  -СХ-
				  	(setq blka (vlax-ename->vla-object a2))
					(vla-Delete blka)
				)
				(progn
					(setq txt "-Ч-")
				)
			)
		)
	(zxc_0)
	(zxc_1) 																						; пронумеровали
	(repeat (- b 1)
		(setq i (+ i 1))
		(setq ii_nab (vl-position (nth i s)  f_list)) 																; номер который обработать(присвоить шифр) первым
		(setq a1 (ssname nab ii_nab)) 																	; взяли первый из набора
		(setq ccord_2 (nth 2 (assoc '10 (entget a1))))													; координаты вставки форматки
		(if (equal ccord_1 ccord_2 15)
			(progn 																						; в строке - нумеруем
				(setq o T) (setq n (- n 1))
				(zxc_0)(zxc_1)
			)
			(progn  																					; не в строке - нумеруем
				(setq o nil)(zxc_0)(zxc_1)
			)
		)
		(setq ccord_1 ccord_2)
		(setq i_nab ii_nab)

	)
	(alert (strcat "Шифры пронумерованы: " (itoa b) "   ")) 												; сообщение
)

----- добавлено через ~3 мин. -----
Но так и не понятно почему сортировка vl-sort-i не работала.

Кулик Алексей aka kpblc · 25.07.2016, 12:50

Ты принципиально не локализовываешь переменные? http://autolisp.ru/2011/06/08/functi...bility-region/
С кодом через час-другой начну разбираться, не раньше.

tujn08 · 25.07.2016, 12:54

Цитата:

Сообщение от Кулик Алексей aka kpblc

Ты принципиально не локализовываешь переменные?

Да. так получается, что при изменении кода это становиться сложно делать. Короткие функции через foreach и lambda еще не привык писать (а надо бы).

Кулик Алексей aka kpblc · 25.07.2016, 12:57

Добавлю: есть еще такая штука, как параметры вызова.
Далее: (ssget "_W" ...) будет корректно работать только если вся область видима на экране.
Про привязки отдельно напоминать надо?

----- добавлено через 51 сек. -----
При правильной организации кода, передаче параметров и проч. - все становится очень просто и быстро.

Кулик Алексей aka kpblc · 25.07.2016, 13:55

Твой код вывалил ошибку на твоем же примере. В чем собственно затык - я разбираться не стал, в качестве примера кода - см.аттач.

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
LISP. Не могу корректно сменить основной файл меню	Кулик Алексей aka kpblc	LISP	8	04.07.2016 08:51
LISP. Программная вставка dwf в текущий файл	Кулик Алексей aka kpblc	LISP	4	10.02.2015 14:38
Lisp: удалить "ножницы".	hwd	LISP	2	29.05.2013 19:10
Объекты есть, но их нет!	Volodich	AutoCAD	19	22.03.2013 09:55
LISP: возможно ли выбрать через ssget рамкой объекты разных типов?	cj_lex	LISP	5	20.04.2012 10:54

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