Господа активиксные лиспсисты, помогите разобраться.
Задача: из DXF кода стиля мультилинии (340) mlst сделать три списка повсем элементам - ofs для значений отступа, cofs для цвета элемента и ltofs для типа линии.
Вопрос: отчего
(foreach n mlst
(cond ((= (car n) 49) (setq ofs (cons (cdr n) ofs)))
((= (car n) 62) (setq cofs (cons (cdr n) cofs)))
((= (car n) 6) (setq ltofs (cons (cdr n) ltofs))));cond
);foreach
работает прекрасно, а вроде бы более элегантное
(mapcar '(lambda (x y)
(foreach n mlst (if (= (car n) x) (setq y (cons (cdr n) y)))));lambda
'(49 62 6) (list ofs cofs ltofs));mapcar
не видит численных значений и формитрует соотв. список только для строковых атомов ltofs. :? В чем здесь дело :?:

[Alaspher]

Если я правильно понял, то нужно что-то типа:

Код:

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

(lst8lst (cdr (mapcar (function cdr)
                      (vl-remove-if-not
                        (function (lambda (x)
                                    (vl-position (car x) '(49 62 6))
                                  )
                        )
                        mlst
                      )
              )
         )
         3
)

где 'lst8lst':

Код:

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

(defun lst8lst (lst modul / _str8lst _str8lstst)
  (defun _lst8lst (slst i mod / tmp)
    (cond ((not slst) nil)
	  ((zerop i) (cons (list (car slst)) (_lst8lst (cdr slst) mod mod)))
	  (t
	   (setq tmp (_lst8lst (cdr slst) (1- i) mod))
	   (cons (cons (car slst) (car tmp)) (cdr tmp))
	  )
    ) ;_ end of cond
  ) ;_ end of defun
  (_lst8lst lst (1- modul) (1- modul))
) ;_ end of defun

Alaspher,
Честно говоря, я в ваш код въехать не смог, однвко заметил, что вложенный defun _lst8lst ссылается сам на себя. Нет ли там какой-нидь ачепятки? И честно говоря, я не увидел в вашем коде формирования трех независимых списеов. растолкуйте, плиз.

[Alaspher]

Сообщение от Лентяй ...вложенный defun _lst8lst ссылается сам на себя. Нет ли там какой-нидь ачепятки?

Так и задумано, рекурсия - называется.

И честно говоря, я не увидел в вашем коде формирования трех независимых списеов. растолкуйте, плиз.

Вот та рекурсия и формирует отдельные списки - режет переданый ей список на подсписки "по 3".

P.S. Добавка - забыл. Подсписки формируются по принципу - один подсписок, на один элемент мультилинии, а не один на свойство.

[Олег (jr.)]

______________________
Неск. вариантов на выбор :

(setq ofs nil cofs nil ltofs nil a nil)

(foreach i '(49 62 6) (foreach p mlst
(if (equal i (car p))(setq a (cons (cdr p) a)))))
(mapcar 'set '(ofs cofs ltofs) (reverse a))
; Check :
(print ofs)
(print cofs)
(print ltofs)

