[Pontelimon]

Добрый день !

Я совсем недавно начал пытаться что-то сделать на Lisp так что прошу сильно не ругаться =)

Вот моя первый код, он должен выделять одно строчный текст, расположенный по оси Y < -75.

Код:

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

(defun vibor ( / )
  (setq nabor2 (ssadd))
  (setq nabor (ssget "_X" (list (cons 0 "TEXT") (cons 1 "*`.###"))))
  (if (null nabor)
      (progn
	(princ "\nНету подходящего текста. ")
	(princ)
      )
      (progn
	(setq i -1 kolichestvo_repeatov (sslength nabor))
	(repeat kolichestvo_repeatov
	  (setq i (1+ i))
	  (setq konkretniy_primitiv (entget (ssname nabor i)))
	  (setq koordinata_Y (caddr (assoc 10 konkretniy_primitiv)))
	  (if (koordinata_Y < -75)
	    (ssadd (konkretniy_primitiv) nabor2)
	    );end if
	    );end repeat
	  );end progn
    );end if
  (sssetfirst nil nabor2)
  (princ)
  );end defun

Но как Вы наверное уже догадались он не работает, почему ?

P.S. Очень прошу посмотреть что можно сделать именно в моем варианте решения данной задачи.

[Лиспер]

Расположенный по оси - это точка вставки у него ниже -75? А почему фильтруется по значению текста?

[Дима_]

Сообщение от Pontelimon (if (koordinata_Y < -75)

это нормальная ошибка начинающих - вначале функция - (< koordinata_y 75)

[Pontelimon]

Сообщение от Лиспер Расположенный по оси - это точка вставки у него ниже -75? А почему фильтруется по значению текста?

Да, забыл просто написать, изначально выберется текст такого типа *`.###
Например: 125.889 или 1.089

2Дима_
Спасибо, буду внимательней =)


Подправил эту ошибку, выдаёт:
; ошибка: излишние cdrs в точесной паре на входе

[TararykovDG]

Может так

Код:

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

(sssetfirst nil (ssget "_X" (list (cons 0 "TEXT") (cons 1 "*`.###") (cons -4 "*,<,*") (list 10 0.0 -75.0 0.0))))

[Pontelimon]

Сообщение от TararykovDG Может так Код: [Выделить все] (sssetfirst nil (ssget "_X" (list (cons 0 "TEXT") (cons 1 "*`.###") (cons -4 "*,<,*") (list 10 0.0 -75.0 0.0))))

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

[TararykovDG]

Выделил красным

Код:

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

(defun vibor ( / )
  (setq nabor2 (ssadd))
  (setq nabor (ssget "_X" (list (cons 0 "TEXT") (cons 1 "*`.###"))))
  (if (null nabor)
      (progn
    (princ "\nНету подходящего текста. ")
    (princ)
      )
      (progn
    (setq i -1 kolichestvo_repeatov (sslength nabor))
    (repeat kolichestvo_repeatov
      (setq i (1+ i))
      (setq konkretniy_primitiv (entget (ssname nabor i)))
      (setq koordinata_Y (caddr (assoc 10 konkretniy_primitiv)))
      (if (koordinata_Y < -75)
        (ssadd (konkretniy_primitiv) nabor2) ; здесь скобки не нужны и вместо konkretniy_primitiv должно быть (ssname nabor i)
        );end if
        );end repeat
      );end progn
    );end if
  (sssetfirst nil nabor2)
  (princ)
  );end defun

[Pontelimon]

2 TararykovDG
Ура ! получилось =)) Спасибо за пояснения !!!
А вот еще 1 вопрос по Вашему варианту в 1 строчку, я немного усложнил то что вы написали, посмотрите пожалуйста, что там не так:

Код:

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

(sssetfirst nil (ssget "_X" (list (cons 0 "TEXT") (cons 1 "*`.###")(-4 . "<OR") (cons -4 "*,>,*") (list 10 0.0 -75.0 0.0)(cons -4 "*,<,*") (list 10 0.0 -85.0 0.0)(-4 . "OR>"))))

[Дима_]

Вам наверное не or а and нужен.

[Pontelimon]

Мне нужно чтобы он выбрал текст находящийся либо выше -75 либо ниже -85, вроде тут OR нужен ?
А выдает он:
неверный тип аргумента: consp "<OR"

P.S. в моем коде vibor, у меня получилось это реализовать.

[VVA]

Код:

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

(sssetfirst
  nil
  (ssget "_X"
         (list (cons 0 "TEXT")
               (cons 1 "*`.###")
               '(-4 . "<OR") ;_<=== апостроф в начале
               (cons -4 "*,>,*")
               (list 10 0.0 -75.0 0.0)
               (cons -4 "*,<,*")
               (list 10 0.0 -85.0 0.0)
               '(-4 . "OR>");_<=== апостроф в начале
         ) ;_ end of list
  ) ;_ end of ssget
) ;_ end of sssetfirst

