[mironov0279]

Добрый день, после последнего обращения на форуме со смешным и глупым кодом посветил выходные изучению языка Lisp по аналогичным скриптам и книге "AutoLISP и Visual LISP в среде AutoCAD" интересная книга для начинающих и не только.
Вопрос программистам по языку -
1. посмотрите пожалуйста скрипт работает через раз, так как опыта у меня не много не могу найти ошибку.
2. может кто подскажет как прописать команду чтоб в конце слой автоматически переименовывался в переменную (setq d (getint "длина: ").

Код:

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

 (defun C:послоям (/) 
	(vl-load-com)
	(setq lst (list "LINE"))
	(progn
		(princ "Выберите область поиска...")(terpri)
		(setq point_1(getpoint "Первая точка: "))(terpri)
		(setq point_2 (getcorner point_1 "Вторая точка: "))(terpri)
		(command "_zoom" point_1 point_2)
	)
	(foreach x lst
	  (setq d (getint "длина:  "))
		(setq i 0 ii 0)
		(setq nab (ssget "_W" point_1 point_2 (list (cons 0 x)))) ; выбор 
		(if nab (setq b_nab (sslength nab)) (setq b_nab 0))
		(repeat b_nab 
			(setq vla_a (vlax-ename->vla-object (ssname nab i)))
			(if (equal "ARC" x)
			  	(setq R (vlax-get vla_a "Radius"))
				(setq L (vlax-get vla_a "Length"))
			)
			(if (or (= L d) (= R d))
				(progn
				  (entmake '((0 . "LAYER") (100 . "AcDbSymbolTableRecord")
					     (100 . "AcDbLayerTableRecord") (2 . "!00") (70 . 4) (62 . 1)))
					(vlax-put-property vla_a 'Layer "!00")
					(setq ii (+ ii 1))
				)
			)
			(setq L 10)
			(setq R 10)
		  	(setq i (+ i 1))
		)
		(alert (strcat "Перенесено: " (itoa ii) " " x " из: " (itoa i)))
	)
)

Заранее спасибо.

[Кулик Алексей aka kpblc]

Ннууууу.... А разве можно задать имя слою с символом "!"? И потом, я как-то не очень понял что вообще код должен делать (читал по диагонали, каюсь).

[mironov0279]

Можно если осторожно , это сделано для того чтоб слой всегда был наверху удобнее переименовать, не надо листать все слои. Что делает : допустим вы армируете плиту в ней у вас около 40 типов длин от 7.5 до 0,2 м и отрезков около 2-3 тыс. вам нужно это все разделить. Вы запускаете скрипт и у вас получается что 7,5 метровые отрезки в кол-ве 800-900 шт находятся на верхнем закрытом слои, вы его переименовываете в 7,5 м, отключаете все остальные слои и работаете с арматурой 7,5 м. Только просьба не говорить что в Ревите или в других макросах делается это быстрее и проще это ложь.

[VVA]

mironov0279, Не понятно что в твоем примере делают дуги (ARC)
Зациклил запрос длин.

Код:

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

 
(defun C:послоям (/ nab lst lay d i ) 
;;; (vl-load-com)
(defun conv-pickset-to-list (value / item lst)
;;;Функция преобразования набора в список
      (repeat (setq item (sslength value)) ;_ end setq
        (setq lst (cons (ssname value (setq item (1- item))) lst))
      ) ;_ end repeat
      lst
    )
(defun Layer (Nme)
;;;Функция создания слоя
  (or
    (tblsearch "LAYER" Nme)
    (entmake (list (cons 0 "LAYER")
                 (cons 100 "AcDbSymbolTableRecord")
                 (cons 100 "AcDbLayerTableRecord")
                 (cons 2 Nme)
                 (cons 70 4) ;_Блокировка слоя
                 (cons 62 1) ;_Цвет
                 )
           )
    )
  (tblsearch "LAYER" Nme)
  )
  (princ "\nВыберите область поиска...")
 (initget 1)(setq pt1(getpoint "\nПервая точка: "))
 (initget 1)(setq pt2 (getcorner pt1 "\nВторая точка: "))
 (command "_zoom" pt1 pt2)
 (if (setq nab (ssget "_W" pt1 pt2 (list (cons 0 "LINE")))) ; выбор
   (progn
     (setq lst (conv-pickset-to-list nab))
     (while (setq d (getdist "\nДлина <выход>:  "))
       (setq i 0 lay (cdr(assoc 2(layer(strcat "!Длина-" (rtos d 2 2))))))
       (foreach line lst
         (if (equal
               (distance
                 (cdr(assoc 10 (entget line))) ;_точка начала отрезка
                 (cdr(assoc 11 (entget line))) ;_точка конца отрезка
                 )
               d
               1e-3 ;_с точностью до тысячных
               )
           (progn
             (setq i (1+ i))
             (entmod(subst (cons 8 lay)(assoc 8 (entget line))(entget line)))
             )
           )
         );_foreach
       (princ "... перенесено ")(princ i)(princ " из ")(princ (length lst))
       );_while
     );_progn
   );_if
(princ) 
)

[mironov0279]

VVA Спасибо большое по поводу дуг (ну я начал изучать Lisp буквально на выходных, первый мой тест вообще был набор букв и цифр (вынудил меня пользователь ===AAA===), за который мне вообще было стыдно . Я переписывал скрипт по удалению малых отрезков и дуг (от туда они и остались ). Еще раз спасибо завтра поразбираюсь с кодом и добавлю подгрузку текстового файла с пересечением длин (их можно взять из таблицы СПДС)

[===AAA===]

Буквально на всякий случай. Как "для вновь изучающего LISP". :-)

Постарайся не использовать слово "скрипт" - это совсем другое.
Это отдельные файлы-сценарии с расширением *.scr

[mironov0279]

===AAA===, Спасибо куда я без ваших мудрых замечаний (не обижайтесь я шучу)

[mainevent100]

стандартная функция "быстрого выбора" не помогает?

[mironov0279]

mainevent100, на 6 тыс объектов и около 80 разных длин ну да наверное помогает но я думаю программирование устроено чтоб облегчить жизнь а не усложнить. Кто еще умнее что нибудь напишет

[Nike]

https://forums.autodesk.com/t5/visua...415318#M377383

[mironov0279]

Nike, Спасибо за ссылку, на досуге почитаю. У меня не настолько большой кругозор по иностранным сайтам (тем более этот скрипт "еще раз спасибо VVA " мне нравится больше).
Сории как же я забыл специалиста из Норильска извини дорогой, я все таки буду называть скрипт.
P.S. ===AAA=== должен понимать почему я такое внимание обращаю этому специалисту (на прошлом заблокированном Админом вопросе все понятно, почитал я ваши прошлые сообщения вам случайно не 15 лет? амбал-16)