[tujn08]

Понимаю, что лисп не очень аккуратен, но проблема вот в чем:
Дальше 29 листа автокад зависает. В чем может быть причина?

Код:

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

 (defun c:zxc ( / )
	(progn
	(vl-load-com)
	(setq a (car(entsel "\n Выбрать первый лист \n:")))
	(setq X1 (cadr(assoc '10 (entget a)))) ;Х координата выбранного блока
	(setq Y1 (caddr(assoc '10 (entget a)))) ;y координата выбранного блока
	(setq nab (ssget "_X"  (list (cons 8 "Форматка_штамп") (cons 0 "INSERT")))); создали набор
	(ssdel a nab);удалили из набора выбранный блок- от него пляшет отсчет
	(setq b (sslength nab) i b); получаем кол набора и кладем в переменную i
	(setq nnp 1); обнуляем счетчик = значение первого листа
	)
;////////////////тут присвоить номер выбранному листу//////////////
		(progn
		; вместо этого у нас просто "а" (setq a1 (ssname a i));взяли примитив из набора
		(setq a2 (entnext a))
		(repeat 7 ;кол атрибутов ЛИСТ на 6 месте
		(if (equal b1 "ЛИСТ")
				(progn 
					(setq b1 (subst (cons 1 (itoa nnp)) (assoc '1 (entget a2)) (entget a2)))
					(entmod b1);изменить примитив
					(entupd a2);перерисовать примитив
				)             
				(progn
					(setq a2 (entnext a2))
					(setq b1 (cdr(assoc '2(entget a2))))
				)
		);if
		)
		(repeat 7 ;кол атрибутов ЛИСТ на 6 месте
		(if (equal b1 "ЛИСТОВ")
				(progn 
					(setq b1 (subst (cons 1 (itoa (1+ b))) (assoc '1 (entget a2)) (entget a2)))
					(entmod b1);изменить примитив
					(entupd a2);перерисовать примитив
				)             
				(progn
					(setq a2 (entnext a2))
					(setq b1 (cdr(assoc '2(entget a2))))
				)
		);if
		);конец цикла перебора атрибутов
			(setq ip (sslength nab)); передаем колличество -> новой переменной
			(setq i (1- ip));т.к. начало с нуля, то делаем на 1 меньше. берем последний элемент учитывай 0
					);если первый лист
;////////////////тут присвоить номер выбранному листу/////////////////
	;(repeat b ; цикл по кол.набора
	(while nab ;пока набор существует
	;(repeat 36
		(progn
			(setq a1 (ssname nab i));взяли примитив из полного набора (взяли последний примитив)
			(setq X2 (cadr(assoc '10 (entget a1)))) ;Х координата выбранного блока
			(setq Y2 (caddr(assoc '10 (entget a1)))) ;y координата выбранного блока
			(setq a2 a1);для получения дополнительной информации примитива
			(setq a1 (entnext a1)) ;тут уже атрибут сидит первого примитива
				(setq blk (vlax-ename->vla-object a2))
				(setq w (cdar (setq q (mapcar '(lambda ( x ) (cons (vla-get-propertyname x) (vlax-get x 'value))) (vlax-invoke blk 'getdynamicblockproperties)))))
			(setq b1 (cdr(assoc '2(entget a1))))
			;(setq tip (cdr(assoc '0(entget a1))))
			;(and (equal w "последующий лист") (equal (- Y2 Y1) (- 0 10)) (equal (- X2 X1) (+ 10 (cdr (assoc '"Расстояние1" q)))))
			;);убрать
				(if (and (equal w "последующий лист") (equal (- Y2 Y1) (- 0 10)) (equal (- X2 X1) (+ 10 (cdr (assoc '"Расстояние1" q)))));and 
	(progn ;если лист в строкеи все хорошо
					 (setq nnp (1+ nnp));если лист стоит в правильной очереди, то ему присваивается значение +1
						(repeat 14 ;лист2 13 в очереди
							(if (equal b1 "ЛИСТ2")
								(progn 
									(setq b1 (subst (cons 1 (itoa nnp)) (assoc '1 (entget a1)) (entget a1)))
									(entmod b1);изменить примитив
									(entupd a1);перерисовать примитив
								)             
								(progn
									(setq a1 (entnext a1))
									(setq b1 (cdr(assoc '2(entget a1))))
									(setq tip (cdr(assoc '0(entget a1))))
								)
							);if
						);конец цикла перебора атрибутов
						;);(setq X1 X2 Y1 Y2); что бы всю строку пронумеровать пересваиваем значения дальше/ Тут по порядку вставки блоков
					(setq a1 (ssname nab i))
					(ssdel a1 nab);удалили из набора отработанный выбранный блок
					(setq X1 X2 Y1 Y2); что бы всю строку пронумеровать пересваиваем значения дальше; освободили вторые координаты путем присвоения их первым
					(setq b (sslength nab)); новое количество набора - на 1 стало меньше
					(if (equal b "0")
						(progn
						(setq nab nil)
						);progn
						(progn
						;(princ "\n Зацикливание!!! - резервный останов. Условие отработки блоков 'не в правильном месте' не произошло!\n")
						;(setq nab nil)
							(if (equal i 0)
								(progn ;i равно нулю
									(setq i (1- b))) ; progn i равно нулю
								(progn ;i больше нуля
									(setq i (1- i)));progn i больше нуля
							)
						);progn
					)
					); ;если лист в строкеи все хорошо
	(progn ; если лист не в "порядковой" строке
					(princ "\n Лист не в строке \n")
					(if (equal i 0)
					(progn 
					;(setq ip (sslength nab))
					(setq i (1- b))
					)
					(progn
					(setq i (1- i))
					)
					);if
					);progn если лист не в строке
				);if
		);progn
	);repeat b
);defun c: zxc

[baksconstructor]

В 2014 вообще не хочет работать.
Я не знаю что здесь исправить, но у Вас всё сделано атрибутами, а их пронумеровать можно и другими методами.

[tujn08]

Сообщение от baksconstructor другими методами.

Думаю не подойдет(хотя не знаю даже о каких методах идет речь) т.к.:
1) номер листа будет браться из концовки шифра (***-***-***-***-Ч025 = лист 25). Строка = одному чертежу из нескольких листов: 25.1 25.2 ... 25.N.
1.1) бывает без Ч025
2) Но есть случаи когда листов слишком много и их размещают в несколько строк
3) Есть атрибут "транслит" ***-***-***-***-CH025-revC0D-F0H.dwg"
где: D = номеру изма,
H = номер листа.
Учитывая все это кроме как программно не вижу вариантов. Тот лисп можно было бы использовать, но дальше 29 листа не хочет работать. Как временный вариант - дробить набор по 29.
Мне сказали списки проще обрабатывать и на форуме есть lisp перевода набора в списки. Кто знает о чем речь, прошу ссылку (я что-то нашел, но думаю это не то).

[VVA]

Сообщение от tujn08 на форуме есть lisp перевода набора в списки. Кто знает о чем речь, прошу ссылку

_dwgru-conv-pickset-to-list

[tujn08]

Спасибо! Я вчера почти тоже самое уже сам написал. Lisp отличается, но результат тот же.

[tujn08]

Кто замечал такое?
Не первый раз с этим сталкиваюсь.

Поясню:
два объекта лежат в одной плоскости, а автокад говорит, что нет! Почему?
Координаты не округляю даже.

[baksconstructor]

Сообщение от tujn08 хотя не знаю даже о каких методах идет речь

Возможно таким , там тоже есть нумерация.

[VVA]

Сообщение от tujn08 Поясню: два объекта лежат в одной плоскости, а автокад говорит, что нет! Почему? Координаты не округляю даже.

Точность представления вещественных чисел. Не парься, это нормально. В Equal есть необязательный параметр - точность. Используй его

Код:

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

(equal 1.99999999999 2.00000000000001 0.00001)
(equal 1.99999999999 2.00000000000001 1e-4)

[tujn08]

Сообщение от VVA В Equal есть необязательный параметр - точность. Используй его

У меня не укладывается в голове: 28 раз все работало, а 29 автокад решил изменить свое решение. Забавно )))

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

Сообщение от baksconstructor там тоже есть нумерация

У меня есть своя пакетная печать. Спасибо!

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

Сообщение от VVA В Equal есть необязательный параметр - точность. Используй его

Добавил погрешность/точность - дальше 29 листа не нумеруется, но уже не зависает (это прогресс!).

[VVA]

Сообщение от tujn08 У меня не укладывается в голове: 28 раз все работало, а 29 автокад решил изменить свое решение. Забавно )))

Автокад здесь ни при чем. Почитай здесь.

[tujn08]

Сообщение от VVA Почитай здесь.

Я думал об этом до lisp, но т.к. на тестовых 10 рамках работало исправно не делал округления.
Поменял выразение- нумерация пошла дальше, но опять зависает в конце )))

Код:

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

 (<= (- X2 X1) (+ 20 (cdr (assoc '"Расстояние1" q))))

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

Сообщение от tujn08 (setq b (sslength nab)); новое количество набора - на 1 стало меньше 083 ********************(if (equal b "0")

нашел ошибку тут. Вроде все работает )) Всем спасибо!!! но тему не буду закрывать- продолжение следует...

[tujn08]

Такой "дикий" вопрос у меня:
1. как создать пустой список
2. как правильно положить туда "STR"
3. как проверить наличие в списке "STR"

Код:

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

 (setq ls (list)) ; создали пустой список
(setq ls_b2 (list b2)) ; создали список из значения атрибута
(member (cdr(assoc '1(entget a1))) ls) ; есть такой в списке?
(append ls ls_b2) ; добавили в список новый шифр

У меня получается:
(123123 123123 123123 123123 123123 123123 123123 123123 123123 123123 123123 123123 2)("123123" "123123" "123123" "123123" "123123" "123123" "" "" "" "" "" "" "" "" "" "" "" "" "123123" "123123" "123123" "123123" "123123" "123123" "2")

Где ошибка?

Код:

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

 (defun c:asd ( / nab ls a a1 b1 blk w q x i ls_b2 b2)
	(vl-load-com)
	(setq nab (ssget "_X"  (list (cons 8 "Форматка_штамп") (cons 0 "INSERT")))) ; создали набор из всех форматок
	(setq b (sslength nab))
	(setq i (1- b)); количество в наборе и на чало счетчика переключения
	(setq ls (list)) ; создали пустой список
	(repeat b ; перебираем все атрибуты
		(setq a (ssname nab i)) ; взяли последний элемент в наборе
		(setq a1 (entnext a)) ; положили в а1 список атрибутов
		(setq b1 (cdr(assoc '2(entget a1)))) ; взяли название атрибута
			(setq blk (vlax-ename->vla-object a)) ; взяли vla объект в blk
			; w - название видимости (... "последующий лист" ...)
			; q - ширина форматки
			(setq w (cdar (setq q (mapcar '(lambda ( x ) (cons (vla-get-propertyname x) (vlax-get x 'value))) (vlax-invoke blk 'getdynamicblockproperties)))))
			(if (equal w "последующий лист") ; последующий лист?
				(progn ; да - последующий лист
					(repeat 1 ; ШИФР2 стоит 1 в очереди
						(if (equal b1 "ШИФР2")
							(progn (setq b2 (cdr(assoc '1 (entget a1))))) ; в новой переменной лежит шифр             
							(progn (setq a1 (entnext a1)) (setq b1 (cdr(assoc '2(entget a1)))))
							;;;(setq b1 (cdr(assoc '2(entget a1)))))вместо этого надо получить значение атрибута (cdr(assoc '1 (entget a1))) а не название ВЕЗДЕ!!!
						);if
					);конец цикла перебора атрибутов
				  		(setq a (ssname nab i)) ; взяли последний элемент в наборе
						(setq a1 (entnext a)) ; положили в а1 список атрибутов
						(setq b1 (cdr(assoc '2(entget a1)))) ; взяли название атрибута
					(repeat 14 ;шифр 14 в очереди - дополнительно меняем шифр в других видимостях
						(if (equal b1 "ШИФР")
							(progn (setq b2 (cdr(assoc '1 (entget a1))))) ; в новой переменной лежит шифр        
							(progn (setq a1 (entnext a1)) (setq b1 (cdr(assoc '2(entget a1)))))
						);if
					);конец цикла перебора атрибутов
				) ; да - последующий лист
				(progn ; нет - это первый или пустой лист
					(repeat 14 ;шифр 14 в очереди
						(if (equal b1 "ШИФР")
							(progn (setq b2 (cdr(assoc '1 (entget a1))))) ; в новой переменной лежит шифр        
							(progn (setq a1 (entnext a1)) (setq b1 (cdr(assoc '2(entget a1)))))
						);if
					);конец цикла перебора атрибутов
				  		(setq a (ssname nab i)) ; взяли последний элемент в наборе
						(setq a1 (entnext a)) ; положили в а1 список атрибутов
						(setq b1 (cdr(assoc '2(entget a1)))) ; взяли название атрибута
					(repeat 1 ; ШИФР2 стоит 1 в очереди - дополнительно меняем шифр в других видимостях
						(if (equal b1 "ШИФР2")
							(progn (setq b2 (cdr(assoc '1 (entget a1))))) ; в новой переменной лежит шифр             
							(progn (setq a1 (entnext a1)) (setq b1 (cdr(assoc '2(entget a1)))))
						);if
					) ;конец цикла перебора атрибутов
				) ; нет - это первый или пустой лист
			) ; if (equal w "последующий лист")
			(setq ls_b2 (list b2)) ; создали список из значения атрибута
			;; тут тоже поменять на значени атрибута
			(if (member (cdr(assoc '1(entget a1))) ls) ; есть такой в списке? 
				(progn ;да
					(setq i (1- i)) ; ищем в наборе дальше
				) ;да
				(progn ;нет
					(append ls ls_b2) ; добавили в список новый шифр
					(setq i (1- i)) ; ищем в наборе дальше
				) ;нет
			) ; if есть такой в списке?
			
	) ;repeat b
;1 получили чистый список
;1.1 сортировка списка по правилам: ОД СХ-002 Ч-003 ...
;цикл по количеству списка
;2 создать наборы по номеру из списка
;конец цикла
;цикл перебора всех наборов
;3 взяли первый набор
;4 цикл поиска первого листа
;5 нашли первый лист
;5.1 номер листа равен номеру элемента из списка + . + сквозная нумерация
;6 запуск программы нумерования
;7 запуск программы транслита
;конец цикла перебора всех наборов
) ;defun c:asd

[gomer]

Сообщение от tujn08 Такой "дикий" вопрос у меня: 1. как создать пустой список 2. как правильно положить туда "STR" 3. как проверить наличие в списке "STR"

(member str (cons str (list))

Сообщение от tujn08 Где ошибка?

Весь код походу одна сплошная ошибка, но это не точно, так как слишком много букаф

[tujn08]

Привет всем! С прошедшим 9 Мая!
Продолжаю тему...

Код:

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

 ;;; сквозная нумерация v_07_05_2015
;;; 0) нумерует все листы автоматически по ГОСТ по шифрам
;;; 1) шифр должен быть
;;; 2) шифры у разных чертежей должны отличаться
;;; 3) меняет шифр на правильный в других видимостях блока (этап подготовки для PDF)
;;; В следующих версиях:
;;; 1) транслит автоматически
;;; 2) автоматическая рамка для PDF (этап подготовки для PDF)
;;; 3) новая версия рамки с атрибутами изменений
(defun c:asd ( / nab a a1 b1 blk w q x i ls_b2 b2)
  (setq ls nil nab nil a nil a1 nil b1 nil blk nil w nil q nil x nil i nil ls_b2 nil b2 nil b_ls nil)
	(vl-load-com)
	(setq D "1") ;номер изма 1=0 изм. 2=1 изм.
	(setq nab (ssget "_X"  (list (cons 8 "Форматка_штамп") (cons 0 "INSERT")))) ; создали набор из всех форматок
	(setq b (sslength nab))
	(setq i (1- b)); количество в наборе и на чало счетчика переключения
			(setq a (ssname nab i)) ; взяли последний элемент в наборе
		(setq a1 (entnext a)) ; положили в а1 список атрибутов
		(setq b1 (cdr(assoc '2(entget a1)))) ; взяли название атрибута ; создали пустой список
	(repeat b ; перебираем все атрибуты
		(setq a (ssname nab i)) ; взяли последний элемент в наборе
		(setq a1 (entnext a)) ; положили в а1 список атрибутов
		(setq b1 (cdr(assoc '2(entget a1)))) ; взяли название атрибута
			(setq blk (vlax-ename->vla-object a)) ; взяли vla объект в blk
			; w - название видимости (... "последующий лист" ...)
			; q - ширина форматки
			(setq w (cdar (setq q (mapcar '(lambda ( x ) (cons (vla-get-propertyname x) (vlax-get x 'value))) (vlax-invoke blk 'getdynamicblockproperties)))))
			(if (equal w "последующий лист") ; последующий лист?
				(progn ; да - последующий лист
					(repeat 1 ; ШИФР2 стоит 1 в очереди
						(if (equal b1 "ШИФР2")
							(progn (setq b2 (cdr(assoc '1 (entget a1))))) ; в новой переменной лежит шифр             
							(progn (setq a1 (entnext a1)) (setq b1 (cdr(assoc '2(entget a1)))))
						);if
					);конец цикла перебора атрибутов
				  		(setq a (ssname nab i)) ; взяли последний элемент в наборе
						(setq a1 (entnext a)) ; положили в а1 список атрибутов
						(setq b1 (cdr(assoc '2(entget a1)))) ; взяли название атрибута
					(repeat 14 ;шифр 14 в очереди - дополнительно меняем шифр в других видимостях
						(if (equal b1 "ШИФР")
							(progn (setq b1 (subst (cons 1 b2) (assoc '1 (entget a1)) (entget a1)))
							  (entmod b1) (entupd a1)
							  )
							(progn (setq a1 (entnext a1)) (setq b1 (cdr(assoc '2(entget a1)))))
						);if
					);конец цикла перебора атрибутов
				) ; да - последующий лист
				(progn ; нет - это первый или пустой лист
					(repeat 14 ;шифр 1 в очереди
						(if (equal b1 "ШИФР")
							(progn (setq b2 (cdr(assoc '1 (entget a1))))) ; в новой переменной лежит шифр        
							(progn (setq a1 (entnext a1)) (setq b1 (cdr(assoc '2(entget a1)))))
						);if
					);конец цикла перебора атрибутов
				  		(setq a (ssname nab i)) ; взяли последний элемент в наборе
						(setq a1 (entnext a)) ; положили в а1 список атрибутов
						(setq b1 (cdr(assoc '2(entget a1)))) ; взяли название атрибута
					(repeat 1 ;шифр 14 в очереди - дополнительно меняем шифр в других видимостях
						(if (equal b1 "ШИФР2")
							(progn (setq b1 (subst (cons 1 b2) (assoc '1 (entget a1)) (entget a1)))
							  (entmod b1) (entupd a1)
							  )
							(progn (setq a1 (entnext a1)) (setq b1 (cdr(assoc '2(entget a1)))))
						);if
					);конец цикла перебора атрибутов
				) ; нет - это первый или пустой лист
			) ; if (equal w "последующий лист")
			(setq ls_b2 (list b2)) ; создали список из значения атрибута
			;; тут тоже поменять на значени атрибута
			(if (member (cdr(assoc '1(entget a1))) ls) ; есть такой в списке? 
				(progn ;да
					(setq i (1- i)) ; ищем в наборе дальше
				) ;да
				(progn ;нет
				    	(setq ls (append ls_b2 ls));создали набор куда помещаем все из набора
					;(append ls ls_b2) ; добавили в список новый шифр
					(setq i (1- i)) ; ищем в наборе дальше
				) ;нет
			) ; if есть такой в списке?
	) ;repeat b
  (setq b_ls (length ls)) ; взяли количество элементов
  (vl-remove (1- b_ls) ls) ; удалили случайно созданый nil
  (setq b_ls (length ls)) ; обновили количество элементов в списке
  (setq i_b_ls (1- b_ls)) ; переменная перебора шифров- берем последний
  (repeat b_ls ; цикл по количеству доступных шифров на чертеже
    (setq i_ls (nth i_b_ls ls)) ; взяли послдений/следующий шифр в переменную
  	;(setq b_str (strlen i_ls)) ; взяли количество знаков в шифре (строка должна быть)
	;(if (AND (equal "O"  (1- (1- b_str))) (equal "Д" (1- b_str)))
 		(progn ; это лист ОД - создадим набор для него
			;(setq m "1")
			;(setq nnp "1")
			;(setq nnp1 (strcat "1" "." "m"))
			(setq nab_x (ssadd)); создать пустой набор
			(setq b (sslength nab)) ; всего в наборе = b
			(setq i (1- b)); количество в наборе и на чало счетчика переключения
			(repeat b ; цикл по кол. сущ набора
				(setq a (ssname nab i)) ; взяли последний элемент в наборе
				(setq a1 (entnext a)) ; положили в а1 список атрибутов
				(setq b1 (cdr(assoc '2(entget a1)))) ; взяли название атрибута
				(repeat 1 ; ШИФР2 стоит 1 в очереди  цикла перебора атрибутов
					(if (equal b1 "ШИФР2")
						(progn ; тут условие совпадение шифра списка с шифром из блока
						  	(setq b2 (cdr(assoc '1 (entget a1)))) ; в новой переменной лежит шифр             
						  	(if (equal i_ls b2); если шифр = шафру из списка
   								(progn 
									(ssadd a nab_x)
									(ssdel a nab) ; удалили из общего набора - ускоряем работу
								)	 ; да - то его в набор
						 	) ; if; если шифр = шафру из списка
						) ; progn тут условие совпадение шифра списка с шифром из блока           
						(progn (setq a1 (entnext a1)) (setq b1 (cdr(assoc '2(entget a1))))) ; если не шифр2 то ищем его дальше- не должен пригодиться
					);if
				);конец цикла перебора атрибутов
						(progn
							(if (equal i 0) ; берем следующий эемент
								(progn (setq i (1- b)))
								(progn (setq i (1- i)))
							);if
						)
     		) ; repeat b ; цикл по кол. сущ набора
    ; \\\\\\\\\\\\\\\\\\\\\найти первый лист в этом наборе
											(setq b_x (sslength nab_x)) ; всего в наборе = b
											(setq i (1- b_x)); количество в наборе и на чало счетчика переключения
											(setq a (ssname nab_x i));взяли примитив из полного набора (взяли последний примитив)
											(setq X1 (fix(cadr(assoc '10 (entget a))))) ;Y координата выбранного блока
											(setq Y1 (fix(caddr(assoc '10 (entget a))))) ;X координата выбранного блока
											(repeat b_x
												(setq a1 (ssname nab_x i));взяли следующий примитив из полного набора (взяли ПРЕДпоследний примитив)
												(setq X2 (fix(cadr(assoc '10 (entget a1))))) ;Y координата выбранного блока
												(setq Y2 (fix(caddr(assoc '10 (entget a1))))) ;X координата выбранного блока
													(if (and (<= X2 X1) (>= Y2 Y1)) ; ищем самый первый
																(progn ;если стоит раньше то...
																	(setq a a1)
																	(setq X1 X2 Y1 Y2) ;сохраняем его координаты
																  	(if (equal i 0) ; если конеец набора
																		(progn (setq i (1- b_x))) ; начинаем заного
																		(progn (setq i (1- i))) ; продолжаем, если не конец набора
																	);if ; если конеец набора взять след элемент
																) ;progn ;если стоит раньше то...
																(progn ;если не первый
																	(if (equal i 0) ; если конеец набора
																		(progn (setq i (1- b_x))) ; начинаем заного
																		(progn (setq i (1- i))) ; продолжаем, если не конец набора
																	);if ; если конеец набора взять след элемент
																)
													) ;(if (and (< X2 X1) (> Y2 Y1)) ; ищем самый первый
											) ; repeat b_x
	; \\\\\\\\\\\\\\\\\\\\\найти первый лист в этом наборе
; автоматическая нумерация v_07.05.2015
; считает любое количество строк
; считает любое количество листов в строке
; изменения для дргугой программы: nab на nab_x и по мелочи
;(defun zxc ( / a b X1 X2 Y1 Y2 w b1 a2 nnp i nab_x nab_N b2 v w X Y q D x a4)
(progn
  ;(setq a nil b nil X1 nil X2 nil Y1 nil Y2 nil w nil b1 nil b2 nil a2 nil a1 nil nnp nil i nil nab_x nil nab_N nil X nil Y nil i nil ii nil)
	(progn
	(vl-load-com)
	(ssdel a nab_x);удалили из набора выбранный блок- от него пляшет отсчет
	(setq b (sslength nab_x) i b); получаем кол набора и кладем в переменную i
	(setq nnp 1); обнуляем счетчик = значение первого листа
	)
;////////////////тут присвоить номер выбранному листу//////////////
		(progn
		(setq a2 (entnext a))
		(setq s1 a)
		(if (equal b 0)
			(progn ; один лист
				(repeat 7 ;кол атрибутов ЛИСТОВ на 6 месте
					(if (equal b1 "ЛИСТОВ")
						(progn 
							(setq b1 (subst (cons 1 (itoa (1+ b))) (assoc '1 (entget a2)) (entget a2)))
							(entmod b1);изменить примитив
							(entupd a2);перерисовать примитив
						)             
						(progn
							(setq a2 (entnext a2))
							(setq b1 (cdr(assoc '2(entget a2))))
						)
					);if
				);конец цикла перебора атрибутов
				(setq a2 (entnext a))
				(repeat 7 ;кол атрибутов ЛИСТ на 6 месте
					(if (equal b1 "ЛИСТ")
						(progn 
							(setq b1 (subst (cons 1 "") (assoc '1 (entget a2)) (entget a2)))
							(entmod b1);изменить примитив
							(entupd a2);перерисовать примитив
						)             
						(progn
							(setq a2 (entnext a2))
							(setq b1 (cdr(assoc '2(entget a2))))
						)
					);if
				) ; цикл перебора атрибутов
				(zng) ; транслит
			) ; один лист
			(progn ; больше 1 листа
				(repeat 7 ;кол атрибутов ЛИСТОВ на 6 месте
				(if (equal b1 "ЛИСТОВ")
					(progn 
						(setq b1 (subst (cons 1 (itoa (1+ b))) (assoc '1 (entget a2)) (entget a2)))
						(entmod b1);изменить примитив
						(entupd a2);перерисовать примитив
					)             
					(progn
						(setq a2 (entnext a2))
						(setq b1 (cdr(assoc '2(entget a2))))
					)
				);if
				);конец цикла перебора атрибутов
				(setq a2 (entnext a))
				(repeat 7 ;кол атрибутов ЛИСТ на 6 месте
				(if (equal b1 "ЛИСТ")
					(progn 
						(setq b1 (subst (cons 1 (itoa nnp)) (assoc '1 (entget a2)) (entget a2)))
						(entmod b1);изменить примитив
						(entupd a2);перерисовать примитив
					)             
					(progn
						(setq a2 (entnext a2))
						(setq b1 (cdr(assoc '2(entget a2))))
					)
				);if
				) ; цикл перебора атрибутов
				(zng) ; транслит
			) ; больше 1 листа
		) ; (equal b 1)
					(setq ip (sslength nab_x)); передаем колличество -> новой переменной
			(setq i (1- ip));т.к. начало с нуля, то делаем на 1 меньше. берем последний элемент учитывай 0
					);если первый лист
;////////////////тут присвоить номер выбранному листу/////////////////
	(while nab_x ;пока набор существует
	(setq b (sslength nab_x)); получаем кол набора и кладем в переменную i
		(if (equal 0 b) ; набор =0
			(progn (setq nab_x nil)) ; если набор 0
	
		(progn
			(setq a1 (ssname nab_x i));взяли примитив из полного набора (взяли последний примитив)
			(setq s1 a1)
			(setq X2 (fix(cadr(assoc '10 (entget a1))))) ;Y координата выбранного блока
			(setq Y2 (fix(caddr(assoc '10 (entget a1))))) ;X координата выбранного блока
			(setq a4 a1);для получения дополнительной информации примитива
			(setq a1 (entnext a1)) ;тут уже атрибут сидит первого примитива
				(setq blk (vlax-ename->vla-object a4))
				(setq w (cdar (setq q (mapcar '(lambda ( x ) (cons (vla-get-propertyname x) (vlax-get x 'value))) (vlax-invoke blk 'getdynamicblockproperties)))))
			(setq b1 (cdr(assoc '2(entget a1))))
		  	(setq Y (- Y2 Y1) X (- X2 X1))
		  	(setq D (+ 12 (cdr (assoc '"Расстояние1" q))))
			;);убрать
				(if (and (equal Y -12 5) (equal X D 5)) ;and
	(progn ;если лист в строкеи все хорошо
					 (setq nnp (1+ nnp));если лист стоит в правильной очереди, то ему присваивается значение +1
						(repeat 14 ;лист2 13 в очереди
							(if (equal b1 "ЛИСТ2")
								(progn 
									(setq b1 (subst (cons 1 (itoa nnp)) (assoc '1 (entget a1)) (entget a1)))
									(entmod b1);изменить примитив
									(entupd a1);перерисовать примитив
								)             
								(progn
									(setq a1 (entnext a1))
									(setq b1 (cdr(assoc '2(entget a1))))
									;(setq tip (cdr(assoc '0(entget a1))))
								)
							);if
						);конец цикла перебора атрибутов
						(zng) ; транслит
					(setq a1 (ssname nab_x i))
					(ssdel a1 nab_x);удалили из набора отработанный выбранный блок
					(setq X1 X2 Y1 Y2); что бы всю строку пронумеровать пересваиваем значения дальше; освободили вторые координаты путем присвоения их первым
					(setq b (sslength nab_x)); новое количество набора - на 1 стало меньше
					(if (equal b 0) ; главный набор закончился?
						(progn ; да- переключаемся на другой набор, если существует
							(if (not nab_N) ; существует набор?
								(progn (setq nab_x nil)) ; нет - удаляем главный набор и выходим из цикла
								(progn ; да - переключаемся на другой набор, если существует 1) главный набор закончился 2) присваием главному набору меньший и удаляем меньший набор
				;;; вместо переприсваивания надо переложить все снова в той же последовательности										
							    (setq b2 (sslength nab_N))
							    (setq i (1- b2))
							    (setq nab_x (ssadd))
							    (repeat b2
							      (setq a4 (ssname nab_N i))
							      (ssadd a4 nab_x)
							      (setq i (1- i))
							      ); repeat b		    													
											;(setq nab_x nab_N) ; обновили главлный набор
											(setq b (sslength nab_x)) ; новое количество набора
											(setq i (1- b)) ; берем элемент из набора
											(setq nab_N nil b2 nil) ; удаляем меньший (ненужный) набор
									;тут поиск первого в новом наборе
											(progn 
											(setq a2 (ssname nab_x i));взяли примитив из полного набора (взяли последний примитив)
											(setq s1 a2)
											(setq X1 (fix(cadr(assoc '10 (entget a2))))) ;Y координата выбранного блока
											(setq Y1 (fix(caddr(assoc '10 (entget a2))))) ;X координата выбранного блока
											(setq v b)
											(setq a2 (entnext a2))
											(setq b1 (cdr(assoc '2(entget a2))))
											(repeat b ; цикл по остаткам (ищем первый лист)
												(if (equal v 1)
														(progn
															(setq X1 X2 Y1 Y2)
															(setq nnp (1+ nnp));если лист стоит в правильной очереди, то ему присваивается значение +1
															(repeat 14 ;лист2 13 в очереди
																(if (equal b1 "ЛИСТ2")
																	(progn 
																		(setq b1 (subst (cons 1 (itoa nnp)) (assoc '1 (entget a2)) (entget a2)))
																		(entmod b1);изменить примитив
																		(entupd a2);перерисовать примитив
																	)             
																	(progn
																		(setq a2 (entnext a2))
																		(setq b1 (cdr(assoc '2(entget a2))))
																		;(setq tip (cdr(assoc '0(entget a2))))
																	)
																);if
															);конец цикла перебора атрибутов
															(zng) ; транслит
															(if (not nab_N) ; существует набор?
																(progn (setq nab_x nil)) ; нет - удаляем главный набор и выходим из цикла
																(progn ; да - переключаемся на другой набор, если существует 1) главный набор закончился 2) присваием главному набору меньший и удаляем меньший набор
																;;; вместо переприсваивания надо переложить все снова в той же последовательности										
																	(setq b2 (sslength nab_N))
							   										(setq i (1- b2))
							    										(setq nab_x (ssadd))
							   										(repeat b2
							    											(setq a4 (ssname nab_N i))
							      											(ssadd a4 nab_x)
							      											(setq i (1- i))
							     										); repeat b
							    									) ;; да - переключаемся
															  ) ;(not nab_N) ; существует набор?
														)
												  ) ; if (equal bv 1)
														(progn
															(setq a1 (ssname nab_x i));взяли следующий примитив из полного набора (взяли последний примитив)
															(setq s1 a1)
															(setq X2 (fix(cadr(assoc '10 (entget a1))))) ;Y координата выбранного блока
															(setq Y2 (fix(caddr(assoc '10 (entget a1))))) ;X координата выбранного блока
															(if (and (< X2 X1) (> Y2 Y1)) ; ищем самый первый
																(progn ;если стоит раньше то...
																	(setq a2 a1 iii i)
																	(setq X1 X2 Y1 Y2) ;сохраняем его координаты
																	(if (equal i 0) ; если конеец набора
																		(progn
																		  (setq a1 (ssname nab_x iii))
																		  ;(entget a1)
																		        (setq a1 (entnext a1))
																		  ;(entget a1)
																		        (setq b1 (cdr(assoc '2(entget a1))))
																			(setq nnp (1+ nnp));если лист стоит в правильной очереди, то ему присваивается значение +1
																				(repeat 14 ;лист2 13 в очереди
																					(if (equal b1 "ЛИСТ2")
																						(progn 
																							(setq b1 (subst (cons 1 (itoa nnp)) (assoc '1 (entget a1)) (entget a1)))
																							(entmod b1);изменить примитив
																							(entupd a1);перерисовать примитив
																						)             
																						(progn
																							(setq a1 (entnext a1))
																							(setq b1 (cdr(assoc '2(entget a1))))
																							;(setq tip (cdr(assoc '0(entget a1))))
																						)
																					);if
																				);конец цикла перебора атрибутов
																				(zng) ; транслит
																			(setq a1 (ssname nab_x iii))
																			(ssdel a1 nab_x)
																		  	(setq X1 X2 Y1 Y2)
																			(setq b (sslength nab_x))
																			(setq i 0)
																		 	(setq i (1- b)) ;начали с начала
																		) ; начинаем заного
																		(progn (setq i (1- i))) ; продолжаем, если не конец набора
																	);if ; если конеец набора взять след элемент
																) ;progn ;если стоит раньше то...
																(progn ;если не первый
																	(setq b (sslength nab_x))
																	(if (equal i 0) ; если конеец набора
																		(progn (setq i (1- b))) ; начинаем заного
																		(progn (setq i (1- i))) ; продолжаем, если не конец набора
																	);if ; если конеец набора взять след элемент
																)
															) ; if (> X1 X2)
														) ; progn - больше 1 в наборе
													) ;; цикл по остаткам (ищем первый лист)
											);progn
	;тут поиск первого в новом наборе
								);progn
							)
						);progn  да- переключаемся на другой набор, если существует
						(progn ; нет -главный набор не закончислся
							(setq b (sslength nab_x))
							(if (equal i 0) ; в начале набора? (этот элемен уже обработаный)
								(progn (setq i (1- b))) ; да - начинаем перебирать элементы с начала
								(progn (setq i (1- i))) ; нет - продолжаем перебирать элементы
							)
						);progn  нет -главный набор не закончислся
					) ;if (equal b 0) ; главный набор закончился?
	); ;если лист в строкеи все хорошо
				(progn ; проверяем в какой строке
	  				(if (< 300 (fix (- Y1 Y2))) ; в другой строке?
						(progn ; да - перемещаем в другой набор
							;(setq X1_N X2 Y1_N Y2)
							(setq a1 (ssname nab_x i));взяли примитив из полного набора (взяли последний примитив)
						  	(if (null nab_N)
								(progn	(setq nab_N (ssadd))
									(ssadd a1 nab_N))
								(progn	(ssadd a1 nab_N))
							)
						        (ssdel a1 nab_x)
						 	(setq b (sslength nab_x))
							(setq b2 (sslength nab_N))
							(if (equal b 0) ; главный набор закончился?
								(progn ; да- переключаемся на другой набор, если существует
;;; тут надо набор перевернуть nab_N	  
										(progn ; да - 1) главный набор закончился 2) присваием главному набору меньший и удаляем меньший набор							
;;;простое обновление заменяем на условие переворота
										  (if (> b2 1) ; проверяем набор больше одного- тогда можно проверить его на переворот
										  (progn ; условие переворота
										    (setq b3 (sslength nab_N)) ; взяли количество набора который надо перевернуть или нет
										    (setq a4 (ssname nab_N (1- b3)));взяли примитив из полного набора (взяли последний примитив)
											(setq X1_N (fix(cadr(assoc '10 (entget a4))))) ;Y координата выбранного блока
											(setq Y1_N (fix(caddr(assoc '10 (entget a4))))) ;X координата выбранного блока
										    (setq a5 (ssname nab_N (1- (1- b3))));взяли примитив из полного набора (взяли последний примитив)
											(setq X2_N (fix(cadr(assoc '10 (entget a5))))) ;Y координата выбранного блока
											(setq Y2_N (fix(caddr(assoc '10 (entget a5))))) ;X координата выбранного блока
										  (if (and (> X2_N X1_N) (< Y2_N Y1_N))
										     (progn ; переворачиваем
							   				(setq b2 (sslength nab_N))
							   				(setq i (1- b3))
							   				(setq nab_x (ssadd))
							   				(repeat b2
							      					(setq a4 (ssname nab_N i))
							      					(ssadd a4 nab_x)
							      					(setq i (1- i))
							      				); repeat b2
										      )
										     (progn ; не переворачиваем
										       (setq nab_x nab_N)
										      )
										   )
										  ) ; progn условие переворота
										    (progn ; нет смысла переворачивать
										      (setq nab_x nab_N)
										      )
										    ) ; if (> b2 1)

										  
											(setq b (sslength nab_x)) ; новое количество набора
											(setq i (1- b)) ; берем элемент из набора
											(setq nab_N nil b2 nil) ; удаляем меньший (ненужный) набор
									;тут поиск первого в новом наборе
											(progn 
											(setq a2 (ssname nab_x i));взяли примитив из полного набора (взяли последний примитив)
											(setq s1 a2)
											(setq X1 (fix(cadr(assoc '10 (entget a2))))) ;Y координата выбранного блока
											(setq Y1 (fix(caddr(assoc '10 (entget a2))))) ;X координата выбранного блока
											(setq v b)
											(setq a2 (entnext a2))
											(setq b1 (cdr(assoc '2(entget a2))))
											(repeat b ; цикл по остаткам (ищем первый лист)
												(if (equal v 1)
														(progn
															(setq X1 X2 Y1 Y2)
															(setq nnp (1+ nnp));если лист стоит в правильной очереди, то ему присваивается значение +1
															(repeat 14 ;лист2 13 в очереди
																(if (equal b1 "ЛИСТ2")
																	(progn 
																		(setq b1 (subst (cons 1 (itoa nnp)) (assoc '1 (entget a2)) (entget a2)))
																		(entmod b1);изменить примитив
																		(entupd a2);перерисовать примитив
																	)             
																	(progn
																		(setq a2 (entnext a2))
																		(setq b1 (cdr(assoc '2(entget a2))))
																		;(setq tip (cdr(assoc '0(entget a2))))
																	)
																);if
															);конец цикла перебора атрибутов
															(zng) ; транслит
															(if (not nab_N) ; существует набор?
																(progn (setq nab_x nil)) ; нет - удаляем главный набор и выходим из цикла
																(progn ; да - переключаемся на другой набор, если существует 1) главный набор закончился 2) присваием главному набору меньший и удаляем меньший набор
																  (setq nab_x nab_N)
							    									) ;; да - переключаемся
															); (not nab_N) ; существует набор?
														)
;;;												  ) ; if (equal bv 1)
														(progn
															(setq a1 (ssname nab_x i));взяли следующий примитив из полного набора (взяли последний примитив)
															(setq s1 a1)
															(setq X2 (fix(cadr(assoc '10 (entget a1))))) ;Y координата выбранного блока
															(setq Y2 (fix(caddr(assoc '10 (entget a1))))) ;X координата выбранного блока
															(if (and (< X2 X1) (> Y2 Y1)) ; ищем самый первый
																(progn ;если стоит раньше то...
																	(setq a2 a1 iii i)
																	(setq X1 X2 Y1 Y2) ;сохраняем его координаты
																	(if (equal i 0) ; если конеец набора
																		(progn
																		  (setq a1 (ssname nab_x iii))
																		  ;(entget a1)
																		        (setq a1 (entnext a1))
																		  ;(entget a1)
																		        (setq b1 (cdr(assoc '2(entget a1))))
																			(setq nnp (1+ nnp));если лист стоит в правильной очереди, то ему присваивается значение +1
																				(repeat 14 ;лист2 13 в очереди
																					(if (equal b1 "ЛИСТ2")
																						(progn 
																							(setq b1 (subst (cons 1 (itoa nnp)) (assoc '1 (entget a1)) (entget a1)))
																							(entmod b1);изменить примитив
																							(entupd a1);перерисовать примитив
																						)             
																						(progn
																							(setq a1 (entnext a1))
																							(setq b1 (cdr(assoc '2(entget a1))))
																							;(setq tip (cdr(assoc '0(entget a1))))
																						)
																					);if
																				);конец цикла перебора атрибутов
																				(zng) ; транслит
																			(setq a1 (ssname nab_x iii))
																			(ssdel a1 nab_x)
																		  	(setq X1 X2 Y1 Y2)
																			(setq b (sslength nab_x))
																		 	(setq i (1- b)) ;начали с начала
																		) ; начинаем заного
																		(progn (setq i (1- i))) ; продолжаем, если не конец набора
																	);if ; если конеец набора взять след элемент
																) ;progn ;если стоит раньше то...
																(progn ;если не первый
																	(setq b (sslength nab_x))
																	(if (equal i 0) ; если конеец набора
																		(progn (setq i (1- b))) ; начинаем заного
																		(progn (setq i (1- i))) ; продолжаем, если не конец набора
																	);if ; если конеец набора взять след элемент
																)
															) ; if (> X1 X2)
														) ; progn - больше 1 в наборе
												  ) ; if (equal bv 1) поставили сюды
													) ;; цикл по остаткам (ищем первый лист)
											);progn
										)
									;)
								);progn
								(progn ; нет -главный набор не закончислся
									(setq b (sslength nab_x))
									(if (equal i 0) ; в начале набора? (этот элемен уже обработаный)
										(progn (setq i (1- b))) ; да - начинаем перебирать элементы с начала
										(progn (setq i (1- i))) ; нет - продолжаем перебирать элементы
									)
								);progn
							)
						)
						(progn ; нет- просто берем следующий элемент
						 	(setq b (sslength nab_x))
  							(if (equal i 0) ; берем следующий эемент
								(progn (setq i (1- b)))
								(progn (setq i (1- i)))
							);if
 						)
					  )
					);progn если лист не в строке
				);if
		);progn
		) ; (equal 0 b) ; набор =0
	);repeat b
);defun c: zxc
;;;	\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\zxc ; пронумеровали
   ; транслит воткнуть в нумерацию параллельно (это долго)
    	) ; progn ; это лист ОД - создадим набор для него
    (setq i_b_ls (1- i_b_ls)) ; следующий шифр
	) ; repeat b_ls ; цикл по количеству доступных шифров на чертеже
(defun zng ( / trans-from-en-to-rus)
   (vl-load-com)
  ////////////// ////////////// ////////////// ////////////// ////////////// ////////////// //////////////;функция транслита начало
 (defun trans-from-en-to-rus (str / translit)
;;;  по мотивам http://www.caduser.ru/cgi-bin/f1/board.cgi?t=28488Sx
;;;  name - исходная строка 
;;;  возвращается преобразованная 
  (setq	dict
	  	 '(("А" "A")("Б" "B")("В" "V")("Г" "G")("Д" "D")
	   ("Е" "E")("Ж" "ZN")("З" "Z")("И" "I")
	   ("К" "K")("Л" "L")("М" "M")("Н" "N")
	   ("О" "O")("П" "P")("Р" "R")("С" "S")("Т" "T")
	   ("У" "U")("Ф" "F")("Х" "KH")("Ц" "TS")("Ч" "CH")
	   ("Ш" "SH")("Щ" "SHCH")("Ы" "Y")("Э" "E")("Ю" "YU")("Я" "YA")
	   ("/" "_")("." "_")
	  )
  )
  (apply 'strcat
	 (mapcar '(lambda (x / sym)
		    (if	(setq sym (assoc x dict))
		      (cadr sym)
		      x
		    ) ;_ конец if 
		  ) ;_ конец lambda 
		 (mapcar 'chr (vl-string->list str))
	 ) ;_ конец mapcar 
  ) ;_ конец apply
  ;(trans-from-en-to-rus zna)
)
  ////////////// ////////////// ////////////// ////////////// ////////////// ////////////// //////////////;функция транслита конец
(progn 
;(setq s1 (car(entsel "\n ВЫБЕРИТЕ блок \n: ")))
(setq Obj (vlax-ename->vla-object s1))
(setq zna (cdr(car(cdr(cddddr(cddddr(cddddr(mapcar '(lambda (Att) (cons (vla-get-TagString Att) (vla-get-TextString Att))) (vlax-invoke Obj 'GetAttributes)))))))))
 (setq ppn (strcat(trans-from-en-to-rus zna) "-revC0" D "-F0" nnp ".dwg")); где D изм nnp номер листа
 ;(setq nnp1 (atoi nnp))
 
  ////////////// ////////////// ////////////// ////////////// ////////////// ////////////// //////////////  //////////////;функция транслита замены значения атрибута начало
(setq s1 (entnext s1))
(setq b1 (cdr(assoc '2 (entget s1)))) 
(setq tip (cdr(assoc '0 (entget s1))))
(while b1 
  (if (or (equal tip "ATTDEF")(equal tip "ATTRIB"))
     (progn 
		 (if (equal b1 "ТРАНСЛИТ") (progn 
         (setq b1 (subst (cons 1 ppn) (assoc '1 (entget s1)) (entget s1)))
         (entmod b1)(entupd s1)
         (setq zna (cdr(assoc '1 (entget s1)))) ;значение примитива
     ))
    (setq s1 (entnext s1))
    (if s1 (progn 
          (setq tip (cdr(assoc '0 (entget s1)))) ;тип примитива
         ;(princ "tip =")(princ tip)(terpri)
          (setq b1 (cdr(assoc '2 (entget s1)))) ;имя примитива
          (setq zna (cdr(assoc '1 (entget s1)))) ;значение примитива
          (if (equal tip "SEQEND")(progn (textscr)
            (setq s1 
            (car(entsel "\n ВЫБЕРИТЕ новый блок\n: "))); после отработки изменения = просим выбрать новый блок - заменить на просмотр всех блоков
             ;(textscr)
              (if s1 (progn 
                   (setq s1 (entnext s1))
                   (setq tip (cdr(assoc '0 (entget s1)))) ;тип примитива
                   (setq b1 (cdr(assoc '2 (entget s1)))) ;тип примитива
                   (setq zna (cdr(assoc '1 (entget s1))));значение примитива
              ))
          ))
    ))
     (if (not s1)(progn (setq s1 nil b1 nil))) 
  ))    ;условие нахождения атрибута
)       ;цикл
)
 ////////////// ////////////// ////////////// ////////////// ////////////// ////////////// ////////////// //////////////;функция транслита замены значения атрибута конец
)
) ;defun c:asd

В 7-ми местах есть / (zng) ; транслит / тут мне надо выполнить функцию транслита шифра
При том, что ее можно вкл или выкл при помощи toggle. Внятного(очень простого) примера не нашел для себя.
Прошу дать lisp с одним toggle.

PS
в моем лиспе есть ошибки (zng "прикручен" неправильно)- пока не исправил

PPS
Прошу не судить за мой lisp- я только учусь ))) (ну работает же !!!)

[VVA]

Сообщение от tujn08 Прошу дать lisp с одним toggle.

Здесь найдешь примеры с кодом dcl и lisp для всех элементов диалоговых окон