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

Код:

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

(defun _dwgru-block-get-attr-by-mask (block-ref mask / res)
                                     ;|
*    Получение указателей на атрибуты вхождения блока
*    Параметры вызова:
	block-ref	указатель на вхождение блока
	mask		маска тэга атрибута
|;
  (if (not mask)
    (setq mask "*")
    ) ;_ end of if
  (if (_dwgru-is-ent-block-reference block-ref)
    (vl-remove-if-not
      '(lambda (x)
         (or x
             (wcmatch (strcase (vla-get-tagstring x)) (strcase mask))
             ) ;_ end of or
         ) ;_ end of lambda
      (apply 'append
             (mapcar '_dwgru-conv-value-to-list
                     (list
                       (vla-getattributes
                         (setq block-ref (_dwgru-conv-ent-to-vla block-ref))
                         ) ;_ end of vla-GetAttributes
                       (vla-getconstantattributes block-ref)
                       ) ;_ end of append
                     ) ;_ end of mapcar
             ) ;_ end of apply
      ) ;_ end of vl-remove
    ) ;_ end of if
  ) ;_ end of defun

Используемые функции:

• _dwgru-conv-ent-to-vla
• _dwgru-conv-value-to-list
• _dwgru-is-ent-block-reference

[gabrin]

2Кулик Алексей aka kpblc. Подскажите а как этим всем пользоваться

[Mozgunov]

Добрый день! Скажите пожалуйста, почему я не могу получить при помощи этой функции указатель на атрибут динамического блока?

[Soldat_OV]

Кулик Алексей aka kpblc, в списке используемых функций последняя ссылка нерабочая. Подскажите, где можно найти ее?

[gomer]

