Форумы caduser.ru

 
Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти  
Страницы: 1
RSS
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
1. Можно еще функцию наваять, которая выдаёт возможные значения и свойства для блока?
2. Какой value для "Flip state"?
> krieger (2007-06-28 11:50:58)
Сюда же? Или в отдельную тему?
Как бы то ни было:
Код
(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

Вроде пашет...
Работает..., сразу с "Flip state" разобрался... smile:)
Тока, функция выдаёт не возможные значения, а текущие значения. Понятно что для параметров типа Linear нельзя их перечислить, но у, например, Visibility State их ограниченное число.
Не то вставил, сорри. Чтоб ты не мучался с переделыванием кода, попробуй такое чудовище:
Код
(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
И тишина...
> Кулик Алексей aka kpblc (2007-06-28 14:34:33)
Цитата
И тишина...
Иногда я отхожу от компьютера... smile:)
Код работает, НО, как я понял, только когда там всего один параметр типа Visibility. Как только появляется другой, прога выдает ошибку "Ошибка выполнения :: 2(один раз было 38)" Соответственно с Lookup, который управляет другими параметрами - дохлый номер.
> krieger (2007-06-28 17:19:33)
Можешь прислать пример? Я-то тестировал на стандартных дин.блоках...
Ну и последнее. Благодаря 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
Обе функции работают только если в чертеже есть уже вставленный в блок. А если необходимо вывести список свойств дин. блока, определенного в базе чертежа, но еще не вставленного (без графики)?
А можно, что бы сразу у нескольких блоков менялся параметр visibility, например:
1. Выделил блоки (одинаковые);
2. Из раскрывающегося списка возможных значений выбрал необходимое значение.
Очень удобная была бы вещь!!!
> Kostinok (2008-09-09 11:14:55)
1. Выделил блоки (одинаковые);
2. Из раскрывающегося списка возможных значений выбрал в окне свойств необходимое значение.
И все.
> Makswell (2008-09-09 12:42:24)
LISP. Изменение свойств(а) динамических блоков.
Есть задумка програмно вставлять блоки (светильники) равномерно по комнате, подчиняясь определенному закону, значит надо делать LISP, тогда почему бы не вставить такую функцию, которая сразу вставит блок с определенными параметрами?
Это гораздо удобнее!
Страницы: 1
Читают тему (гостей: 1, пользователей: 0, из них скрытых: 0)