Тема: LISP. Изменение свойств(а) динамических блоков.

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

(defun _kpblc-change-dyn-block-prop (ent name value / adoc prop value_lst blk)
                                    ;|
*    Функция изменения свойства динамического блока.
*    Параметры вызова:
*    ent    указатель на блок (vla-, ename или string). Строка воспринимается
        как хендл объекта. nil -> запрашивается у пользователя
*    name    имя дин.свойства
*    value    новое значение
*    Функция проверяет, является ли переданный примитив указателем на динамический
* блок, наличие у этого дин.блока указанного свойства и возможности назначения
* value.
|;
  (vl-load-com)
  (vl-catch-all-apply
    '(lambda ()
       (setq ent (cond (ent)
                       (t (car (entsel "\nУкажите блок <Отмена> : ")))
                       ) ;_ end of cond
             ) ;_ end of setq
       ) ;_ end of lambda
    ) ;_ end of vl-catch-all-apply
  (vla-startundomark
    (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
    ) ;_ end of vla-StartUndoMark
  (if
    (vl-catch-all-error-p
      (vl-catch-all-apply
        (function
          (lambda ()
            (if
              (and (setq
                     ent (cond
                           ((= (type ent) 'ename) (vlax-ename->vla-object ent))
                           ((= (type ent) 'vla-object) ent)
                           ((= (type ent) 'str)
                            ((lambda (/ tmp)
                               (vl-catch-all-apply
                                 '(lambda () (setq tmp (vla-handletoobject ent)))
                                 ) ;_ end of vl-catch-all-apply
                               tmp
                               ) ;_ end of lambda
                             )
                            )
                           (t nil)
                           ) ;_ end of cond
                     ) ;_ end of setq
                   (= (strcase (vla-get-objectname ent) t) "acdbblockreference")
                   (= (vla-get-isdynamicblock
                        (setq
                          blk (vla-item (vla-get-blocks adoc)
                                        (vla-get-effectivename ent)
                                        ) ;_ end of vla-item
                          ) ;_ end of setq
                        ) ;_ end of vla-get-isxref
                      :vlax-true
                      ) ;_ end of =
                   name
                   (= (type name) 'str)
                   value
                   (setq
                     prop (car (vl-remove-if-not
                                 '(lambda (x)
                                    (= (strcase (vla-get-propertyname x))
                                       (strcase name)
                                       ) ;_ end of =
                                    ) ;_ end of lambda
                                 (vlax-safearray->list
                                   (vlax-variant-value
                                     (vla-getdynamicblockproperties ent)
                                     ) ;_ end of vlax-variant-value
                                   ) ;_ end of vlax-safearray->list
                                 ) ;_ end of vl-remove-if-not
                               ) ;_ end of car
                     ) ;_ end of setq
                   (member
                     value
                     (mapcar 'vlax-variant-value
                             (vlax-safearray->list
                               (vlax-variant-value (vla-get-allowedvalues prop))
                               ) ;_ end of vlax-safearray->list
                             ) ;_ end of mapcar
                     ) ;_ end of member
                   ) ;_ end of and
               (progn
                 (vla-put-value
                   prop
                   (vlax-make-variant
                     value
                     (vlax-variant-type (vla-get-value prop))
                     ) ;_ end of vlax-make-variant
                   ) ;_ end of vla-put-value
                 (vla-update ent)
                 ) ;_ end of progn
               (princ "\nТакого значения или свойства в блоке нет")
               ) ;_ end of if
            ) ;_ end of lambda
          ) ;_ end of function
        ) ;_ end of vl-catch-all-apply
      ) ;_ end of vl-catch-all-error-p
     (princ (strcat "\nОшибка выполнения :: " (itoa (getvar "errno"))))
     ) ;_ end of if
  (vla-endundomark adoc)
  (princ)
  ) ;_ end of defun

Re: LISP. Изменение свойств(а) динамических блоков.

1. Можно еще функцию наваять, которая выдаёт возможные значения и свойства для блока?
2. Какой value для "Flip state"?

Re: LISP. Изменение свойств(а) динамических блоков.

> krieger
Сюда же? Или в отдельную тему?

Re: LISP. Изменение свойств(а) динамических блоков.

Как бы то ни было:

(defun _kpblc-get-dyn-block-list-prop-and-values (ent / res)
                                                 ;|
*    Функция получения списка свойств и их возможных значений для дин.блока
*    Параметры вызова:
*  ent  указатель на блок (vla-, ename или string). Строка воспринимается
    как хендл объекта. nil -> запрашивается у пользователя
|;
  (vl-load-com)
  (vl-catch-all-apply
    '(lambda ()
       (setq ent (cond (ent)
                       (t (car (entsel "\nУкажите блок <Отмена> : ")))
                       ) ;_ end of cond
             ) ;_ end of setq
       ) ;_ end of lambda
    ) ;_ end of vl-catch-all-apply
  (if
    (vl-catch-all-error-p
      (vl-catch-all-apply
        (function
          (lambda ()
            (if
              (and (setq
                     ent (cond
                           ((= (type ent) 'ename) (vlax-ename->vla-object ent))
                           ((= (type ent) 'vla-object) ent)
                           ((= (type ent) 'str)
                            ((lambda (/ tmp)
                               (vl-catch-all-apply
                                 '(lambda () (setq tmp (vla-handletoobject ent)))
                                 ) ;_ end of vl-catch-all-apply
                               tmp
                               ) ;_ end of lambda
                             )
                            )
                           (t nil)
                           ) ;_ end of cond
                     ) ;_ end of setq
                   (= (strcase (vla-get-objectname ent) t) "acdbblockreference")
                   (= (vla-get-isdynamicblock
                        (vla-item
                          (vla-get-blocks
                            (vla-get-activedocument (vlax-get-acad-object))
                            ) ;_ end of vla-get-blocks
                          (vla-get-effectivename ent)
                          ) ;_ end of vla-item
                        ) ;_ end of vla-get-isxref
                      :vlax-true
                      ) ;_ end of =
                   ) ;_ end of and
               (setq res
                      (mapcar '(lambda (x)
                                 (cons (vla-get-propertyname x)
                                       (vlax-variant-value (vla-get-value x))
                                       ) ;_ end of cons
                                 ) ;_ end of lambda
                              (vl-remove-if
                                '(lambda (a)
                                   (= (strcase (vla-get-propertyname a)) "ORIGIN")
                                   ) ;_ end of lambda
                                (vlax-safearray->list
                                  (vlax-variant-value
                                    (vla-getdynamicblockproperties ent)
                                    ) ;_ end of vlax-variant-value
                                  ) ;_ end of vlax-safearray->list
                                ) ;_ end of vl-remove-if
                              ) ;_ end of mapcar
                     ) ;_ end of setq
               (princ "\nОшибка указания примитива")
               ) ;_ end of if
            ) ;_ end of lambda
          ) ;_ end of function
        ) ;_ end of vl-catch-all-apply
      ) ;_ end of vl-catch-all-error-p
     (princ (strcat "\nОшибка выполнения :: " (itoa (getvar "errno"))))
     ) ;_ end of if
  res
  ) ;_ end of defun

Вроде пашет...

Re: LISP. Изменение свойств(а) динамических блоков.

Работает..., сразу с "Flip state" разобрался... :)
Тока, функция выдаёт не возможные значения, а текущие значения. Понятно что для параметров типа Linear нельзя их перечислить, но у, например, Visibility State их ограниченное число.

Re: LISP. Изменение свойств(а) динамических блоков.

Не то вставил, сорри. Чтоб ты не мучался с переделыванием кода, попробуй такое чудовище:

(defun _kpblc-get-dyn-block-list-prop-and-values (ent / res)
                                                 ;|
*    Функция получения списка свойств и их возможных значений для дин.блока
*    Параметры вызова:
*  ent  указатель на блок (vla-, ename или string). Строка воспринимается
    как хендл объекта. nil -> запрашивается у пользователя
|;
  (vl-load-com)
  (vl-catch-all-apply
    '(lambda ()
       (setq ent (cond (ent)
                       (t (car (entsel "\nУкажите блок <Отмена> : ")))
                       ) ;_ end of cond
             ) ;_ end of setq
       ) ;_ end of lambda
    ) ;_ end of vl-catch-all-apply
  (if
    (vl-catch-all-error-p
      (vl-catch-all-apply
        (function
          (lambda ()
            (if
              (and (setq
                     ent (cond
                           ((= (type ent) 'ename) (vlax-ename->vla-object ent))
                           ((= (type ent) 'vla-object) ent)
                           ((= (type ent) 'str)
                            ((lambda (/ tmp)
                               (vl-catch-all-apply
                                 '(lambda () (setq tmp (vla-handletoobject ent)))
                                 ) ;_ end of vl-catch-all-apply
                               tmp
                               ) ;_ end of lambda
                             )
                            )
                           (t nil)
                           ) ;_ end of cond
                     ) ;_ end of setq
                   (= (strcase (vla-get-objectname ent) t) "acdbblockreference")
                   (= (vla-get-isdynamicblock
                        (vla-item
                          (vla-get-blocks
                            (vla-get-activedocument (vlax-get-acad-object))
                            ) ;_ end of vla-get-blocks
                          (vla-get-effectivename ent)
                          ) ;_ end of vla-item
                        ) ;_ end of vla-get-isxref
                      :vlax-true
                      ) ;_ end of =
                   ) ;_ end of and
               (setq res
                      (mapcar
                        '(lambda (x)
                           (cons
                             (vla-get-propertyname x)
                             (mapcar 'vlax-variant-value
                                     (vlax-safearray->list
                                       (vlax-variant-value (vla-get-allowedvalues x))
                                       ) ;_ end of vlax-safearray->list
                                     ) ;_ end of mapcar
          ;(vlax-variant-value (vla-get-value x))
                             ) ;_ end of cons
                           ) ;_ end of lambda
                        (vl-remove-if
                          '(lambda (a)
                             (= (strcase (vla-get-propertyname a)) "ORIGIN")
                             ) ;_ end of lambda
                          (vlax-safearray->list
                            (vlax-variant-value
                              (vla-getdynamicblockproperties ent)
                              ) ;_ end of vlax-variant-value
                            ) ;_ end of vlax-safearray->list
                          ) ;_ end of vl-remove-if
                        ) ;_ end of mapcar
                     ) ;_ end of setq
               (princ "\nОшибка указания примитива")
               ) ;_ end of if
            ) ;_ end of lambda
          ) ;_ end of function
        ) ;_ end of vl-catch-all-apply
      ) ;_ end of vl-catch-all-error-p
     (princ (strcat "\nОшибка выполнения :: " (itoa (getvar "errno"))))
     ) ;_ end of if
  res
  ) ;_ end of defun

Re: LISP. Изменение свойств(а) динамических блоков.

И тишина...

Re: LISP. Изменение свойств(а) динамических блоков.

Кулик Алексей aka kpblc пишет:

И тишина...

Иногда я отхожу от компьютера... :)
Код работает, НО, как я понял, только когда там всего один параметр типа Visibility. Как только появляется другой, прога выдает ошибку "Ошибка выполнения :: 2(один раз было 38)" Соответственно с Lookup, который управляет другими параметрами - дохлый номер.

Re: LISP. Изменение свойств(а) динамических блоков.

> krieger
Можешь прислать пример? Я-то тестировал на стандартных дин.блоках...

Re: LISP. Изменение свойств(а) динамических блоков.

Ну и последнее. Благодаря krieger'у, выполнившему тестирование, был выявлен баг: не индексированные свойства выбивали последнюю функцию напрочь. Без такой ошибки код выглядит так:

(defun _kpblc-get-dyn-block-list-prop-and-values (ent / res)
                                                ;|
*    Функция получения списка свойств и их возможных значений для дин.блока
*    Параметры вызова:
*  ent  указатель на блок (vla-, ename или string). Строка воспринимается
   как хендл объекта. nil -> запрашивается у пользователя
|;
 (vl-load-com)
 (vl-catch-all-apply
   '(lambda ()
      (setq ent (cond (ent)
                      (t (car (entsel "\nУкажите блок <Отмена> : ")))
                      ) ;_ end of cond
            ) ;_ end of setq
      ) ;_ end of lambda
   ) ;_ end of vl-catch-all-apply
 (if
   (vl-catch-all-error-p
     (vl-catch-all-apply
       (function
         (lambda ()
           (if
             (and (setq
                    ent (cond
                          ((= (type ent) 'ename) (vlax-ename->vla-object ent))
                          ((= (type ent) 'vla-object) ent)
                          ((= (type ent) 'str)
                           ((lambda (/ tmp)
                              (vl-catch-all-apply
                                '(lambda () (setq tmp (vla-handletoobject ent)))
                                ) ;_ end of vl-catch-all-apply
                              tmp
                              ) ;_ end of lambda
                            )
                           )
                          (t nil)
                          ) ;_ end of cond
                    ) ;_ end of setq
                  (= (strcase (vla-get-objectname ent) t) "acdbblockreference")
                  (= (vla-get-isdynamicblock
                       (vla-item
                         (vla-get-blocks
                           (vla-get-activedocument (vlax-get-acad-object))
                           ) ;_ end of vla-get-blocks
                         (vla-get-effectivename ent)
                         ) ;_ end of vla-item
                       ) ;_ end of vla-get-isxref
                     :vlax-true
                     ) ;_ end of =
                  ) ;_ end of and
              (setq res
                     (mapcar
                       '(lambda (x / еьз)
                          (cons
                            (vla-get-propertyname x)
                            (if (vl-catch-all-error-p
                                  (vl-catch-all-apply
                                    '(lambda ()
                                       (setq tmp (mapcar 'vlax-variant-value
                                                         (vlax-safearray->list
                                                           (vlax-variant-value (vla-get-allowedvalues x)
                                                             ) ;_ end of vlax-variant-value
                                                           ) ;_ end of vlax-safearray->list
                                                         ) ;_ end of mapcar
                                             ) ;_ end of setq
                                       ) ;_ end of lambda
                                    ) ;_ end of vl-catch-all-apply
                                  ) ;_ end of vl-catch-all-error-p
                              (list "Неиндексированное значение")
                              tmp
                              ) ;_ end of if
                            ) ;_ end of cons
                          ) ;_ end of lambda
                       (vl-remove-if
                         '(lambda (a)
                            (= (strcase (vla-get-propertyname a)) "ORIGIN")
                            ) ;_ end of lambda
                         (vlax-safearray->list
                           (vlax-variant-value
                             (vla-getdynamicblockproperties ent)
                             ) ;_ end of vlax-variant-value
                           ) ;_ end of vlax-safearray->list
                         ) ;_ end of vl-remove-if
                       ) ;_ end of mapcar
                    ) ;_ end of setq
              (princ "\nОшибка указания примитива")
              ) ;_ end of if
           ) ;_ end of lambda
         ) ;_ end of function
       ) ;_ end of vl-catch-all-apply
     ) ;_ end of vl-catch-all-error-p
    (princ (strcat "\nОшибка выполнения :: " (itoa (getvar "errno"))))
    ) ;_ end of if
 res
 ) ;_ end of defun

Re: LISP. Изменение свойств(а) динамических блоков.

Обе функции работают только если в чертеже есть уже вставленный в блок. А если необходимо вывести список свойств дин. блока, определенного в базе чертежа, но еще не вставленного (без графики)?

Re: LISP. Изменение свойств(а) динамических блоков.

А можно, что бы сразу у нескольких блоков менялся параметр visibility, например:
1. Выделил блоки (одинаковые);
2. Из раскрывающегося списка возможных значений выбрал необходимое значение.
Очень удобная была бы вещь!!!

Re: LISP. Изменение свойств(а) динамических блоков.

> Kostinok
1. Выделил блоки (одинаковые);
2. Из раскрывающегося списка возможных значений выбрал в окне свойств необходимое значение.
И все.

Re: LISP. Изменение свойств(а) динамических блоков.

> Makswell
LISP. Изменение свойств(а) динамических блоков.
Есть задумка програмно вставлять блоки (светильники) равномерно по комнате, подчиняясь определенному закону, значит надо делать LISP, тогда почему бы не вставить такую функцию, которая сразу вставит блок с определенными параметрами?
Это гораздо удобнее!