(mapcar 'set '(ofs cofs ltofs)
(mapcar 'cdr
(vl-remove-if-not '(lambda (x)
(member (car x)'(49 62 6))) mlst)))
; Check :
(print ofs)
(print cofs)
(print ltofs)

А можно прописать свою собственную
функцию :

(defun dxf-list (elist test_list)
(if test_list
(cons (cdr (assoc (car test_list) elist))
(dxf-list elist (cdr test_list) ))))
; Check :
(mapcar 'set '(ofs cofs ltofs)
(dxf-list mlst '(49 62 6)))

Или классическим ЛИСПом
(Спасибо финским братьям) :

(defun dxf-list2 (elist test_list)
(cond ((null test_list) nil)
(T (cons (cdr (assoc (car test_list) elist))
(dxf-list2 elist (cdr test_list))))))
; Check :
(mapcar 'set '(ofs cofs ltofs)
(dxf-list2 mlst '(49 62 6)))

~'O'~

Alaspher
"Так и задумано, рекурсия - называется"

Про рекурсии - это знаемо. Удивился отсутсвию в теле функции специфицированных параметров _str8lst и _str8lstst.

"Добавка - забыл. Подсписки формируются по принципу - один подсписок, на один элемент мультилинии, а не один на свойство."

Мерси, коллега, но это - неот той стенки гвоздь. Мне нужны списки по свойствам.

Олегу.
Спасибо. Вариант 2 ине нравится больше всех.

Однако, будет ли лбъяснение, почему моя функция не видит численных значений, а только строковые?

Предыдущее было мое.
Олег, я проверил варианты 1 и 2. Оба останавливаются после первого цикла, формируя одноатомные списки. Так что, звиняйте, дядьку, - не работают. Пришлочь сделать

Код:

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

(setq pp (mapcar 'cdr 
  (cdr (vl-remove-if-not '(lambda (x) (member (car x)'(49 62 6))) mlst))))
  (while pp
    (setq ofs (cons (car pp) ofs)
            cofs (cons (cadr pp) cofs)
            ltofs (cons (caddr pp) ltofs)
            pp (cdddr pp))
  );while

Это работает

[Олег (jr.)]

Элементарная проверка :

(setq ofs nil ltofs nil cofs nil comm nil)
(repeat 3
(setq en (car (entsel)))
(setq mlst (entget en))
(mapcar 'set '(ofs cofs ltofs)
(mapcar 'cdr
(vl-remove-if-not '(lambda (x)
(member (car x)'(48 62 6))) mlst)))
(setq comm (append comm (list (list ofs cofs ltofs)))))

(print comm)

RESULT : ((6 "ByBlock" 15.0)
(1 "ByBlock" 15.0)
(5 "ByBlock" 12.0))

49-й код у меня отсутствует, заменил на 48.
Точно так же работают все три остальных функции
Делай выводы

[Alaspher]

Сообщение от Anonymous Мерси, коллега, но это - неот той стенки гвоздь. Мне нужны списки по свойствам... Однако, будет ли лбъяснение, почему моя функция не видит численных значений, а только строковые?

Код:

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

(setq ofs nil
      cofs nil
      ltofs nil
)

(setq mlst (dictsearch (cdr (assoc -1 (dictsearch (namedobjdict) "acad_mlinestyle"))) "new")) ;_ для стиля "new"

(mapcar '(lambda (x y)
           (foreach n mlst
             (if (= (car n) x)
               (set y (cons (cdr n) (eval y)))
             )
           )
         )
        '(49 62 6)
        (list 'ofs 'cofs 'ltofs)
)

Олегу
В том-то и дело, что ваша программа (без последней модификации с repeat) выдает только первые атомы каждого спика, а это совсем не то, что мне было нужно. Мне нужны многоатомные списки типа
ofs = '(0.75 0.5 0.0 -0.5 -0.75)
cofs = '(256 2 256 3 256)
ltofs = '("bylater" "bylater" "bylater" "bylater" "bylater"),
причем в порядке следования элеменитов в описании стиля мультилинии независимо от количества элеменитов. Кстати, код 49 - значение отступа для каждого элемента, так что его не может не быть.

Alaspher'у
Проверил вашу программу - все тоже самое? т.е.она правильно выдает список со строковыми атомами, а с численными - полный nil, причем в единственном числе - ofs = nil, cofs = nil. Кстати, ваш способ открытия списка стиля требует указания имени стиля, т.е. использования (assoc 2 (entget выбранная_мультилиния)), тогда как как код 340 обращается к списку стиля этой мультилинии непосредственно. Однако, все равно спасибо за выше участие.

[Олег (jr.)]

"Чтобы накормить голодного, дайте не рыбу ,а удочку ..."

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

[Alaspher]

Сообщение от Лентяй Alaspher'у Проверил вашу программу - все тоже самое? т.е.она правильно выдает список со строковыми атомами, а с численными - полный nil, причем в единственном числе - ofs = nil, cofs = nil. Кстати, ваш способ открытия списка стиля требует указания имени стиля, т.е. использования (assoc 2 (entget выбранная_мультилиния)), тогда как как код 340 обращается к списку стиля этой мультилинии непосредственно. Однако, все равно спасибо за выше участие.

Какая разница, через что получать DXF? Ну пусть указанием на объект:

Код:

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

(setq ofs nil 
      cofs nil 
      ltofs nil 
) 

(setq mlst (entget (cdr (assoc 340 (entget (car (entsel)))))))
 
(mapcar '(lambda (x y) 
           (foreach n mlst
             (if (= (car n) x) 
               (set y (cons (cdr n) (eval y))) 
             ) 
           ) 
         ) 
        '(49 62 6) 
        (list 'ofs 'cofs 'ltofs) 
)

... один хрен - что так, что эдак - получаем в указанные переменные полный список всех желаемых кодов. По крайней мере, в R15 и R16.

один хрен - что так, что эдак - получаем в указанные переменные полный список всех желаемых кодов. По крайней мере, в R15 и R16.

Думаю, что вы правы. Полные спски должны формироваться в любом случае. Однако, на моем конкретном домашнем писюке этого не происходит. Подзреваю, что с моим R15-тым CAD'ом что-то не в порядке. Например, не говоря уже о списках, он почемуто вы дает variants в всех случаях запроса списка точки - и в (vla-get-StartPoint obj), и в (vlax-get-property obj 'StartPoint), хотя во втором - должен быть открытый список. А вот. на бывшем рабочеи компьютере это не происходило и все шло как надо, хотя и там и тут - та же версия WIN200 и тот же A2K. С чего бы это?