При формировании списка важно различать когда элемент списка получается как результат выполнения функции (например (cons 0 "TEXT")), а когда передается статически (как есть), например (-4 . "OR>"). Во втором случае перед скобкой нужно ставить апостроф ('(-4 . "<OR")) или вызывать ф-цию quote

[Pontelimon]

А почему вот этот фильтр ничего на находит ?

Код:

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

(ssget "_X"(list (cons 0 "TEXT")(cons -4 ">,>,*")(list 10 0.0 0.0 0.0)'(-4 . "<OR")(cons 1 "[4-9]#")(cons 1 "####")(cons 1 "###")'(-4 . ">OR")))

Причем если я подставляю туда что-то 1 из области OR (и соответственно уберу OR), то он работает как надо ... например вот так:

Код:

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

(ssget "_X"(list (cons 0 "TEXT")(cons -4 ">,>,*")(list 10 0.0 0.0 0.0)(cons 1 "###")))

[Лиспер]

Без проверок:

Код:

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

(ssget "_X" '((0 . "TEXT") (-4 . ">,>,*") (10 0. 0. 0.) (1 . "[4-9]#,####,###")))

Сработает или нет - не знаю.

[TararykovDG]

Сообщение от Pontelimon А почему вот этот фильтр ничего на находит ? Код: [Выделить все] (ssget "_X"(list (cons 0 "TEXT")(cons -4 ">,>,*")(list 10 0.0 0.0 0.0)'(-4 . "<OR")(cons 1 "[4-9]#")(cons 1 "####")(cons 1 "###")'(-4 . ">OR"))) Причем если я подставляю туда что-то 1 из области OR (и соответственно уберу OR), то он работает как надо ... например вот так: Код: [Выделить все] (ssget "_X"(list (cons 0 "TEXT")(cons -4 ">,>,*")(list 10 0.0 0.0 0.0)(cons 1 "###")))

В припципе Лиспер уже написал правильный вариант, а у Тебя Pontelimon,

Код:

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

это у Тебя
(ssget "_X"(list (cons 0 "TEXT")(cons -4 ">,>,*")(list 10 0.0 0.0 0.0)'(-4 . "<OR")(cons 1 "[4-9]#")(cons 1 "####")(cons 1 "###")'(-4 . ">OR")))
что должно быть
(ssget "_X"(list (cons 0 "TEXT")(cons -4 ">,>,*")(list 10 0.0 0.0 0.0)'(-4 . "<OR")(cons 1 "[4-9]#")(cons 1 "####")(cons 1 "###")'(-4 . "OR>")))

[Pontelimon]

Всем спасибо, забыл что можно через запятую просто перечислить ... и не проверял написание т.к. LISP не выдавал ошибку.

Я тут написал написал продолжение своей первой програмки, причем оно даже работает(!). Смысл его в том что она получив набор из первой части начинает его округлять до сотых, я видел тут на форуме есть уже готовые решения с округлением, но я не всё там понимаю, поэтому решил попробовать написать самостоятельно.
Вот это произведение:

Код:

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

  (if (null nabor2)
      (progn
	(princ "\nНету подходящих цифр для округления. ")
	(princ)
      )
      (progn
	(setq i2 -1 kolichestvo_repeatov2 (sslength nabor2))
	(repeat kolichestvo_repeatov2
	(setq i2 (1+ i2))
	(setq konkretniy_primitiv2 (entget (ssname nabor2 i2)))
	(setq znachenie (cdr (assoc 1 konkretniy_primitiv2)))
	(setq znachenie_list (vl-string->list znachenie))
	(setq dlina_lista (length znachenie_list))
	(setq last_zifra (nth (- dlina_lista 1) znachenie_list ))
	(setq pre_last_zifra (nth(- dlina_lista 2)znachenie_list))
	(cond
	  ((>= last_zifra 54) 
	   	(setq novoe_znachenie '())
	   	(setq novoe_znachenie_ascii '())
		(setq i3 -1 kolichestvo_repeatov3 (length znachenie_list))
		(repeat (- kolichestvo_repeatov3 1)
		(setq i3 (1+ i3))
		(setq zifra_iz_spiska (nth i3 znachenie_list))
		(setq novoe_znachenie_ascii (append novoe_znachenie_ascii (list zifra_iz_spiska)))
		)
		(setq novoe_znachenie (vl-list->string novoe_znachenie_ascii))
	   	(setq novoe_znachenie (atof novoe_znachenie))
	   	(if (minusp novoe_znachenie)
		 (progn (setq novoe_znachenie(- novoe_znachenie 0.01)))
		 (progn (setq novoe_znachenie(+ novoe_znachenie 0.01)))
		)
	   	(setq novoe_znachenie (rtos novoe_znachenie 2 2))
	 	(setq konkretniy_primitiv2 (subst (cons 1 novoe_znachenie) (assoc 1 konkretniy_primitiv2)konkretniy_primitiv2))
	   	(entmod konkretniy_primitiv2)
	   )
	  ((<= last_zifra 52) 
	   	(setq novoe_znachenie '())
	   	(setq novoe_znachenie_ascii '())
		(setq i3 -1 kolichestvo_repeatov3 (length znachenie_list))
		(repeat (- kolichestvo_repeatov3 1)
		(setq i3 (1+ i3))
		(setq zifra_iz_spiska (nth i3 znachenie_list))
		(setq novoe_znachenie_ascii (append novoe_znachenie_ascii (list zifra_iz_spiska)))
		)
		(setq novoe_znachenie (vl-list->string novoe_znachenie_ascii))
	 	(setq konkretniy_primitiv2 (subst (cons 1 novoe_znachenie) (assoc 1 konkretniy_primitiv2)konkretniy_primitiv2))
	   	(entmod konkretniy_primitiv2)
	   )
	  ((and (= last_zifra 53) (or(= pre_last_zifra 48) (= pre_last_zifra 50) (= pre_last_zifra 52)(= pre_last_zifra 54)(= pre_last_zifra 56)))
	   	(setq novoe_znachenie '())
	   	(setq novoe_znachenie_ascii '())
		(setq i3 -1 kolichestvo_repeatov3 (length znachenie_list))
		(repeat (- kolichestvo_repeatov3 1)
		(setq i3 (1+ i3))
		(setq zifra_iz_spiska (nth i3 znachenie_list))
		(setq novoe_znachenie_ascii (append novoe_znachenie_ascii (list zifra_iz_spiska)))
		)
		(setq novoe_znachenie (vl-list->string novoe_znachenie_ascii))
	 	(setq konkretniy_primitiv2 (subst (cons 1 novoe_znachenie) (assoc 1 konkretniy_primitiv2)konkretniy_primitiv2))
	   	(entmod konkretniy_primitiv2)	   
	   )
	  ((and (= last_zifra 53) (or(= pre_last_zifra 49) (= pre_last_zifra 51) (= pre_last_zifra 53)(= pre_last_zifra 55)(= pre_last_zifra 57)))
	   	(setq novoe_znachenie '())
	   	(setq novoe_znachenie_ascii '())
		(setq i3 -1 kolichestvo_repeatov3 (length znachenie_list))
		(repeat (- kolichestvo_repeatov3 1)
		(setq i3 (1+ i3))
		(setq zifra_iz_spiska (nth i3 znachenie_list))
		(setq novoe_znachenie_ascii (append novoe_znachenie_ascii (list zifra_iz_spiska)))
		)
		(setq novoe_znachenie (vl-list->string novoe_znachenie_ascii))
	   	(setq novoe_znachenie (atof novoe_znachenie))
	   	(if (minusp novoe_znachenie)
		 (progn (setq novoe_znachenie(- novoe_znachenie 0.01)))
		 (progn (setq novoe_znachenie(+ novoe_znachenie 0.01)))
		)
	   	(setq novoe_znachenie (rtos novoe_znachenie 2 2))
	 	(setq konkretniy_primitiv2 (subst (cons 1 novoe_znachenie) (assoc 1 konkretniy_primitiv2)konkretniy_primitiv2))
	   	(entmod konkretniy_primitiv2)
	   )				
	 );end cond
	 );end repeat
  (setvar 'dimzin 8)
  (princ "\nКоличество округленных цифр ")
  (princ(sslength nabor2))
  (princ)
  )
  );end if

Буду признателен за замечания и советы.

[VVA]

Сообщение от Pontelimon Буду признателен за замечания и советы.

После замечаний и советов может получиться

Сообщение от Pontelimon я видел тут на форуме есть уже готовые решения с округлением, но я не всё там понимаю

[Pontelimon]

Я тут еще прикинул небольшой код, который должен опускать по оси Y некоторые цифры, но я никак не пойму, почему он опускает только 3 цифры ?!
Код:

Код:

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

(defun c:oform ( /)
 (setq nabor5(ssget "_X"(list (cons 0 "TEXT")(cons -4 "*,>,*")(list 10 0.0 0.0 0.0)'(-4 . "<OR")(cons 1 "[4-9]#")(cons 1 "####")(cons 1 "###")'(-4 . "OR>"))))
 (if (null nabor5)
      (progn
	(princ "\nНет цифр. ")
	(princ)
      )
        (progn
        (setq i5 -1 kolichestvo_repeatov5 (sslength nabor5))
	(repeat kolichestvo_repeatov5
	(setq novie_koord '())
	(setq i5 (1+ i5))
	(setq konkretniy_primitiv5 (entget (ssname nabor5 i5)))
	(setq koordX (cadr (assoc 10 konkretniy_primitiv5)))
	(setq koordY (caddr (assoc 10 konkretniy_primitiv5)))
	(setq koordZ 0.0)
	(setq koordY (- koordY 1))
	(setq novie_koord (append novie_koord (list koordX)))
	(setq novie_koord (append novie_koord (list koordY)))
	(setq novie_koord (append novie_koord (list koordZ)))      
	(setq konkretniy_primitiv5 (subst (cons 10 novie_koord) (assoc 10 konkretniy_primitiv5)konkretniy_primitiv5))
	(entmod konkretniy_primitiv5)
	)
        (princ)
	)
   	)
        )

Ну и файл с цифрами, на котором я ставил эксперимент прилагаю.

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

Подозреваю, что дело в выравнивании текста...
http://autolisp.ru/2010/04/06/text-and-attrib-entities/

[Pontelimon]

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

Код:

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

 (setq nabor5(ssget "_X"(list (cons 0 "TEXT")(cons -4 "*,>,*")(list 10 0.0 0.0 0.0)'(-4 . "<OR")(cons 1 "[4-9]#")(cons 1 "####")(cons 1 "###")'(-4 . "OR>"))))
 (if (null nabor5)
      (progn
	(princ "\nâàõ!. ")
	(princ)
      )
        (progn
        (setq i5 -1 kolichestvo_repeatov5 (sslength nabor5))
	(repeat kolichestvo_repeatov5
	(setq novie_koord '())
	(setq i5 (1+ i5))
	(setq konkretniy_primitiv5 (entget (ssname nabor5 i5)))
	(setq koordX (cadr (assoc 10 konkretniy_primitiv5)))
	(setq koordY (caddr (assoc 10 konkretniy_primitiv5)))
	(setq koordZ 0.0)
	(setq koordY (- koordY 1))
	(setq novie_koord (append novie_koord (list koordX)))
	(setq novie_koord (append novie_koord (list koordY)))
	(setq novie_koord (append novie_koord (list koordZ)))      
	(setq konkretniy_primitiv5 (subst (cons 72 0) (assoc 72 konkretniy_primitiv5)konkretniy_primitiv5))
	(entmod konkretniy_primitiv5)
	(setq konkretniy_primitiv5 (subst (cons 10 novie_koord) (assoc 10 konkretniy_primitiv5)konkretniy_primitiv5))
	(entmod konkretniy_primitiv5)
	)
	(princ)
	)
   	)
  )

[Pontelimon]

Тут возникло еще пару вопросов:

Как можно на лиспе вставить блок который находиться у меня на закладке Палитра в точку с координатами 0,0 ? Так же при вставке с палитры он у меня автоматически расчленяться.

Сам блок находиться в файле: D:\%CADRootDir%\Палитры\Specificacia.dwg
Называется: Профиль В

Как можно получить координаты точки вставки блока ? (хочу их использовать в фильтре)

[Лиспер]

Сначала вставляется файл, содержащий блок (command "_.-insert" FileName) (command)
Потом вставляешь уже сам блок "Профиль В".
P.S. На форуме есть тема, название, кажется, "На заметку программистам" - там были какие-то коды.
P.P.S.

Сообщение от Pontelimon при вставке с палитры он у меня автоматически расчленяться

Посмотри настройки инструмента.

Сообщение от Pontelimon Как можно получить координаты точки вставки блока

DXF Reference в руки, 10 группа.

[Disney]

Сообщение от Лиспер DXF Reference в руки, 10 группа.

Не всегда всё так просто...

[Лиспер]

Disney, вряд ли тут задействована немировая система координат будет И потом, trans никуда не делся

[Pontelimon]

Сообщение от Лиспер Сначала вставляется файл, содержащий блок (command "_.-insert" FileName) (command) Потом вставляешь уже сам блок "Профиль В". P.P.S. Посмотри настройки инструмента.

Спасибо, получилось вставить блок по нужным координатам, но появилось несколько вопросов:

1. Когда я подгружаю файл содержащий нужный мне блок, он хочет его вставить на текущий чертеж, можно ли сделать так чтобы он только подгружал из него блоки без запроса вставки ?

2. Я что-то, не понял какого инструмента настройки смотреть ? я хочу чтобы они при вставке разбивались.

3. Можно ли избавиться от спама к командной строке, который сопровождает вставку блока ?

[Лиспер]

1. Я ж написал самый простой вариант: (command "_.-insert" <FileName>) (command)
2. Настройки инструмента на ToolPalette, который у тебя выполняет вставку блока
3. Можно cmdecho -> 0; nomutt -> 1. Потом вернуть все обратно

[Pontelimon]

Сообщение от Лиспер 1. Я ж написал самый простой вариант: (command "_.-insert" <FileName>) (command) 2. Настройки инструмента на ToolPalette, который у тебя выполняет вставку блока 3. Можно cmdecho -> 0; nomutt -> 1. Потом вернуть все обратно

Спасибо ! Все получилось ! =)

[Pontelimon]

Поясните пожалуйста, почему в данном случае выдаётся ошибка:
"; ошибка: неверная функция: 190.0"
вот код:

Код:

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

 (setq listkoordY (list 190.0 195.0 200.0 205.0 210.0 215.0 220.0 225.0 230.0))
(setq listkoordY (list 'min listkoordY))
(setq minkoordY(eval listkoordY)) 

Все, вопрос снимаю, сам допер.

Код:

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

 (setq listkoordY (list 190.0 195.0 200.0 205.0 210.0 215.0 220.0 225.0 230.0))
(setq listkoordY (cons 'min listkoordY))
(setq minkoordY(eval listkoordY)) 

[Лиспер]

А что, проще не получается?

Код:

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

 (setq listkoordY '(190.0 195.0 200.0 205.0 210.0 215.0 220.0 225.0 230.0))
(apply 'min listkoordY)

Или так:

Код:

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

 (setq minkoordY (apply 'min '(190.0 195.0 200.0 205.0 210.0 215.0 220.0 225.0 230.0)))

[Pontelimon]

Сообщение от Лиспер А что, проще не получается? Код: [Выделить все] (setq listkoordY '(190.0 195.0 200.0 205.0 210.0 215.0 220.0 225.0 230.0)) (apply 'min listkoordY) Или так: Код: [Выделить все] (setq minkoordY (apply 'min '(190.0 195.0 200.0 205.0 210.0 215.0 220.0 225.0 230.0)))

Да, так действительно проще, спасибо

Я столкнулся вот с такой проблемой:

Есть полилиния (рамка) вот ее DXF:

((-1 . <Имя объекта: 7ec57e30>) (0 . "LWPOLYLINE") (330 . <Имя
объекта: 7ef90cf8>) (5 . "C06") (100 . "AcDbEntity") (67 . 0) (410 . "Model")
(8 . "0") (100 . "AcDbPolyline") (90 . 4) (70 . 1) (43 . 0.5) (38 . 0.0) (39 .
0.0) (10 -110.0 -130.0) (40 . 0.5) (41 . 0.5) (42 . 0.0) (10 -110.0 280.0) (40
. 0.5) (41 . 0.5) (42 . 0.0) (10 337.0 280.0) (40 . 0.5) (41 . 0.5) (42 . 0.0)
(10 337.0 -130.0) (40 . 0.5) (41 . 0.5) (42 . 0.0) (210 0.0 0.0 1.0))

В ней аж 4 группы с 10-кой, как мне ее опустить по Y на 10 единиц ?

[Дима_]

без проверки - как-то так:
(entmode (mapcar '(lambda (x) (if (= (car x) 10) (cons 10 (cons (cadr x) (cons (-(caddr x) 10) (cdddr x)))) x)) DXF))
но ихмо - в данном случае "надежней" vla:
(vla-move (vlax-ename->vla-object (entlast)) (vlax-3d-point '(0 10 0)) (vlax-3d-point '(0 0 0)))

[Pontelimon]

Сообщение от Дима_ без проверки - как-то так: (entmode (mapcar '(lambda (x) (if (= (car x) 10) (cons 10 (cons (cadr x) (cons (-(caddr x) 10) (cdddr x)))) x)) DXF)) но ихмо - в данном случае "надежней" vla: (vla-move (vlax-ename->vla-object (entlast)) (vlax-3d-point '(0 10 0)) (vlax-3d-point '(0 0 0)))

Использовал Ваш vla вариант, спасибо !!!
DXF не запустился.

[Дима_]

Сообщение от Pontelimon Использовал Ваш vla вариант, спасибо !!! DXF не запустился.

там где выделенно DXF должен быть dxf код полилинии (типа того что вы писали) - как вариант (entget (entlast))

[VVA]

Сообщение от Pontelimon DXF не запустился.

И не запустится. Нужно не entmode, а entmod
А так красивее

Код:

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

(and
(setq DXF (entget(car(entsel "\Выбери полилинию: "))))
(entmod(mapcar '(lambda (x)(if(= (car x) 10)(cons 10 (mapcar '- (cdr x) '(0 -10))) x)) DXF))
)

[Дима_]

Сообщение от VVA И не запустится. Нужно не entmode, а entmod

эх...

[Pontelimon]

Сообщение от VVA И не запустится. Нужно не entmode, а entmod А так красивее Код: [Выделить все] (and (setq DXF (entget(car(entsel "\Выбери полилинию: ")))) (entmod(mapcar '(lambda (x)(if(= (car x) 10)(cons 10 (mapcar '- (cdr x) '(0 -10))) x)) DXF)) )

А Вы бы не могли разъяснить поэтапно, как для дурака, как это работает ? =) И если не трудно применительно к такому вот примеру:

Есть полилиния :

((-1 . <Имя объекта: 7e909850>) (0 . "LWPOLYLINE") (330 . <Имя
объекта: 7ef90cf8>) (5 . "4B12") (100 . "AcDbEntity") (67 . 0) (410 . "Model")
(8 . "0") (100 . "AcDbPolyline") (90 . 2) (70 . 0) (43 . 0.0) (38 . 0.0) (39 .
0.0) (10 26.2914 84.5212) (40 . 0.0) (41 . 0.0) (42 . 0.0) (10 27.5839 84.5212)
(40 . 0.0) (41 . 0.0) (42 . 0.0) (210 0.0 0.0 1.0))

Как мне изменить все ее Х координаты на свои переменные X1 и X2 ?

[Дима_]

(and ; это альтернатива проверки условия (if) если первый опрератор (setq...) вернет nil то следуящея команда выполняться не будет
(setq DXF (entget(car(entsel "\Выбери полилинию: ")))) ;присваивает значению DXF список dxf кодов выбранного примитива
(entmod ;преобразовать примитив
(mapcar ;вернуть обработанные следующей функцией все элементы списка (dxf)
'(lambda (x);функция принимающая на входе 1 аргумент - ассоциативную пару (список, либо cons-пара где первый элемент является кодом остальной части списка)
(if(= (car x) 10);если код пары = 10 (координата)
(cons 10 (mapcar '- (cdr x) '(0 -10))); создать ассоативный список с кодом 10 (координата) и координатой меньше начальной по оси X на 0, по оси Y на 10 (ноль, так-же, можно поменять на любое число (в т.ч. и отрицательное) - для изменения координаты Х)
x));в противном случае (не код 10) - вернуть полученное значение без изменений
DXF ;обрабатываемый список кодов)))

[Pontelimon]

Сообщение от Дима_ (and ; это альтернатива проверки условия (if) если первый опрератор (setq...) вернет nil то следуящея команда выполняться не будет (setq DXF (entget(car(entsel "\Выбери полилинию: ")))) ;присваивает значению DXF список dxf кодов выбранного примитива (entmod ;преобразовать примитив (mapcar ;вернуть обработанные следующей функцией все элементы списка (dxf) '(lambda (x);функция принимающая на входе 1 аргумент - ассоциативную пару (список, либо cons-пара где первый элемент является кодом остальной части списка) (if(= (car x) 10);если код пары = 10 (координата) (cons 10 (mapcar '- (cdr x) '(0 -10))); создать ассоативный список с кодом 10 (координата) и координатой меньше начальной по оси X на 0, по оси Y на 10 (ноль, так-же, можно поменять на любое число (в т.ч. и отрицательное) - для изменения координаты Х) x));в противном случае (не код 10) - вернуть полученное значение без изменений DXF ;обрабатываемый список кодов)))

Большое спасибо ! Стало на порядок понятней ! Но не понятно как в этом случае можно было бы различить несколько групп с кодом 10, т.е. допустим первую 10-ку нужно увеличить на 5 а вторую уменьшить 5?

[Дима_]

Сообщение от Pontelimon Но не понятно как в этом случае можно было бы различить несколько групп с кодом 10, т.е. допустим первую 10-ку нужно увеличить на 5 а вторую уменьшить 5?

Вариант 1 проще в понимании, но мне не нравится - ввести дополнительную переменную и считать ей какая сейчас координата - соответственно исправить проверку.
Вариант 2 - рекурсивный - написать самовызывающую функцию последовательно "обходящею список", с дополнительными аргументами (номера, четности и пр.) - несколько иная логика работы - но без проблем будет работать с многовложенными списками и пр. "неожиданостями".
p.s. - за активное применение второго метода иногда "сыплется" критика со стороны формучан.

[Pontelimon]

Ну второй вариант мне пока по определению явно не доступен. Поэтому я остановлю свой выбор на 1-ом, вот я немного модифицировал код под свои нужды, предоставленный как пример, VVA.

(entmod (mapcar '(lambda (x) (if(and (= (car x) 10) (= minkoordX (cadr x))) (cons 10 (mapcar '+ (cdr x) '(0.5 0))) x)) dno))
(entmod (mapcar '(lambda (x1) (if(and (= (car x1) 10) (= (+ minkoordX 4) (cadr x1))) (cons 10 (mapcar '- (cdr x1) '(0.5 0))) x1)) dno))

В итоге первым действием все как и было мной задумано отрезок полилинии(слева) укорачивается на 0.5, а вот вторым действием вместо укорачивания почему-то отрезок просто перемещаться налево на 0.5, а если повторить все с первого действия то отрезок начинает просто перемещаться то на 0.5 налево, то направо. Где я ошибся ?

[Дима_]

Сообщение от Pontelimon а если повторить все с первого действия то отрезок начинает просто перемещаться то на 0.5 налево, то направо. Где я ошибся ?

Это и есть одна из тех многочисленных "неожиданостей" которые всплывают при использовании "простого первого метода" - после entmod dno надо обновить - а то он производит изменения в соответствии с первыми (изначальными) параметрами. Если программа будет чуть посложней - иногда очень не просто не упустить, что сейчас у тебя в переменной.

[Pontelimon]

Точно! Спасибо за пояснения ! Вроде работает =) а еще я модифицировал ряд своих кодов, вот например ищет минимальную Х координату из всех полилиний, посмотрите, может там что-то можно еще улучшить ?

Код:

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

 (defun c:oform ( /)
(setq nabor_x '())
(setq test (ssget "_X" '((0 . "LWPOLYLINE"))))
(setq i -1 povtor (sslength test))
(repeat povtor
(setq i (1+ i))
(setq primitiv (entget (ssname test i))) 
(mapcar '(lambda (x)(if(= (car x) 10)(setq krdx (cadr x)) x)) primitiv)
(setq nabor_x (append nabor_x (list krdx)))
)
(setq minx (apply 'min nabor_x))
)

[Дима_]

Сообщение от Pontelimon может там что-то можно еще улучшить ?

Ну как тебе сказать, всегда чего-то можно улучшить. Можно последовательные setq в один объеденить - можно append на cons поменять - но это мелочи - надо научится думать "по лисповски" вот тебе пример - скажу сразу, я его накатал только для того чтоб ты "мысль" ухватил - сам бы написал изначально по другому - в этом коде много "лишних" операций, но с моей точки зрения может подвести тебя к "правильной" логике:

Код:

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

 
(vl-load-com)
(apply 'min
  (mapcar 'cadr 
     (vl-remove-if-not '(lambda (x) (= (car x) 10))
         (apply 'append
            (mapcar 'entget
               (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget "_x" '((0 . "lwpolyline")))))))))))

[Disney]

Сообщение от Дима_ я его накатал только для того чтоб ты "мысль" ухватил - сам бы написал изначально по другому - в этом коде много "лишних" операций

покажи как.
Опять с рекурсией?

[Дима_]

Сообщение от Disney покажи как. Опять с рекурсией?

Ну попробуй сам - "прошагивай" по набору - с одним аргументом - (самой мальенькой координатой).
p.s. с практической точки зрения конечно имеет смысл сохранить список из набора, (да и функцию я бы естественно делал получающую список на входе), но если мы рассматриваем эту задачу в отдельности, то это лишняя операция - попробуй "вытягивать нужное" сразу из него (набора).
В вышеуказанной функции мы "пробегаем" по списку 7+количество полученных элементов раз (он правда 2 раза уменьшается) - уверяю достаточно 1-го.

[Disney]

Сообщение от Дима_ Ну попробуй сам

Попробовал, сократил пару "пробегов", но получилась фигня какая-то

Код:

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

 (defun test3 (/ rec-get_vert ssget_to_list rec-f)
  (defun rec-get_vert (lwp)
    (cond
      ((= (caar lwp) 10)
       (cons (cadar lwp) (rec-get_vert (cdr lwp)))
      )
      ((cdr lwp) (rec-get_vert (cdr lwp)))
    )
  )
  (defun ssget_to_list (ss)
    (vl-remove-if
      'listp
      (mapcar 'cadr (ssnamex ss))
    )
  )
  (defun rec-f (_list)
    (if	(cdr _list)
      (append (get_vert (entget (car _list))) (rec-f (cdr _list)))
      (get_vert (entget (car _list)))
    )
  )
  (apply 'min
	 (rec-f (ssget_to_list (ssget "_x" '((0 . "lwpolyline")))))
  )
)

Как показывают тесты:
test1 - функция Pontelimon #41
test2 - функция Дима_ #42
test3 - моя #45

1 полилиния

Команда: (benchmark '((test)(test2)(test3))) Elapsed milliseconds / relative speed for 2048 iteration(s): (TEST)......1373 / 1.15 <fastest> (TEST3).....1498 / 1.05 (TEST2).....1575 / 1.00 <slowest>

100 полилиний

Команда: (benchmark '((test)(test2)(test3))) Elapsed milliseconds / relative speed for 256 iteration(s): (TEST2).....1732 / 2.48 <fastest> (TEST)......2854 / 1.50 (TEST3).....4290 / 1.00 <slowest>

1000 полилиний

Команда: (benchmark '((test)(test2)(test3))) Elapsed milliseconds / relative speed for 32 iteration(s): (TEST2)......1982 / 5.74 <fastest> (TEST).......4228 / 2.69 (TEST3).....11373 / 1.00 <slowest>

[Дима_]

1. По поводу скорости - чем никогда не славился лисп - так это скоростью работы. Он хорош скоростью разработки (если писать на нем в лисп стиле). Почему я приемуществнно (везде где возможно) использую лямбды с рекурсиями - мне это дает широчайшие возможности по корректировке кода - в моей практике (лисп и не только) постоянно корректируется ТЗ - если программа написанна в строго функциональном стиле - переправить ее в 5 раз проще и быстрее чем императивную - функции ни как не зависимы - "подводных камней" совместимости данных нет - написал один раз функцию и забыл - работать будет вн зависимости из какого места (состояния) программы ты ее вызвал.
2. Любую рекурсивную функцию можно "развернуть" в цикл - она станет на 2-5% быстрей, но потерят "изменяемость" (хорошие лисп трансляторы делают это автоматом), но написать с нуля такую-же развернутую функцию вряд-ли получится (разная логика) - хотим мы того или нет - алгоритм в деталях будет разный в зависмости от стиля.
3. Ты сейчас "закрутил" в рекурсию логику итеративной программы - потому и результат "не ахти" (получил худшие качества с обоих методов) - забудь мою (и понтелимоновскую) версию попробуй написать с нуля - не оглядываясь на логику той программы - если уже "совсем не как" - могу "свой" вариант "накалякать" (мне это не сложно) - но если хочешь действительно осознать попробуй все таки сам - подскажу лишь, что все действие делается за 1 прогон.
з.ы. выйгрыш в скорости в рекурсивной программе - может быть только из-за более удачной реализации алгоритма (с моей точки зрения это достаточно часто).

[Disney]

Сообщение от Дима_ могу "свой" вариант "накалякать" (мне это не сложно)

Сдаюсь, выкладывай.

Сообщение от Дима_ но если хочешь действительно осознать попробуй все таки сам

ни чего страшного, всему своё время, когда-то я вообще больше года смотрел на описание функций работы со списками(типа mapcar, apply, ...), но так и не понимал, что они делают и как работают, потом почти столько же времени смотрел как их применяют в своих кодах другие, а однажды наконец и я стал ими пользоваться, это оказалось на столько удобно, что я радовался как ребёнок.

[Дима_]

Сообщение от Disney Сдаюсь, выкладывай.

Для "критиков" не читавших предварительные посты повторю:

p.s. с практической точки зрения конечно имеет смысл сохранить список из набора, (да и функцию я бы естественно делал получающую список на входе), но если мы рассматриваем эту задачу в отдельности...

Код:

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

 (defun test4 (ss)
  (if ss ((lambda (min-x f-rec)
            (f-rec (1- (sslength ss)) (min-x (entget (ssname ss 0)) nil)))
          (lambda (ent-lst min-value); mix-n
            (if ent-lst
                (min-x (cdr ent-lst)
                       (if (and (= (caar ent-lst) 10)
                                (or (< (cadar ent-lst) min-value);вот сюда я рекомндую обратить пристальное внимание
                                    (not min-value)));по "простой" логике проверка должна идти в обратном порядке, но попробуй понять в чем "фишка"
                           (cadar ent-lst)
                           min-value))
                min-value))
          (lambda (i min-value);f-rec
            (if (zerop i)
                min-value
                (f-rec (1- i) (min-x (entget (ssname ss i)) min-value)))))))

p.s. если еще будут вопросы - возможно отвечу не ранее чем через неделю (сегодня улетаю - командировка в Новосибирск - не знаю что там с инетом). Удачи.
p.p.s - глюк оформления кода в 8 строке - нет там певрой ";" - просто <

[Pontelimon]

Я еще хотел уточнить вот такой простой случай:

Код:

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

 (setq Y 0)
(SSSETFIRST nil (ssget "_F" '((0 Y)(10000 Y))'((0 . "LWPOLYLINE")(8 . "TR_UP"))))

Почему тут выходить ошибка : слишком много аргументов ?
причем если написать просто :

Код:

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

 (SSSETFIRST nil (ssget "_F" '((0 0)(10000 0))'((0 . "LWPOLYLINE")(8 . "TR_UP"))))

то работает.

[Do$]

Это неправильно:

Код:

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

'((0 Y)(10000 Y))

Это правильно:

Код:

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

(list (list 0 Y)(list 10000 Y))

Код:

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

_$ (setq Y 0)
0
_$ '((0 Y)(10000 Y))
((0 Y) (10000 Y))
_$ (list (list 0 Y)(list 10000 Y))
((0 0) (10000 0))
_$

[Pontelimon]

Сообщение от Do$ Это неправильно: Код: [Выделить все] '((0 Y)(10000 Y)) Это правильно: Код: [Выделить все] (list (list 0 Y)(list 10000 Y)) Код: [Выделить все] _$ (setq Y 0) 0 _$ '((0 Y)(10000 Y)) ((0 Y) (10000 Y)) _$ (list (list 0 Y)(list 10000 Y)) ((0 0) (10000 0)) _$

Do$, спасибо вам ! ошибку понял, все заработало =)

[Disney]

Сообщение от Дима_ Код: [Выделить все] (or (< (cadar ent-lst) min-value);вот сюда я рекомндую обратить пристальное внимание 09***********************************(not min-value)));по "простой" логике проверка должна идти в обратном порядке, но попробуй понять в чем "фишка"

Ну тут всё просто, логическая функция сравнения < при первом проходе не выдаст ошибку если бы даже оба аргумента были nil, зато нам не придёться проверять все последующие проходы min-value на nil
Теперь вопросы:

1. Для чего мы сокращали количество проходов, если это ни привело ни к ускорению программы, ни к понятности кода для широких масс?
2. Чем lambda лучше defun?
3. Выложи наконец-то чисто свой код, который бы ты написал для себя безо всяких образовательных целей

Сообщение от Дима_ в Новосибирск - не знаю что там с инетом

Всё очень даже не плохо:

• полное покрытие 3G,
• бесплатный Wi-Fi во всех приличных общественных местах,
• высокоскоростной кабельный в каждом доме и офисном здание.

Сообщение от Pontelimon Почему тут выходить ошибка : слишком много аргументов ?

Пока видео делал, Do$ уже любезно ответил, но раз сделал выложу.

[gomer]

Сообщение от Disney Чем lambda лучше defun?

лямбда - это временная дефун...

[Disney]

Сообщение от Disney лямбда - это временная дефун...

"Да это то понятно..."
Например вот:

Код:

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

 
(defun test1 (test / rec_1+)
  (defun rec_1+	(lst)
    (if	lst
      (cons (1+ (car lst))
	    (rec_1+ (cdr lst))
      )
    )
  )
  (rec_1+ test)
)


(defun test2 (test / rec_1+)
  (setq	rec_1+ (lambda (lst)
		 (if lst
		   (cons (1+ (car lst))
			 (rec_1+ (cdr lst))
		   )
		 )
	       )
  )
  (rec_1+ test)
)


(defun test3 (test)
  ((lambda (rec_1+ lst)
     (rec_1+ lst)
   )
    (lambda (lst)
      (if lst
	(cons (1+ (car lst))
	      (rec_1+ (cdr lst))
	)
      )
    )
    test
  )
)
(defun test4 (test)
  (mapcar '1+ test)
)


(defun rec-f (st end)
  (if (<= st end)
    (cons st (rec-f (1+ st) end))
  )
)

во всех случаях(кроме test4) количество локальных переменных одинаковое.
ну и анализ быстродействия, хотя Дима_ уверяет, что это не показатель.
Не скомпилированный LSP

Код:

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

Команда: (setq test (rec-f 0 5))
(0 1 2 3 4 5)
Команда: (benchmark '((test1 test)(test2 test)(test3 test)(test4 test)))
Elapsed milliseconds / relative speed for 32768 iteration(s):

    (TEST2 TEST).....1326 / 1.12 <fastest>
    (TEST3 TEST).....1341 / 1.11
    (TEST1 TEST).....1373 / 1.08
    (TEST4 TEST).....1482 / 1.00 <slowest>

Команда: (setq test (rec-f 0 100))
(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 
29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 
55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 
81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100)
Команда: (benchmark '((test1 test)(test2 test)(test3 test)(test4 test)))
Elapsed milliseconds / relative speed for 32768 iteration(s):

    (TEST4 TEST).....1716 / 3.09 <fastest>
    (TEST2 TEST).....5226 / 1.01
    (TEST3 TEST).....5258 / 1.01
    (TEST1 TEST).....5304 / 1.00 <slowest>

Скомпилированный VLX

Код:

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

Команда: (setq test (rec-f 0 5))
(0 1 2 3 4 5)

Команда: (benchmark '((test1 test)(test2 test)(test3 test)(test4 test)))
Elapsed milliseconds / relative speed for 32768 iteration(s):

    (TEST2 TEST).....1232 / 1.25 <fastest>
    (TEST3 TEST).....1232 / 1.25
    (TEST1 TEST).....1248 / 1.24
    (TEST4 TEST).....1544 / 1.00 <slowest>

Команда: (setq test(rec-f 0 100))
(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 
29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 
55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 
81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100)

Команда: (benchmark '((test1 test)(test2 test)(test3 test)(test4 test)))
Elapsed milliseconds / relative speed for 32768 iteration(s):

    (TEST4 TEST).....1903 / 1.58 <fastest>
    (TEST2 TEST).....2979 / 1.01
    (TEST3 TEST).....2995 / 1.01
    (TEST1 TEST).....3011 / 1.00 <slowest>

Сообщение от gomer дефун

дифан

[gomer]

Сообщение от Disney Например вот:

А если так?

Код:

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

 (defun test2 (lst)
  (if lst 
    (cons (1+ (car lst))
          (test2 (cdr lst))
    )
  )
)

или так

Код:

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

 (mapcar '1+ '(0 1 2 3 4 5))

Disney, вы можете проверить и эти варианты???

[Disney]

Сообщение от gomer Disney, ты можешь проверить и эти варианты???

добавил mapcar

[Pontelimon]

Сообщение от Disney Пока видео делал, Do$ уже любезно ответил, но раз сделал выложу.

Спасибо за видео, все очень доходчиво объяснено.

Я бы хотел уточнить еще 1 свою функцию(срабатывает 9 раз из 10), хотелось бы добиться 100% работоспособности, есть такой вот код :

Код:

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

 (defun c:test2 ( / )
  
(setq minx 658)
(setq truba_up_sprava (ssget "_F" (list (list (+ minx 4) 0)(list (+ minx 4) 10000))'((0 . "LWPOLYLINE")(8 . "TR_UP"))))
(setq primitiv (entget (ssname truba_up_sprava 0)))
(entmod (mapcar '(lambda (x) (if(and (= (car x) 10) (= (+ minx 4) (cadr x))) (cons 10 (mapcar '- (cdr x) '(0.5 0))) x)) primitiv))
  
)

И для наглядности чертеж с полилинией на которую этот код почему-то не действует.

А должен он удлинить полилинию налево по оси Х на 0.5

[TararykovDG]

Сообщение от Pontelimon И для наглядности чертеж с полилинией на которую этот код почему-то не действует. А должен он удлинить полилинию налево по оси Х на 0.5

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

Код:

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

 
(setq truba_up_sprava (ssget "_F" (list (list (+ minx 4) 0)(list (+ minx 4) 10000))'((0 . "LWPOLYLINE")(8 . "TR_UP"))))

и в общем-то такая конструкция будет срабатывать не 9 раз из 10, а может и все 10 раз не сработать, так при формировании набора с помощью методов "_F" тому подобных ("W", "WP", "C" и т. д.) корректность возвращаемого набора зависит от нескольких дополнительных факторов: границ видимость (т. е. если ваш примитив (полиниия) находяться вне видимой части экрана, то он может и не попасть в набор), можно перед ssget'ом зуммировать экран соответсвующем образом, но это мягко говоря будет плохо выгладет (когда во время выполнения программы экран начнет дергаться), лучше выбрать все полилинии на каком-то слое (ssget "_X" (list (cons 0 "LWPOLYLINE") (cons 8 "TR_UP"))) , а потом по дополнительным проверкам оставить нужную вам или вообще по-другому получать нужный примитив с чертежа

[Pontelimon]

На мой взгляд линия попадает в набор, но может я ошибаюсь. В любом случае спасибо за совет, я обязательно учту это.

Пересохранил файл для 2007 акада.

[TararykovDG]

Посмотрел файл. Дело вот в чем, при проверке

Код:

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

 
(= (+ minx 4) (cadr x))

для первой координаты получаем (= 662 662.0) что возвращает nil, так оно и есть. Можно даже срвнить (= 662.0 662.0) и в некоторых случаях получить nil (не равны)

Нужно сравнивать так

Код:

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

 
(equal (+ minx 4) (cadr x) 0.001) ; или вместо 0.001 подставть свою точность

[Pontelimon]

хмм... действительно, спасибо, помогло. Но почему так ? почему в 1 случае они могут быть равны, а в другом нет ? я про (= 662.0 662.0) .

[TararykovDG]

Ну если написать вручную (= 662.0 662.0) то они конечну будут равны, а вот если числа получаются в результате вычислений, то не всегда

Код:

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

 
_$ (= 12.0 12.0)
T ; равны
$ (setq a 12.000000000)
12.0
_$ (setq b 12.000001)
12.0
_$ a b
12.0
12.0
_$ (= a b)
nil ; не равны

Все дело в точности представления вещественных чисел. Вообще сравнивать вещественные числа с помощью (< > <= и т. д.) не корректно ни на каком языке программирования (во всяской случае известных мне). На лиспе можно использовать equal. Или можно сравнить разность с нулем

Код:

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

 
_$ (- a b)
-1.0e-006

[Дима_]

Сообщение от Disney Для чего мы сокращали количество проходов, если это ни привело ни к ускорению программы, ни к понятности кода для широких масс? Чем lambda лучше defun? Выложи наконец-то чисто свой код, который бы ты написал для себя безо всяких образовательных целей

Я блогаполучно "переместился" в Сибирь - с интернетом тут более менее порядок, но к разнице во времени пока еще не адаптировался, по существу:
1. см. # 46-1 + если попробывать чуть-чуть изменить Т.З. - например проверять "действительные координаты" (trans ...), и подумать насколько изменится программа в #42 и #48. в #48 в "любой" точке программы доступны все необходиммые данные, что не скажешь про 42 (там где мы отделяем значение по х - уже ничего не доступно о том откуда она взялась). mapcar - чудесная функция, но в передаваемой процедуре доступен только один элемент списка(ов) (причем в "явном виде" неизвестно какой первый?, последний? и пр), что уж говорить если "вдруг понадобится" переделывать с учетом расстояний от предыдущей точки...
2. По мне дефун это (setq(lambda ...)) - прочем setq - это тоже своего рода "глабальная" лямбда - если функция используется в одном месте, то зачем засорять имена, и уж тем более не вижу смысла "дефунить" временные переменные (пожалуй за эксключением *error* - да и то он устарел).
3. Я бы написал как в #48, но функцию min-x использовал бы по аналогии с #42 - (mapcar 'cadr (vl-remove...)) - т.к. все равно "читать весь" dxf - проще mapcar'ом, но в тоже время в его лямбде - все данные доступны.

[Pontelimon]

Есть такая замечательная функция nentsel , с ее помощью я могу добраться до примитива, который сидит в блоке, но как ее применить к набору ?

Вобщем что-то вроде этого:

Код:

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

 (setq nabor_blokov (ssget ":L"(list (cons 0 "INSERT"))))
(setq primitiv (car(nentsel(ssname nabor_blokov 0))))

Нужно добраться как-то до примитива внутри блока ...

[Дима_]

Сообщение от Pontelimon Есть такая замечательная функция nentsel , с ее помощью я могу добраться до примитива, который сидит в блоке, но как ее применить к набору ?

Забудь - это функция для запроса у пользователя, как доставать примитивы из описания блока - поищи по форуму не раз обсуждалось.

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

Сообщение от Pontelimon Нужно добраться как-то до примитива внутри блока ...

А этот "примитив" часом не атрибут?

[Pontelimon]

Сообщение от Кулик Алексей aka kpblc А этот "примитив" часом не атрибут?

Не обычный блок внутри которого находиться 1 примитив (MTEXT) вот я хотел добраться до его значения.

В итоге я получил вот это:

Код:

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

 (cdr(assoc 1(entget(cdr(assoc -2(tblsearch "block"(cdr(assoc 2(entget(car(entsel)))))))))))

entsel это для наглядности, в итоге само имя блока через ssget конечно =)

[Лиспер]

Можно и по-другому Для любого блока, для любого состава

Код:

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

 (vl-load-com)

(defun _dwgru-get-block-content (ent / lst)
                                ;|
*    Получение списка vla-указателей на состав блока
*    Параметры вызова:
	ent : указатель на блок. Возможные значения:
		vla- или ename-указатель на вхождение блока
		vla- или ename-указатель на описание блока
		строка имени блока
|;
  (cond
    ((and (= (type ent) 'str)
          (tblobjname "block" ent)
          ) ;_ end of and
     (_dwgru-get-block-content
       (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) ent)
       ) ;_ end of _dwgru-get-block-content
     )
    ((= (type ent) 'ename)
     (_dwgru-get-block-content (vlax-ename->vla-object ent))
     )
    ((and (= (type ent) 'vla-object)
          (= (vla-get-objectname ent) "AcDbBlockReference")
          ) ;_ end of and
     (_dwgru-get-block-content
       (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) (vla-get-name ent))
       ) ;_ end of _dwgru-get-block-content
     )
    ((and (= (type ent) 'vla-object)
          (= (vla-get-objectname ent) "AcDbBlockTableRecord")
          ) ;_ end of and
     (vlax-for item ent
       (setq lst (cons item lst))
       ) ;_ end of vlax-for
     (reverse lst)
     )
    ) ;_ end of cond
  ) ;_ end of defun