[PaSokaS]

Написать программу, которая считала бы, скока на чертеже есть линий одинаковой длины и перекинула бы их в слой, выбранный пользователем.
Прошу откликнутся всех, кто смог бы помоч в написании программы...
ЗЫ зарание благодарю :roll:

[vx]

Fantomas: задачки "шизик" пусть придумывает :)
просто на подсказку хватит 2 мин вместо 20-и на полный код, что я и имел в виду, говоря про неизвестные.

[{Smirnoff}]

Код:

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

Fantomas: задачки "шизик" пусть придумывает :)

Я вижу что тут собралась тёплая студенческая компания У всех преподаватель один и тот же "шизик". Однако не хорошо так с педагогом. Как говорится - не стеляйте в пианиста он как может так и играет.

А код мне писать легче чем объяснять. Потом потребуют дополнительных объяснений и времени всё равно уйдет больше. Да и не преподаватель я...

[PaSokaS]

ого какие дискусии
Сам я из Литвы( Баслийской Государство)
Препод Дура
Аутокад два полугодия
неслишкой сложно там?))
а то я малость зеленый зеленый...
ну контуры нарисовать еще нарисовать пол беды
а такое... мда...
Fantomas може дашь малость литературы имено по тем циклам и командам которые использовал а програме
Огромное Человеческое пасибо
(а учюсь я на компьютерного инжинера )

[{Smirnoff}]

Из литературы на русском могу посоветовать только "Visual LISP и секреты адаптации AutoCAD" Н. Н. Полещук. Эту книгу удобно использовать как справочник. В разделе Download этого сайта есть еще две три книжки на английском. В принципе могу и сам объяснить поподробнее, только не сегодня, может завтра или послезавтра. Сегодня спать хочется...

[vx]

Fantomas: вот и объяснять придется.. :)

PaSokaS: согласен, задачки не для первокурсников. может огласите весь список.. ? ;)
так можно будет собрать на dwg.ru свое учебное пособие по лиспу. с кодами..

[PaSokaS]

Fantomas
да мне еще неделю как делать эту программу
если обьяснишь, буду очень благодарен

[{Smirnoff}]

>PaSokaS
Хорошо. На выходных найду для этого немного времени.

[{Smirnoff}]

Привет. Я немного переписал функцию чтобы тебе было понятнее и постараюсь все (в меру моих способностей) тебе объяснить.

Код:

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

