найти линий одинаковой длины и сменить слой :)

PaSokaS · 17.05.2005, 00:38

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

bdfy · 17.05.2005, 01:09

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

Vova · 17.05.2005, 04:59

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

PaSokaS · 17.05.2005, 23:55

Vova ты че невидешь ?

программа нужна..

PaSokaS · 18.05.2005, 00:00

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

Perezz!! · 18.05.2005, 00:56

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

PaSokaS · 18.05.2005, 01:17

Perezz!!
ну че сделаешь

я сишь уточнил...

блин.. как все заканало

кстате если кому надо могу 6-значку нодогнать

уже не тока спасибо

)

{Smirnoff} · 18.05.2005, 17:38

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

Код:

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

(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.

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

Лентяй · 18.05.2005, 19:35

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} · 18.05.2005, 20:14

>Лентяй

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

PaSokaS · 18.05.2005, 20:26

Fantomas
огромное, человеческой спасибо

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

а это как увидел... чют неопупел %)
Лентяй пасиб и тебе

Vova · 19.05.2005, 05:56

Цитата:

Сообщение от PaSokaS

Vova ты че невидешь ?

программа нужна..

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

Лентяй · 19.05.2005, 10:43

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

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

{Smirnoff} · 19.05.2005, 11:08

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

>Лентяй

Цитата:

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

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

vx · 19.05.2005, 12:56

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

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

{Smirnoff} · 19.05.2005, 13:23

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

Apelsinov · 19.05.2005, 13:25

Цитата:

Сообщение от Vova

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

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

{Smirnoff} · 19.05.2005, 13:47

>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} · 19.05.2005, 14:02

>Apelsinov

Цитата:

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

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

Vova · 19.05.2005, 20:26

Цитата:

Сообщение от Apelsinov

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

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

17.05.2005, 00:38		#1
найти линий одинаковой длины и сменить слой :) PaSokaS Регистрация: 17.05.2005 Сообщений: 13 Написать программу, которая считала бы, скока на чертеже есть линий одинаковой длины и перекинула бы их в слой, выбранный пользователем. Прошу откликнутся всех, кто смог бы помоч в написании программы... ЗЫ зарание благодарю :roll:
Просмотров: 11887