Изменение порядка прорисовки объектов
На самом деле это - небольшая памятка самому себе. О том, как можно программно поменять порядок прорисовки объектов в AutoCAD...
... не используя командные методы, естественно 
С командами все просто до ужаса: выбрали объект(ы), потом _.draworder и понеслась душа в рай. Но, откровенно говоря, как-то лично мне интересно было написать код, который работает без команд.
Кто сказал "написать"? Найти - более верное слово Минут 5 поиска привели на соответствующую тему на dwg.ru.
Добавить к коду Alaspher'a практически нечего. Небольшая договоренность: универсальности в коде должно быть максимум, все обрабатываемые объекты гарантированно принадлежат одному пространству и одному документу, добавляем обработку неактивного документа. Минимум модификаций - и мы получаем:
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 | (defun _lispru-draworder (obj-list obj-base method) ;| * Меняет порядок прорисовки объектов * Параметры вызова: obj-list список vla-указателей на объекты obj-base vla-указатель на опорный объект для помещения "за объектом" или "перед объектом" method бит, указывающий порядок: 0 Позади всех 1 Позади объекта 2 Перед объектом 3 На передний план * Примеры вызова: (_lispru-draworder (mapcar (function vlax-ename->vla-object) (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget "_:L"))))) nil 0) (_lispru-draworder (mapcar (function vlax-ename->vla-object) (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget "_:L"))))) nil 1) (_lispru-draworder (mapcar (function vlax-ename->vla-object) (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget "_:L"))))) (vlax-ename->vla-object (car (entsel "\nПозади объекта : "))) 1) (_lispru-draworder (mapcar (function vlax-ename->vla-object) (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget "_:L"))))) (vlax-ename->vla-object (car (entsel "\nПеред объектом : "))) 2) (_lispru-draworder (mapcar (function vlax-ename->vla-object) (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget "_:L"))))) nil 1) (_lispru-draworder (mapcar (function vlax-ename->vla-object) (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget "_:L"))))) nil 3) |; (cond ((and (= method 1) (not obj-base)) (_lispru-draworder obj-list nil 0) ) ((and (= method 2) (not obj-base)) (_lispru-draworder obj-list nil 3) ) (t ((lambda (/ dict tbl) ;; Используем код из http://autolisp.ru/2011/07/07/x32x64objectid/ (setq dict (vla-getextensiondictionary (_lispru-objectidtoobject (vla-get-document (car obj-list)) (vla-get-ownerid (car obj-list))) ) ;_ end of vla-GetExtensionDictionary tbl (vl-catch-all-apply (function (lambda () (vla-getobject dict "ACAD_SORTENTS") ) ;_ end of lambda ) ;_ end of function ) ;_ end of vl-catch-all-apply ) ;_ end of setq (if (vl-catch-all-error-p tbl) (vla-addobject dict "ACAD_SORTENTS" "AcDbSortentsTable") ) ;_ end of if (setq obj-list (vlax-safearray-fill (vlax-make-safearray vlax-vbobject (cons 0 (1- (length obj-list)))) obj-list) ) ;_ end of setq (cond ((= method 0) (vla-movetobottom tbl obj-list)) ((= method 1) (vla-movebelow tbl obj-list obj-base)) ((= method 2) (vla-moveabove tbl obj-list obj-base)) ((= method 3) (vla-movetotop tbl obj-list)) ) ;_ end of cond ) ;_ end of lambda ) ) ) ;_ end of cond ) ;_ end of defun |
Исходник кода: _lispru-draworder
Вроде бы пока работает...
В коде используются исходники из темы Работа с ObjectID в 64- и 32-разрядных системах:
_lispru-objectidtoobject