(defun c:demo (/
	       lSet	; набор всех линий чертежа
	       asList	; список формата ((примитив длинна)(примтитв длинна))
	       i	; счетчик примитивов в наборе
	       curLn	; текущий примитив обрабатываемый в цикле REPEAT
	       lnDxf	; список DXF-кодов прмитива
	       lnLen	; длинна примитива
	       )
  (if
    (setq lSet(ssget "_X" '((0 . "LINE"))))
    (progn
      (setq asList '()
	    i 0
	    ); end setq
      (repeat(sslength lSet)
	(setq curLn(ssname lSet i)
	      lnDxf(entget curLn)
	      lnLen(distance
             		(cdr(assoc 10 lnDxf))
             		(cdr(assoc 11 lnDxf))
             		); end distance
	      lnLen(distof(rtos lnLen 2 4))
	      asList(append asList(list
				    (list
				    (cdr(assoc -1 lnDxf))
				    lnLen
				    ); ens list
				    ); end list
			    ); end append
	      i(1+ i)
	      ); end setq
	); end repeat
      (setq asList(mapcar 'car
          (vl-remove-if-not
            '(lambda(x)(member(cadr x)
         (mapcar 'cadr(vl-remove x asList))))
              asList))
          ); end setq
      (if asList
	(progn
      (if(not(tblsearch "LAYER" "Equal Length Lines"))
   (command "-layer" "_n"  "Equal Length Lines"
       "_c" "Yellow" "Equal Length Lines" "")
   ); end if
      (foreach line asList
   (entmod
     (subst
       (cons 8 "Equal Length Lines")
        (assoc 8(entget line))(entget line)))
   ); end foreach
      (princ(strcat "\n*** "(itoa(length asList))
          " moved to layer 'Equal Length Lines' ***"))
      ); end progn
	(princ "\n*** There are not equal lines ***")
	); end if
       ); end progn
    (princ "\n*** There are not lines ***")
      ); end if

[{Smirnoff}]

1) Для начала нужно создать набор из всех линий чертежа и проверить что он создан. Если набор создан то исполняется последующий код, а если нет то выдается сообщение *** There are not lines *** .

Код:

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

  (if
    (setq lSet(ssget "_X" '((0 . "LINE"))))

В данном случае аргумент "_X" означает что набор создается из всех примитивов чертежа, а список '((0 . "LINE")) является фильтром который позволяет выбрать только линии. Функция SSGET имеет может иметь множество различных аргументов и фильтры тоже можно делать очень ложные. Об этом прочитай в Help.
2)

Код:

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

      (setq asList '()
	    i 0
	    ); end setq

Сдесь мы создаем пустой список, в который потом будем добавлять данные типа (примитив длинна) и присваеваем начальное значение счетчику примитивов.
3) Нашей задачей является получение списка типа ((примитив длинна)((примитив длинна)...). Для этого нам необходимо обработать все примитивы входящие в набор в цикле. Количество повторов определяется длинной набора:

Код:

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

(repeat(sslength lSet)

Сначала извлекаем из набора примитив с порядковым номером по щетчику i:

Код:

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

(setq curLn(ssname lSet i)

Затем получаем список его DXF-кодов:

Код:

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

lnDxf(entget curLn)

После этого вычисляем длинну линии с помощью функции DISTANCE:

Код:

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

lnLen(distance
             		(cdr(assoc 10 lnDxf))
             		(cdr(assoc 11 lnDxf))
             		); end distance

Координаты точек начала и конца линии извлекаются из списка DXF- кодов из 10-го и 11-го подсписка.

Следующая строчка:

Код:

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

lnLen(distof(rtos lnLen 2 4))

нужна нам чтобы округлить получаемую динну до 4 знаков после запятой, потому что результат работы функции DISTANCE иногда может отличатся на одну цифру в пятом знаке после запятой (из за аргументов). В принципе в ЛИСПе существует стандартная функция EQUAL которая позволяет производить сравнение с задаваемой точностью. Однако данном случае нам удобнее поступить так.

Теперь мы добавляем в список asList очередной список из номера примитива и его длинны:

Код:

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

	      asList(append asList(list
				    (list
				    (cdr(assoc -1 lnDxf))
				    lnLen
				    ); ens list
				    ); end list
			    ); end append

Наращиваем счетчик:

Код:

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

i(1+ i)

Как я уже говорил цикл будет продолжатся до последнего примитива в наборе.
4)Теперь нам нужно удалить из нашего списка элементы не имеющие "двойников" по длинне и преобразовать его в список примитивов без длинны (примитив примитив ...).

Код:

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

(setq asList(mapcar 'car
          (vl-remove-if-not
            '(lambda(x)(member(cadr x)
              (mapcar 'cadr(vl-remove x asList))))
              asList))
          ); end setq

Выглядит сложновато, но попробую объяснить. ЛИСП отличается от других языков программирования тем что там существуют функции которые применяются сразу ко всем элементам списков. Строчки:

Код:

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

         (vl-remove-if-not
            '(lambda(x)(member(cadr x)
              (mapcar 'cadr(vl-remove x asList))))

на человеческий язык переводятся как "удалить элемент списка если в списке без этого элемента нет такого же элемента". Объяснять более подробно займет слишком много времени. Рекомендую почитать очень хорошие объяснения на сайте www.afralisp.com.

Строка

Код:

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

(mapcar 'car

применённая к списку состоящему из примитивов имеющих "двойников" по длинне преобразует его в список состоящий только из примтивов. К примеру набери в командной строке: (mapcar 'car '((1 2)(3 4)(5 6))) и получишь список (1 3 5). Об этом подробнее тоже лучше почитать на www.afralisp.com.

Так извини,что то я засиделся. Продолжу завтра.

[{Smirnoff}]

Слушай, я сейчас сильно занят. Продолжим завтра или послезавтра.

[PaSokaS]

Fantomas ок ок
я пока с этим попробую разобратся

[{Smirnoff}]

Продолжим.

5)Если линий одинаковой длинны на чертеже не обнаружено то дальнейшее исполнение программы вызовет ошибку. Поэтому проверяем наличие непустого списка одинаковых линий:

Код:

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

(if asList

и либо продолжаем исполнение программы либо выдаем сообщение:

Код:

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

(princ "\n*** There are not equal lines ***")

6)Теперь нам надо проверить наличие слоя в который мы будем переность линии и если его нет создать его:

Код:

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

      (if(not(tblsearch "LAYER" "Equal Length Lines"))
   (command "-layer" "_n"  "Equal Length Lines"
       "_c" "Yellow" "Equal Length Lines" "")
   ); end if

Описание слоёв находится в таблице LAYER, где мы производим поиск с помощью функции TBLSEARCH. И если нужный слой не найден создаем его с помощью функции COMMAND, точно так как это делает пользователь в ручную.

7)Далее следует цикл FOREACH внутри которого мы переносим все примитивы из нашего списка в новый слой "Equal Length Lines":

Код:

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

      (foreach line asList
   (entmod
     (subst
       (cons 8 "Equal Length Lines")
        (assoc 8(entget line))(entget line)))
   ); end foreach

Информация о слое примитива находится в группе 8. Таким образом мы создаем новую DXF-группу - (cons 8 "Equal Length Lines"), меняем её с аналогичной группой в списке DXF-кодов примитива и "перерисовываем" примитив функцией ENTMOD. Это очень стандартный приём описанный в Help и любой книжке по AutoLISP.

8 )Осталось вывести сообщение о количестве линий перенесённых в другой слой:

Код:

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

      (princ(strcat "\n*** "(itoa(length asList))
          " moved to layer 'Equal Length Lines' ***"))

Это количество равно длинне нашего списка вычисляемой функцией LENGTH. Функция ITOA преобразует целое число в строку, а STRCAT- сцепляет строки в одну.

(princ) - в конце программы ставится для того чтобы она не возвращала значения. В отличии от других языков программирования в LISP нет процедур, а есть только функции (т. е. они всегда возвращают значение). (princ) или (prin1) - делают так чтобы функция не возвращала никакого значения.


Ну вот вроде все. Чувствую что не особенно понятно. Преподаватель из меня плохой и мне легче писать код, чем объяснять написанное.

[{Smirnoff}]

И ещё один момент. Мы всё время говорим о DXF-кодах примитива. Однако я заметил что многие имеют о них информацию только по справочнику, достоверно не представляя как это выглядит по настоящему. Набери в командной строке:

Код:

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

(entget(car(entsel)))

И щёлни по любому примитиву, в ответ получишь:

Код:

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

Select object: ((-1 . <Entity name: 7ef54ee8>) (0 . "LINE") (330 . <Entity 
name: 7ef54cf8>) (5 . "95") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . 
"Equal Length Lines") (100 . "AcDbLine") (10 31.9773 19.3718 0.0) (11 36.3509 
8.79621 0.0) (210 0.0 0.0 1.0))

Это к примеру описание линии. Как видишь в группе 10 - начало линии, в группе 11 - конец, в группе 8 - название слоя и т. д. Про остальные коды ты можешь прочитать в Help или другой справочной литературе.

Удачи

[PaSokaS]

ке ке
завтра есть вес день читать и понимать
Fantomas пасиб тебе и удачи в дальнейшем программировании
помогай иногда и нам, зеленым зеленым )))

[{Smirnoff}]

Код:

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

(defun c:demo (/
	       lSet	
	       asList	
	       i	
	       curLn	
	       lnDxf	
	       lnLen	
	       lName
	       )
  (if
    (setq lSet(ssget "_X" '((0 . "LINE"))))
    (progn
      (setq asList '()
	    i 0
	    ); end setq
      (repeat(sslength lSet)
	(setq curLn(ssname lSet i)
	      lnDxf(entget curLn)
	      lnLen(distance
             		(cdr(assoc 10 lnDxf))
             		(cdr(assoc 11 lnDxf))
             		); end distance
	      lnLen(distof(rtos lnLen 2 4))
	      asList(append asList(list
				    (list
				    (cdr(assoc -1 lnDxf))
				    lnLen
				    ); ens list
				    ); end list
			    ); end append
	      i(1+ i)
	      ); end setq
	); end repeat
      (setq asList(mapcar 'car
          (vl-remove-if-not
            '(lambda(x)(member(cadr x)
         (mapcar 'cadr(vl-remove x asList))))
              asList))
          ); end setq
      (if asList
	(progn
; ввести имя слоя
	(setq lName(getstring "\n*** Specify layer name <Equal Length Lines>: "))
; если имя не введено, присвоить слою название Equal Length Lines
	(if(= lName "")(setq lName "Equal Length Lines")); end if
      (if(not(tblsearch "LAYER" lName))
   (command "-layer" "_n"  lName
       "_c" "Yellow" lName "")
   ); end if
      (foreach line asList
   (entmod
     (subst
       (cons 8 lName)
        (assoc 8(entget line))(entget line)))
   ); end foreach
	(setvar "clayer" lName)
      (princ(strcat "\n*** "(itoa(length asList))
          " moved to layer '" lName "' ***"))
      ); end progn
	(princ "\n*** There are not equal lines ***")
	); end if
       ); end progn
    (princ "\n*** There are not lines ***")
      ); end if
    (princ)
    ); end c:demo

[Лентяй]

Labas ritas (vakaras) ponas Pasokas!
Darbo Rusiske.
Я тут пробыл две недели в ссылке в Монтане (это такая американская Сибирь) в отрыве от своего компа с русской клавой, потом не смог принять участия в дискуссии, по каковой причине вношу свой вклад только сейчас. Думаю, что еще не поздно.
Сначала об отличии ActveX от AutoLISP.
Не знаю. учат ли ActveX специально, но писать на ЛИСПе, уже имея ActveX как часть АвтоКАДа, это все равно, что работать в DOS, уже имея установленный WINDOWS. В отличие от AutoLISP, работающего с однородными списками чего попало, ActveX работает с объектами АвтоКАДА, независимо от их природы, напрямую обращаясь к их свойствам.
Все команды, который я использовал, перечислены в HELP файлах, и потому - абсолютно законны даже для судентов. Ниже приводится моя программа с пояснениями типа Fantomas-овских. Единственное отличие - это использование полных выражений
(vlax-get-property obj 'property_name),
вместо сокращенного (vla-get-property_name obj), чтобы сделать вид программы более "учебным".
Итак,

Код:

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

(defun C:LC ( / l lns)
  (setq cmd (getvar "CMDECHO")); - запоминаем значение переменной, управляющей выводом промежуточных результатов в командную стороку
  (setvar "CMDECHO" 0); - запрешаем вывод промежуточных результатов в командную стороку 
  (ssget); - выбираем любым досиупным способом, все что попадает в зону выбора
  (setq acobj (vlax-get-acad-object); (получить_информацию_о_всех_объектах_автокада)
	adoc (vlax-get-property acobj 'ActiveDocument); (vla-получить_информацию_о_свойстве "Активный_Документ") проще говоря - об чертеже, с которым работаем в настоящий момент
	ass (vlax-get-property adoc 'ActiveSelectionSet ); (vla-получить_информацию_о_свойстве "Последний_Набор_Выбранных_Примитивов" чертежа adoc)
	lys (vla-get-Layers adoc); (vla-получить_информацию_о_всех существующих_слоях_
	
  );setq 
  (vlax-for obj ass; (ДЛЯ любого объекта, входящего в список ass
    (if (=
	  (vlax-get-property obj 'ObjectName); (получить_информацию_о_свойстве "Имя_Объекта")
	   "AcDbLine"); Имя объекта "Линия". Проще говоря, если объект - линия, то
		      (setq lns (cons obj lns))); внести этот объект в список линий. В результате отфильтровывается все, что не линия.
    );vlax-for
  (princ (strcat "\n " (itoa; - преобоазовыват число в его текстовое представление
			 (length lns)); - длина списка lns
		 " Lines Selected")); "Выбрано линий"
  (while lns; ПОКА существует список lns
    (setq ln0 (car lns); первая линия в списке lns
	  l (vlax-get-property ln0 'length ); - (получить_информацию_о_свойстве "Длина") линии ln0. И никаких кодов и вычилений!
	  lnm (strcat "Length_"; - Образует имя слоя для линий длиной l "Длина_
		      (rtos l)); - преобразует чило l в его текстовое представление
	  n 0; - обнуляем счетчик
    );setq
    (if (vl-catch-all-error-p; - проверяет, ошибочно ли, что
	  (vl-catch-all-apply '(list lys lnm)); - имя слоя lnm уже входит в список всех слоев lys
	  );- если ошибочно, т.е. имя слоя lnm НЕ входит в список слоев
      (vla-add lys lnm); - дополняет этот список новым именем lnm
      );if
    (foreach ln lns; для каждой линии в списке lns
      (if (=
	    (vlax-get-property ln 'length); (получить_информацию_о_свойстве "Длина") линии ln
	    l); длина, первой линии в спске lns
		      (progn; если длина линии ln равна l, то ваполнит следующие опреации
			(vlax-put-property ln 'layer lnm); - (присвоить_свойству "Слой") линии ln значение lnm
			(setq n (1+ n); - увеличить значение счетчика на 1
			      lns (cdr lns); - укорачивет список линий lns, исключая из него обработанный элемент
			);setq
		      );progn
      );if
    );foreach
    (princ (strcat "\n "(itoa n) " Lines of " (rtos l) " Moved on Layer " lnm)); - вывод сообщения "n линий длиной l перемещено на слой lnm"
  );while - конец цикла. В списке lns больше нет линий линой l. Сам список укоротился на n элементов.
  (setvar "CMDECHO" cmd); Переменной, управляющей выводом промежуточных результатов в командную стороку, присваевается ее прежнее значение.
);end

Полагаю, что разница программ очевидна.

[Лентяй]

Черт, комментарии обрезаются и переносятся на новую строку, затрудняя будущее копирование. Попробую еще раз

Код:

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

(defun C:LC ( / l lns)
  (setq cmd (getvar "CMDECHO"))
;запоминаем значение переменной, управляющей выводом промежуточных результатов в командную стороку
  (setvar "CMDECHO" 0);запрешаем вывод промежуточных результатов в командную стороку 
  (ssget); выбираем любым досиупным способом, все что попадает в зону выбора
  (setq acobj (vlax-get-acad-object);(получить_информацию_о_всех_объектах_автокада)
          adoc (vlax-get-property acobj 'ActiveDocument)
;(получить_информацию_о_свойстве "Активный_Документ") проще говоря - об чертеже, с которым работаем в настоящий момент
          ass (vlax-get-property adoc 'ActiveSelectionSet )
;получить_информацию_о_свойстве "Последний_Набор_Выбранных_Примитивов" чертежа adoc)
          lys (vlax-get-property adoc 'Layers); (получить_информацию_о_свойстве "Список_Имен_ Всех_Слоев" чертежа adoc) 
  );setq 
  (vlax-for obj ass; (ДЛЯ любого объекта, входящего в список ass)
    (if (=
            (vlax-get-property obj 'ObjectName); (получить_информацию_о_свойстве "Имя_Объекта")
	"AcDbLine"); Имя объекта "Линия". Проще говоря, если объект - линия, то
	(setq lns (cons obj lns)); внести этот объект в список линий.
;В результате отфильтровывается все, что не линия.
    );if
  );vlax-for
  (princ (strcat "\n " (itoa; - преобоазовыват число в его текстовое представление
                 (length lns)); - длина списка lns
	" Lines Selected")); "Выбрано линий"
  (while lns; ПОКА существует список lns
    (setq ln0 (car lns); первая линия в списке lns
            l (vlax-get-property ln0 'length ); - (получить_информацию_о_свойстве "Длина") линии ln0. 
           lnm (strcat "Length_"; - Образует имя слоя для линий длиной l "Длина_
                   (rtos l)); - преобразует чило l в его текстовое представление
	  n 0; - обнуляем счетчик
    );setq
    (if (vl-catch-all-error-p; - проверяет, ошибочно ли, что
              (vl-catch-all-apply '(list lys lnm)); - имя слоя lnm уже входит в список всех слоев lys
                  );- если ошибочно, т.е. имя слоя lnm НЕ входит в список слоев
                  (vlax-invoke-method lys "Add" lnm)
;применить_метод "Дополнить" к спску lys и внести слой с новым именем lnm
      );if
    (foreach ln lns; для каждой линии в списке lns
      (if (=
                (vlax-get-property ln 'length); (получить_информацию_о_свойстве "Длина") линии ln
	    l); длина, первой линии в спске lns
                (progn; если длина линии ln равна l, то ваполнит следующие опреации
                    (vlax-put-property ln 'layer lnm); - (присвоить_свойству "Слой") линии ln значение lnm
	(setq n (1+ n); - увеличить значение счетчика на 1
	        lns (cdr lns); - укорачивет список линий lns, исключая из него обработанный элемент
	);setq
                );progn
      );if
    );foreach
    (princ (strcat "\n "(itoa n) " Lines of " (rtos l) " Moved on Layer " lnm))
;вывод сообщения "n линий длиной l перемещено на слой lnm"
  );while - конец цикла. В списке lns больше нет линий линой l. Сам список укоротился на n элементов.
  (setvar "CMDECHO" cmd)
;Переменной, управляющей выводом промежуточных результатов в командную стороку, присваевается ее прежнее значение.
);end

Да, главное забыл. Как видно из кода, в качестве имени свойства используется обычно слово, обозначающее это свойство. Правда, на английском языке. Так что одно из условий овладения ActiveX - это знание английского языка. Так что, если вы, Ponas PaSocaS, mokite Angliske, то все будет gerai, и никакой Щизик не будет страшен.

[{Smirnoff}]

>Лентяй

Не знаю. учат ли ActveX специально, но писать на ЛИСПе, уже имея ActveX как часть АвтоКАДа, это все равно, что работать в DOS, уже имея установленный WINDOWS.

Причем здесь DOS и WINDOWS? Изучают то вообще для начала язык LISP. А что использовать для доступа к автокадовским объектам это уже второе дело. Я тоже предпочитаю ActiveX. Но знать только ActiveX и не знать обычный AutoLISP ИМХО - очень плохой стиль.

Кстати у тебя в программе не решена задача как она была поставлена:

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

Вот тут ActiveX уже никак не поможет Не в смысле конечно перекинуть, а в смысле составить список всех линий имеющих "двойников" по длинне...

[{Smirnoff}]

Вот кстати через ActiveX, причем с точным выполнением условия задачи:

Код:

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

(defun c:dem2 (/ lSet asList lCol lName)
  (if
    (setq lSet(ssget "_X" '((0 . "LINE"))))
    (progn
(setq asList(mapcar '(lambda(x)(list x(vla-get-length x)))
               (mapcar 'vlax-ename->vla-object 
                     (vl-remove-if 'listp 
                      (mapcar 'cadr(ssnamex lSet)))))
      
      asList(mapcar 'car
          (vl-remove-if-not
            '(lambda(x)(member(cadr x)
         (mapcar 'cadr(vl-remove x asList))))
              asList))
          ); end setq
      (if asList
	(progn
	(setq lName(getstring "\n*** Specify layer name <Equal Length Lines>: ")
	      lCol(vla-get-Layers(vla-get-ActiveDocument(vlax-get-acad-object)))
		); end setq
	(if(= lName "")(setq lName "Equal Length Lines")); end if
        (if(vl-catch-all-error-p 
            (vl-catch-all-apply 'vla-Add (list lCol lName)))
	  T); end if
	(foreach line asList
	  (vla-put-layer line lName)
	  ); end foreach
	(setvar "clayer" lName)
      (princ(strcat "\n*** "(itoa(length asList))
          " moved to layer '" lName "' ***"))
      ); end progn
	(princ "\n*** There are not equal lines ***")
	); end if
       ); end progn
    (princ "\n*** There are not lines ***")
      ); end if
    (princ)
    ); end c:dem2

[Alaspher]

Код:

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

(defun C:LC (/ acobj adoc ass layrep lnm lys tmp)
;;;  (setq cmd (getvar "CMDECHO"))
;;;  (setvar "CMDECHO" 0)
;;;*PL: Нафига? Откуда-ж им взяться?
;;;  (ssget)
;;;*PL: Странный подход - выбрать всё, а потом фильтровать, когда можно отфильтровать при выборе.
;;;*PL: Например, как это делает Fantomas: (ssget '((0 . "LINE")))
;;;*PL: А коль используем ActiveSelectionSet, то надо использовать... (ниже)
  (setq acobj (vlax-get-acad-object)
        adoc  (vlax-get-property acobj 'ActiveDocument)
        ass   (vlax-get-property adoc 'ActiveSelectionSet)
        lys   (vlax-get-property adoc 'Layers)
  )
  (vla-Clear ass)
  (vla-SelectOnScreen
    ass
    (vlax-safearray-fill (vlax-make-safearray vlax-vbinteger '(0 . 0)) '(0))
    (vlax-safearray-fill (vlax-make-safearray vlax-vbvariant '(0 . 0)) '("LINE"))
  )
  (vlax-for obj ass
;;;    (if (= (vlax-get-property obj 'ObjectName) "AcDbLine")
;;;      (setq lns (cons obj lns))
;;;    )
    (setq lnm    (strcat "Length_" (rtos (vlax-get-property obj 'length)))
          layrep (if (setq tmp (assoc lnm layrep))
                   (subst (cons lnm (1+ (cdr tmp))) tmp layrep)
                   (cons (cons lnm 1) layrep)
                 )
    )
    (if (vl-catch-all-error-p (vl-catch-all-apply '(list lys lnm)))
      (vlax-invoke-method lys "Add" lnm)
    )
    (vlax-put-property obj 'layer lnm)
  )
  (princ (strcat "\n " (itoa (vlax-get-property ass 'count)) " Lines Selected"))
  (foreach i layrep (princ (strcat "\n " (itoa (cdr i)) " Lines moved on layer " (car i))))
;;;  (while lns
;;;    (setq ln0 (car lns)
;;;          l   (vlax-get-property ln0 'length)
;;;          lnm (strcat "Length_" (rtos l))
;;;          n   0
;;;    )
;;;    (if (vl-catch-all-error-p (vl-catch-all-apply '(list lys lnm)))
;;;      (vlax-invoke-method lys "Add" lnm)
;;;    )
;;;    (foreach ln lns
;;;      (if (= (vlax-get-property ln 'length) l)
;;;        (progn (vlax-put-property ln 'layer lnm)
;;;               (setq n   (1+ n)
;;;                     lns (cdr lns)
;;;               )
;;;        )
;;;      )
;;;    )
;;;    (princ (strcat "\n " (itoa n) " Lines of " (rtos l) " Moved on Layer " lnm))
;;;  )
;;;  (setvar "CMDECHO" cmd)
  (princ)
)