[petr.vubrikv]

Помогите пожалуйста создать на lisp список блоков чертежа, содержащих растровые картинки, если таковые имеются. Это должно быть в виде типа
((("Block1") ("Карта1")) (("Block2") ("Карта21" "Карта22")) (...) ...........)

Большое спасибо.

[gomer]

В справке для разработчика все написано...

[Дима_]

Код:

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

(vl-load-com)
(defun listblock (obj / lst) ; возращает список примитивов во вхождении блока, либо блоке obj.
(if (or (= (type obj) 'str) (= (cod 0 obj) "INSERT"))
(progn
(if (= (type obj) 'ename) (setq obj (cod 2 obj)))
(setq obj (cdr (assoc -2 (tblsearch "BLOCK" obj))))
(while obj
(setq	lst (cons obj lst)
	obj (entnext obj)
);end of setq
);end of while
));end of progn&if
(reverse lst)
);end of listblock

(defun tblnamelist ( tbl / obj lst) ;возращает список запрашиваемых объектов: "block","layer" итп.
(setq obj (tblnext tbl T))
(while obj (setq lst (append lst (list (cdr (assoc 2 obj)))) obj (tblnext tbl)))
lst
);end of blocknamelist

(vl-remove-if-not 'cdr
(mapcar '(lambda (name)
		(cons name (vl-remove nil (mapcar '(lambda (ent)
	(if (= (cdr (assoc 0 (entget ent))) "IMAGE") (vla-get-name (vlax-ename->vla-object ent))))
	(listblock name)))))
(tblnamelist "block")))

жирный кусок "вставь" по назначению

[gomer]

я думаю список так должен выглядить вообще-то(асоциативно т.е.):
'(("Block1" . ("Карта1")) ("Block2" . ("Карта21" "Карта22")) (...) ....)

[Дима_]

Для ассоциативности вполне достаточно '(("block" "карта1" "карта2"...)), как впрочем и сделанно у автодеска во всех DXF длинне пары.

[petr.vubrikv]

Дима_
Ох, и не знаю как благодарить. Выручили.
И насчет ассоциативности я с Вами согласен: '(("block" "карта1" "карта2"...)) ,-самое то !
Спасибо.

[petr.vubrikv]

Дима_
Прошу прощения, не подскажете, что за функция такая "cod" у Вас применена ?

(defun listblock
...
(if (or (= (type obj) 'str) (= (cod 0 obj) "INSERT"))
...
(if (= (type obj) 'ename) (setq obj (cod 2 obj)))
...

Спасибо.

[VVA]

Отвечу за Диму. Ф-ция возвращает первое вхождение точечной пары DXF списка. Переименуй ф-цию ниже в cod

Код:

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

;|  ! ***************************************************************************
;; !                           lib:dxf
;; ! ***************************************************************************
;; ! Function : Returns the first occurence of a DXF dotted pair from a list
                Возвращает первое вхождение точечной пары DXF списка
;; ! Argument : 'n'     - The DXF code to check / DXF код
;; !            'lst' -    The List to check  / Список
;; ! Returns  : The value of the DXF dotted pair, if it exists else returns nil
                Значение точечной пары, если есть или nil
;; ! ****************************************************************************|;

(defun lib:dxf (n lst)(if (= (type lst) 'ENAME)(setq lst (entget lst)))(cdr (assoc n lst)))

[Дима_]

Когда "выдергивал" из "своей библиотеки" проглядел - в "жирном" варианте до нее не "доходит" т.к. на вход всега поподает аргумент типа 'str. В "моем оригинале" вот она:

Код:

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

(defun cod (cd obj) ; возращает код cd примитива obj.
(if (and obj (= (type obj) 'ename))
(cdr (assoc cd (entget obj)))
));end of cod

[petr.vubrikv]

Большое спасибо.