Код:

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

 (defun _dwgru-property-get (obj prop)
;;;  Получение значения свойства объекта.
;;;
;;;  Параметры вызова:
;;;    obj -  указатель на объект. Допускается применение ename, vla, строки. В
;;;           последнем случае воспринимается как хендл объекта.  
;;;   prop -  имя свойства. Может быть строкой или атомом
;;;
;;;  Возвращает значение указанного свойства. Если свойства у объекта нет,
;;;  возвращает nil.
;;;
;;;  Примеры вызова:
;|
  
    (_dwgru-property-get (vla-get-ActiveDocument (vlax-get-acad-object))
                         'activelayer
    )
    ; #<VLA-OBJECT IAcadLayer2 064b04e4>

    (_DWGRU-PROPERTY-GET (vla-get-ActiveDocument (vlax-get-acad-object))
         'layer)
     ; nil
|;

    (if (and (setq obj (_dwgru-conv-ent-to-vla obj))
             (vlax-property-available-p obj prop)
        )
        (vlax-get-property obj prop)
    ) ;_ end of if
)

(defun _dwgru-is-ent-block-reference (ent)

;;;    Проверяет, является ли переданный примитив указателем на вхождение
;;;  блока (BlockReference).
;;;
;;;  Параметры вызова:
;;;      ent - проверяемый примитив. Допустимые значения:
;;;            ename
;;;            vla-object
;;;            string, обрабатывается как хендл примитива
;;;
;;;  Возвращает
;;;      t (объект - вхождение блока) или nil (любой иной объект)
;;;
;;;  Примеры вызова:
;|

    (_dwgru-is-ent-block-reference
       (car (entsel "\nУкажите любой объект : "))
    )
     
|;

    (and (=  "AcDbBlockReference"
             (_dwgru-property-get ent (quote objectname))
    
         )
         (not (_dwgru-property-get ent (quote path)))
    )
)

(defun _dwgru-conv-ent-to-vla (ent)
;;;  Выполняет преобразование переданного указателя в vlax-вариант
;;;  Параметры вызова:
;;;    ent - обрабатываемый указатель.
;;;          Может быть:
;;;          ename
;;;          vla-object
;;;          строка (воспринимается как хендл примитива).
;;; Примеры вызова:
;|

    (setq entity (entmakex (list (cons 0 "POINT") (cons 10 (getpoint)))))
    (_dwgru-conv-ent-to-vla entity)
    ; #<VLA-OBJECT IAcadPoint 064ad294>
    
|;

    (cond
      ((= (type ent) (quote vla-object)) ent)
      ((= (type ent) (quote ename)) (vlax-ename->vla-object ent))
      ;|
      ;; Оригинальный вариант:
      ((= (type ent) 'str) (vlax-ename->vla-object (handent ent)))
      |;
      ;; Исправления Alaspher от 28.11.2007. Начало.
      ((= (type ent) (quote str))
        (if (setq ent (handent ent))
          (vlax-ename->vla-object ent)
        ) ;_ end of if
      )
      ;; Исправления Alaspher от 28.11.2007. Конец
      (t nil)
    ) ;_ end of cond
  ) ;_ end of defun
  
  (defun _dwgru-conv-safearray-to-list (value)
;;; ===========  _dwgru-conv-safearray-to-list =================================
;;; Преобразовывает vlax-safearray в обычный список
;;; value - безопасный массив (safearray)
;;; Возврат:
;;;;      - список значений
;;;;      - nil если не safearray
;;;; Пример
;|
    (setq lst '(1 2 3))
    (setq lst1 (vlax-safearray-fill
                 (vlax-make-safearray vlax-vbVariant
                                      (cons 0 (1- (length Lst))))Lst))
    (_DWGRU-CONV-SAFEARRAY-TO-LIST Lst1) 
    ;_ (1 2 3)
    
    (_DWGRU-CONV-SAFEARRAY-TO-LIST "123")
    ;_ nil

|;

    (if (= (type value) (quote safearray))
      (if (>= (vlax-safearray-get-u-bound value 1) 0)
        (mapcar (function
                  (lambda (x)
                     (if (= (type x) (quote variant))
                       (vlax-variant-value x)
                       x
                     ) ;_ end of if
                  ) ;_ end of lambda
                ) ;_ end of function
                (vlax-safearray->list value)
        ) ;_ end of mapcar
      ) ;_ end of if
    ) ;_ end of if
) ;_ end of defun


(defun _dwgru-conv-variant-to-list (value / res)

;;; ===========  _dwgru-conv-variant-to-list ===================================
;;; Преобразовывает vlax-variant в обычный список
;;; value - variant массив
;;; Возврат:
;;;      - список значений
;;;      - nil если не variant
;;; Пример
;|
    (setq lst '(1 2 3))
    (setq lst1 (vlax-make-variant
                 (vlax-safearray-fill
                   (vlax-make-safearray vlax-vbVariant
                                        (cons 0 (1- (length Lst))))
                   '(1 2 3)
                 )
               )
   )
   (_DWGRU-CONV-VARIANT-TO-LIST Lst1)
   ;_ (1 2 3)
   
   (_DWGRU-CONV-VARIANT-TO-LIST "123")
   ;_ nil
   
   (_dwgru-conv-variant-to-list
           (vlax-make-variant 1 vlax-vbInteger)
   ) 
   ;_ (1)
|;

    (if (= (type value) (quote variant))
      (if (= (type (setq res (vlax-variant-value value)))
             (quote safearray)
          )
          (_dwgru-conv-safearray-to-list res)
          (list res)
      )
    )
)


(defun _dwgru-conv-vla-object-to-list (value / res)

;;; ===========  _dwgru-conv-vla-object-to-list =========================
;;; Преобразовывает ... не могу сформулировать :(
;;; value - объект со свойством count
;;; Возврат:
;;;      - список vla-объектов 
;;;      - nil если не объект или нет сво-вы count

    (if (and (= (type value) (quote vla-object))
             (vlax-property-available-p value (quote count))
             (> (vla-get-count value) 0)
        )
        (reverse (vlax-for item value (setq res (cons item res))))
    )
) ;_ end of defun



(defun _dwgru-conv-value-to-list (value / itype)

;;; ===========  _dwgru-conv-value-to-list =====================================
;;; Функция - скелектор
;;; Преобразовывает значение value в список
;;; value - переменная autolisp
;;; Возврат:
;;;      - список (nil это тоже вписок)
;;;*    Примеры вызова:
;|

;;; #1:
    (setq point (vla-addpoint
                   (vla-get-ModelSpace
                     (vla-get-ActiveDocument
                       (vlax-get-acad-object)))
                  (vlax-3d-point '(10 20 30))))

    (_dwgru-conv-value-to-list (vla-get-Coordinates point))
    ; '(10 20 30)
    
;;; #2:

    (setq ent1 (vlax-ename->vla-object
                 (entmakex '((0 . "LINE")
                             (10 574.761 426.116 0.0)
                             (11 1054.08 878.378 0.0))))
     
          ent2 (vlax-ename->vla-object
                 (entmakex '((0 . "LINE")
                             (10 967.833 561.795 0.0)
                             (11 779.78 335.664 0.0)))))

    (_dwgru-conv-value-to-list (vla-IntersectWith ent1 ent2 acExtendNone))
    ; nil
    (_dwgru-conv-value-to-list (vla-IntersectWith ent1 ent2 acExtendBoth))
    ; '(1876.15 1654.04 0.0)
;; #3:
    (_dwgru-conv-value-to-list "A")
    ;_ ("A")
|;


    (setq itype (type value))
    (cond
        ((not itype) nil)
        ((= itype (quote list)) value)
        ((= itype (quote variant))
            (_dwgru-conv-variant-to-list value)
        )
        ((= itype (quote safearray))
            (_dwgru-conv-safearray-to-list value)
        )
        ((= itype (quote vla-object))
            (_dwgru-conv-vla-object-to-list value)
        )

        (T (list value))
    )
) ;_ end of defun

[roaa]

Пользуюсь этим

Код:

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

 (defun _Att_in_blk ( obj lsttag /)
;;; Проверка блока на наличие имени атрибута из списка
;;; Получение указателей на атрибуты вхождения блока
;;; lsttag - список атрибутов (маски функции wcmatch)
;;; Пример запуска:
;;; Все атрибуты (_Att_in_blk (vlax-ename->vla-object (car (entsel))) nil)
;;; Определенный (car (_Att_in_blk (vlax-ename->vla-object (car (entsel))) "ВIAS"))
;;; Первый подходящий из списка 
;;; (car (_Att_in_blk (vlax-ename->vla-object (car (entsel)))(list "ВIAS" "ВТН")))

  (cond 
    ((not lsttag)(setq lsttag (list "*")))
    ((atom lsttag)(setq lsttag (list lsttag)))
  ) ;_ end of cond
  (vl-member-if 
   '(lambda (x)
      (apply 'wcmatch 
        (list 
          (strcase (vla-get-TagString x))
          (apply 'strcat 
            (mapcar '(lambda (str)(strcase (strcat str ","))) lsttag)
          ) ;_ end of apply
        ) ;_ end of cons
      ) ;_ end of apply
    ) ;_ end of lambda
    (vl-catch-all-apply
	   '(lambda ()
	      (append 
	        (vlax-invoke obj 'Getattributes)
		(vlax-invoke obj 'Getconstantattributes)
	      ) ;_ end of append
	    ) ;_ end of lambda
	  ) ;_ end of vl-catch-all-apply
  ) ;_ end of vl-member-if
) ;_ end of defun