[PaSokaS]

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

[bdfy]

может все линии _одной_ заданной длинны ? или разных длинн может быть несколько ?

[Vova]

Это легко делается вручную. Выбери командой Qselect все линии заданой длины и поменяй им слой командой Properties либо через выпадающий список слоев

[PaSokaS]

Vova ты че невидешь ?
программа нужна..

[PaSokaS]

bdfy
Линии разных длин и уже нарисованны( може быть несколько одной длины и другой). Программа напишет скока и какой длинны линии на рисунку и одинаковый по длине перекинет в слой, выбраный пользователем %)

[Perezz!!]

PaSokaS -> А за пивом программа не должна сходить, охладить его и подать тебе в бокале? :wink:

[PaSokaS]

Perezz!!
ну че сделаешь
я сишь уточнил...
блин.. как все заканало
кстате если кому надо могу 6-значку нодогнать
уже не тока спасибо )

[{Smirnoff}]

Чего студент, опять двойка?

Код:

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

(defun c:demo (/ asList)
  (if
    (and
      (setq asList(ssget "_X" '((0 . "LINE"))))
      (setq asList(vl-remove-if 'listp
                     (mapcar 'cadr(ssnamex asList))))
       (setq asList
	     (vl-sort
	       (mapcar
	       '(lambda(x)(list x
			   (distof(rtos(distance
			    (cdr(assoc 10(entget x)))
			    (cdr(assoc 11(entget x)))
			    ); end distance
			    2 4); end rtos
			    ); end distof
			   ); end list
		          ); end lambda
	             asList
	          ); end mapcar
	       '(lambda (x1 x2)(<(cadr x1)(cadr x2)))
		 ); end vl-sort
	     ); end setq
      (setq asList(mapcar 'car
		    (vl-remove-if-not
		      '(lambda(x)(member(cadr x)
			(mapcar 'cadr(vl-remove x asList))))
		        asList))
	       ); end setq
      ); and
    (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
    (princ)
    ); end c:demo

Длинну сравнивает до четвертого знака после запятой. Если делать более точное сравнение возникают проблемы с точностью функции DISTANCE.

Теперь перед тобой наиболее сложная задача - ДОКАЗАТЬ ПРЕПОДУ ЧТО ЭТО ТЫ НАПИСАЛ

[Лентяй]

PaSokaS. лови прогу и благодари меня за то, что я есть.

(defun C:LC ( / l lns) (setq cmd (getvar "CMDECHO")) (setvar "CMDECHO" 0) (ssget) (setq adoc (vla-get-ActiveDocument (vlax-get-acad-object)) ass (vla-get-ActiveSelectionSet adoc) lys (vla-get-Layers adoc) n 0) (vlax-for obj ass (if (= (vla-get-ObjectName obj) "AcDbLine") (setq lns (cons obj lns)))) (princ (strcat "\n " (itoa (length lns)) " Lines Selected")) (while lns (setq l (vla-get-length (car lns)) lnm (strcat "Length_" (rtos l)) lns (cdr lns));setq (if (vl-catch-all-error-p (vl-catch-all-apply ' (list lys lnm))) (vla-add lys lnm));if (foreach ln lns (if (= (vla-get-length ln) l) (progn (vla-put-layer ln lnm) (setq n (1+ n) lns (cdr lns)))));foreach (princ (strcat "\n "(itoa n) " Lines of " (rtos l) " Moved on Layer " lnm)));while (setvar "CMDECHO" cmd) );end

[{Smirnoff}]

>Лентяй

Я не думаю что ActiveX это то что требует препод при начальном изучении AutoLISP... Даже насчет VL-функций у меня есть сомнения. Ну да ещё расписывать лениво.

[PaSokaS]

Fantomas
огромное, человеческой спасибо
я в лиспе зеленый зеленый...
тока контуры малость програмировать умею
а это как увидел... чют неопупел %)
Лентяй пасиб и тебе

[Vova]

Сообщение от PaSokaS Vova ты че невидешь ? программа нужна..

Теперь вижу, что студент
А вы, уважаемые программисты, если хотите, чтобы вашего полку прибыло, помогайте бедному студенту не готовой программой, а наводящей на правильный путь информацией. У меня сын итальянский учит. Как? А также. Закладывает домашнее задание в интернет-переводчик, есть такие, получает мгновенный перевод, и адание выполнено. Думаю, PaSokaS будет знать LISP как мой сын итальянский.

[Лентяй]

Fantomas: Я не думаю что ActiveX это то что требует препод при начальном изучении AutoLISP... Даже насчет VL-функций у меня есть сомнения.

Насколько я понимаю, после ACAD-14 писать на просто AutoLISP без VL-функций - это все равно, что разговаривать на церковно-славянском. Я лично - антилиспист, потому как не люблю его. Вот одни не любят негров, другие - семитов, а я - AutoLISP.

[{Smirnoff}]

>Vova
У меня есть искреннее убеждение - нельзя ничему научить, можно чему то научится. Судя по постингам где то существует учебное заведение(я) где преподают достаточно серьёзный курс AutoLISP. А вот зачем, я понять немогу. Эта такая штука что она либо нравится либо нет и без желания обучаемого тут ничего невозможно выучить. Да и для инженера это абсолютно некритично - главное хорошо знать свою специальность. Вот про вас к примеру никогда не скажешь что вы плохой спец, несмотря на то что AutoLISP не знаете. Моя позиция проста - нехай сдают. Кому интересно тот и сам выучит, кому неинтересно, могут эту науку успешно забыть в следующем семестре. AutoLISP может быть прекрасным факультативным предметом, а мучить им "детей" и сдавать экзамены - бред.

>Лентяй

Насколько я понимаю, после ACAD-14 писать на просто AutoLISP без VL-функций - это все равно, что разговаривать на церковно-славянском. Я лично - антилиспист, потому как не люблю его. Вот одни не любят негров, другие - семитов, а я - AutoLISP.

Если посмотрите мои функции, то увидите что я тоже редко обхожусь без VisualLISP. Однако тут другой случай...

[vx]

PaSokaS: задачка 10 из auto2.pdf? ;)

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

[{Smirnoff}]

>vx
Это уже его дело. Мне проще потратить 20 минут и написать полностью, чем выдумывать для него еще какие нибудь загадки. Хочет разобратся, разберётся и заменит часть моего кода на свой, тем более что написать такую ерунду можно 1001 способом.

[Apelsinov]

Сообщение от Vova А вы, уважаемые программисты, если хотите, чтобы вашего полку прибыло, помогайте бедному студенту не готовой программой, а наводящей на правильный путь информацией.

Вообще, по поводу научить и научиться я во многом с Fantomas'ом согласный.
Но еще:
"если хотите, чтобы вашего полку прибыло" - а кому нужна конкуренция? (я не программист)

[{Smirnoff}]

>PaSokaS

Вот вам задачка для самостоятельной проработки. Вы видите что в программе всего одна переменная представляющая собой список, который видоизменяется до самого её окончания. У вашего преподавателя может вызвать вопрос "шаманский" способ его получения:

Код:

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

      (setq asList(vl-remove-if 'listp
                     (mapcar 'cadr(ssnamex asList))))

По идее на вашем уровне знания AutoLISP, вы должны бы были получить его не таким способом, а поработать с набором получаемым:

Код:

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

(setq asList(ssget "_X" '((0 . "LINE"))))

с помощью организации цикла REPEAT, извлечением из набора отдельных примитивов с помощью функции SSNAME. В результате получить тот же список, только другим способом. Вернее по выходе из цикла он уже должен представлять собой список вида ((примитив длинна)(примитив длинна)). Потом уже можно удалять элементы не имеющие "пары".

Второе вы могли бы сделать ввод названия слоя с помощью функции GETKWORD.

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

Код:

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

(defun c:demo (/ asList)
  (if
    (and
      (setq asList(ssget "_X" '((0 . "LINE"))))
      (setq asList(vl-remove-if 'listp
                     (mapcar 'cadr(ssnamex asList))))
       (setq asList
	       (mapcar
	       '(lambda(x)(list x
			   (distof(rtos(distance
			    (cdr(assoc 10(entget x)))
			    (cdr(assoc 11(entget x)))
			    ); end distance
			    2 4); end rtos
			    ); end distof
			   ); end list
		          ); end lambda
	             asList
	          ); end mapcar
	     ); end setq
      (setq asList(mapcar 'car
		    (vl-remove-if-not
		      '(lambda(x)(member(cadr x)
			(mapcar 'cadr(vl-remove x asList))))
		        asList))
	       ); end setq
      ); and
    (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 is not equal lines ***")
      ); end if
    (princ)
    ); end c:demo

[{Smirnoff}]

>Apelsinov

Но еще: "если хотите, чтобы вашего полку прибыло" - а кому нужна конкуренция? (я не программист)

Я не думаю что относительно ЛИСПа речь может идти о какой то конкуренции. 99% пишут на нем абсолютно бесплатно. Ток кто хочет программировать на лиспе, обязательно будет на нем программировать с курсами или без курсов. Остальным он нафиг не нужен.

[Vova]

Сообщение от Apelsinov "если хотите, чтобы вашего полку прибыло" - а кому нужна конкуренция? (я не программист)

Тогда зачем весь этот форум, где все мы учимся друг об друга?

[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)
)

[Лентяй]

Fantomas

Причем здесь DOS и WINDOWS

Сугубо как иллюстрация удобства и понятности.

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

Здрассьте, приехали! А о чем же говорит

(princ (strcat "\n "(itoa n) " Lines of " (rtos l) " Moved on Layer " lnm))

Правда, слой формируется сам. а не выбирается из существующих. За это - пардонте-с. А вот все остальное - очень даже выбполнено.
1. Составляется общий список всех линий.
2. Произвольно выбирается линия сравнения - (ln0).
3. Все линии, имеющие ту же длину, переносятся но новый слой. При этом они пересчитываются.
Agaspher

Нафига? Откуда-ж им взяться?

Об чем спич? Кому "им"?

Странный подход - выбрать всё, а потом фильтровать, когда можно отфильтровать при выборе.

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

Код: [Выделить все] (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) ) )

У меня такое впечатление, что ваш layrep пересчитывает слои, а не линии.

[Alaspher]

> Лентяй
Ник не коверкай!

Об чем спич? Кому "им"?

Код: [Выделить все] [...] (setq cmd (getvar "CMDECHO")) ;запоминаем значение переменной, управляющей выводом промежуточных результатов в командную стороку [...]

Вот я и спрашиваю:

Код:

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

;;;*PL: Нафига? Откуда-ж им взяться?

промежуточным результатам?

Странный подход - выбрать всё, а потом фильтровать, когда можно отфильтровать при выборе. Не вижу разницы, ибо что в лоб, что по лбу. Впрочем, сие есть вопрос вкуса, о коих. как известно, не спорят.

Разница в оптимальности кода. Это - не "в спор", это - указание на недостаток. Не более того.

У меня такое впечатление, что ваш layrep пересчитывает слои, а не линии.

В layrep (layers report) попадает количество примитивов (линий) ассоциировано с тем слоем, в который они перемещаются, для формирования отчёта:

Код:

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

(foreach i layrep (princ (strcat "\n " (itoa (cdr i)) " Lines moved on layer " (car i))))

[{Smirnoff}]

>Лентяй

Здрассьте, приехали! А о чем же говорит

О том что примитивы имеющие ОДИНАКОВУЮ ДЛИННУ, должны переносится В ОДИН СЛОЙ, притом УКАЗАННЫЙ ПОЛЬЗОВАТЕЛЕМ.

По остальным прениям ничего в данный момент сказать не могу поскольку выпил три литра пива и печать данного текста мне дается с трудом...