Замедление программы из-за vlax-put-property. Свойства дин. блоков

teplolog · 23.11.2009, 18:39

Добрый день. Только начинаю осваивать vla-/vlax- . Написал программу работающую с дин блоками. Если запускаю ее последовательно несколько раз в одном сеансе, сильно увеличивается время работы. Если коментирую 3 строки типа

Код:

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

(vlax-put-property (cadr (assoc "RELEPOS X" dyn_name_prop))
             "value"
            0.
)

Работает быстро и время работы одинаковое в каждом запуске. В чем проблема. Заранее спасибо за помощь.

Кулик Алексей aka kpblc · 23.11.2009, 20:35

Полный код приведи. Наверняка есть шансы ускорить работу...

teplolog · 23.11.2009, 20:41

Извините за сырость и неудобочитаемость, я из-за этого сразу полный и не приводил.

Код:

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

(defun disp_edit_one (ename       /        dyn_name_prop          pt_ins       dx
              dy       dynlist    vname         variant_dynprop           safe_dyn
              i           kl_prop_x    kl_prop_y    kl_prop_name_x
              kl_prop_name_y        kl_x         kl_y      pt_ins       kl_pos_x
              kl_pos_y       kl_pos    blist         kl_ename
             )
                                      ;íà âõîäå èìÿ áëîêà
  (setq pt_ins (assoc 10 (entget ename)))                  ;ïîëó÷àåì òî÷êó âñòàâêè
  (setq blist (battlist ename))
  (setq vname (vlax-ename->vla-object ename))
  (setq variant_dynprop (vlax-invoke-method vname "GetDynamicBlockProperties"))
                                      ;ïîëó÷àåì äèíàìè÷åñêèå ñâîéñòâà áëîêà
  (setq safe_dyn (vlax-variant-value variant_dynprop))
  (setq dynlist (vlax-safearray->list safe_dyn))
  (setq    dyn_name_prop (mapcar '(lambda (x)
                 (cons (vlax-get-property x
                              "PropertyName"
                       )
                       (list x (vlax-variant-value (vlax-get-property x "value")))
                 )
                   )
                  dynlist
              )
  )                                      ;ïîëó÷èëè ñïèñîê â âèäå (íàçâàíèå äèí_ñâîéñòâà . vla-èìÿ  çíà÷åíèå äèí_ñâîéñòâà)
  (if (not (setq dx (caddr (assoc "RELEPOS X" dyn_name_prop))
         dy (caddr (assoc "RELEPOS Y" dyn_name_prop))
       )
      )
    (exit)
  )
                                      ;(if (not (= 0 dx dy))
                                      ; (progn
  (vlax-invoke-method vname
              "move"
              (vlax-3d-point 0 0)
              (vlax-3d-point dx dy)
  )
  (vlax-put-property (cadr (assoc "RELEPOS X" dyn_name_prop))
             "value"
             0.
  )
  (vlax-put-property (cadr (assoc "RELEPOS Y" dyn_name_prop))
             "value"
             0.
  )
  (setq i 1)
  (repeat 6
    (setq kl_prop_name_x (strcat "KL" (itoa i) "POS X")
      kl_prop_name_y (strcat "KL" (itoa i) "POS Y")
    )
    (if    (setq kl_prop_x (assoc kl_prop_name_x dyn_name_prop))
      (progn
    (setq kl_x (vlax-get-property (cadr kl_prop_x) "value"))
    (setq kl_x (vlax-variant-value kl_x))
    (vlax-put-property (cadr kl_prop_x)
               "value"
              (vlax-make-variant (- kl_x dx))
    )
    (setq kl_pos_x (+ (cadr pt_ins) kl_x))
    (setq kl_prop_y (assoc kl_prop_name_y dyn_name_prop))
    (setq kl_y (vlax-get-property (cadr kl_prop_y) "value"))
    (setq kl_y (vlax-variant-value kl_y))
    (vlax-put-property (cadr kl_prop_y)
               "value"
            (vlax-make-variant (- kl_y dy))
    )
    (setq kl_pos_y (+ (caddr pt_ins) kl_y))
    (setq kl_pos (xypole (list kl_pos_x kl_pos_y)))
    (setq kl_ename (cdr (assoc (strcat "KL" (itoa i)) blist)))
    (if (or (> (abs kl_y) 20) (> (abs kl_x) 50))
      (entmodmy kl_ename
            1
            (strcat "L" (itoa (car kl_pos)) "/" (itoa (cadr kl_pos)))
      )
      (entmodmy kl_ename
            1
            ""
      )
    )
      )
    )
    (setq i (+ i 1))
  )
)

Кулик Алексей aka kpblc · 23.11.2009, 21:12

Еще бы файлик... А так - попробуй:

Код:

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

(vl-load-com)

(defun disp-edit-one2 (ent                   /
                       _kpblc-conv-vla-to-list
                       _kpblc-conv-ent-to-ename
                       _kpblc-conv-ent-to-vla
                       _kpblc-list-assoc     attr_list
                       dynprop_list          dx
                       dy
                       )
                      ;|

|;

  (defun _kpblc-list-assoc (key lst)
                           ;|
*    Замена стандартному assoc
*    Параметры вызова:
	key	ключ
	lst	обрабатываеымй список
|;
    (if (= (type key) 'str)
      (setq key (strcase key))
      ) ;_ end of if
    (car
      (vl-remove-if-not
        (function
          (lambda (a / b)
            (and (setq b (car a))
                 (or (and (= (type b) 'str) (= (strcase b) key))
                     (equal b key)
                     ) ;_ end of or
                 ) ;_ end of and
            ) ;_ end of lambda
          ) ;_ end of function
        lst
        ) ;_ end of vl-remove-if-not
      ) ;_ end of car
    ) ;_ end of defun

  (defun _kpblc-conv-ent-to-ename (ent_value /)
                                  ;|
*    Функция преобразования полученного значения в ename
*    Параметры вызова:
*	ent_value	значение, которое надо преобразовать в примитив. Может
*			быть именем примитива, vla-указателем или просто
*			списком.
*			Если не принадлежит ни одному из указанных типов,
*			возвращается nil
*    Примеры вызова:
(_kpblc-conv-ent-to-ename (entlast))
(_kpblc-conv-ent-to-ename (vlax-ename->vla-object (entlast)))
|;
    (cond
      ((= (type ent_value) 'vla-object)
       (vlax-vla-object->ename ent_value)
       )
      ((= (type ent_value) 'ename) ent_value)
      ((= (type ent_value) 'str) (handent ent_value))
      ((= (type ent_value) 'list) (cdr (assoc -1 ent_value)))
      (t nil)
      ) ;_ end of cond
    ) ;_ end of defun

  (defun _kpblc-conv-ent-to-vla (ent_value / res)
                                ;|
*    Функция преобразования полученного значения в vla-указатель.
*    Параметры вызова:
*	ent_value	значение, которое надо преобразовать в указатель. Может
*			быть именем примитива, vla-указателем или просто
*			списком.
*			Если не принадлежит ни одному из указанных типов,
*			возвращается nil
*    Примеры вызова:
(_kpblc-conv-ent-to-vla (entlast))
(_kpblc-conv-ent-to-vla (vlax-ename->vla-object (entlast)))
|;
    (cond
      ((= (type ent_value) 'vla-object) ent_value)
      ((= (type ent_value) 'ename)
       (vlax-ename->vla-object ent_value)
       )
      ((setq res (_kpblc-conv-ent-to-ename ent_value))
       (vlax-ename->vla-object res)
       )
      ) ;_ end of cond
    ) ;_ end of defun

  (defun _kpblc-conv-vla-to-list (value / res)
                                 ;|
*    Преобразовывает vlax-variant или vlax-safearray в список.
|;
    (cond
      ((listp value)
       (mapcar '_kpblc-conv-vla-to-list value)
       )
      ((= (type value) 'variant)
       (_kpblc-conv-vla-to-list (vlax-variant-value value))
       )
      ((= (type value) 'safearray)
       (if (>= (vlax-safearray-get-u-bound value 1) 0)
         (_kpblc-conv-vla-to-list (vlax-safearray->list value))
         ) ;_ end of if
       )
      ((and (member (type value) (list 'ename 'str 'vla-object))
            (= (type (_kpblc-conv-ent-to-vla value)) 'vla-object)
            (vlax-property-available-p
              (_kpblc-conv-ent-to-vla value)
              'count
              ) ;_ end of vlax-property-available-p
            ) ;_ end of and
       (vlax-for sub (_kpblc-conv-ent-to-vla value)
         (setq res (cons sub res))
         ) ;_ end of vlax-for
       )
      (t value)
      ) ;_ end of cond
    ) ;_ end of defun

  (if (setq ent (_kpblc-conv-ent-to-vla ent))
    (progn
      (setq attr_list    (apply (function append)
                                (mapcar
                                  (function
                                    (lambda (x)
                                      (_kpblc-conv-vla-to-list
                                        (vlax-invoke-method ent x)
                                        ) ;_ end of _kpblc-conv-vla-to-list
                                      ) ;_ end of lambda
                                    ) ;_ end of function
                                  (list 'getattributes
                                        'getconstantattributes
                                        ) ;_ end of list
                                  ) ;_ end of mapcar
                                ) ;_ end of apply
            dynprop_list (mapcar
                           (function
                             (lambda (x)
                               (cons
                                 (vla-get-propertyname x)
                                 (_kpblc-conv-vla-to-list (vla-get-value x))
                                 ) ;_ end of cons
                               ) ;_ end of lambda
                             (_kpblc-conv-vla-to-list
                               (vla-getdynamicblockproperties ent)
                               ) ;_ end of _kpblc-conv-vla-to-list
                             ) ;_ end of function
                           ) ;_ end of mapcar
            ) ;_ end of setq
      (if (and (setq dx (_kpblc-list-assoc "relepos x" dynprop_list))
               (setq dy (_kpblc-list-assoc "relepos y" dynprop_list))
               ) ;_ end of and
        (progn
          (vla-move
            ent
            (vlax-3d-point '(0. 0. 0.))
            (vlax-3d-point
              (list
                dx
                dy
                (last
                  (_kpblc-conv-vla-to-list (vla-get-insertionpoint ent))
                  ) ;_ end of last
                ) ;_ end of list
              ) ;_ end of vlax-3d-point
            ) ;_ end of vla-move
          (foreach item '("repelos x" "relepos y")
            (vla-put-value
              (vla-item (vla-getdynamicblockproperties ent) item)
              (vlax-make-variant 0. vlax-vblong)
              ) ;_ end of vla-put-value
            ) ;_ end of foreach
          ) ;_ end of progn
        ) ;_ end of if
      ) ;_ end of progn
    ) ;_ end of if
  ) ;_ end of defun

Остальную часть просто не делал - некогда

P.S. Код не проверял вообще.

teplolog · 23.11.2009, 21:26

Спасибо! Буду читать, вникать и пробовать.

Do$ · 24.11.2009, 08:32

Цитата:

Сообщение от Кулик Алексей aka kpblc

* Замена стандартному assoc

Offtop: А чем стандартный не угодил?

Кулик Алексей aka kpblc · 24.11.2009, 08:37

В стандартном имеет значение регистр символов. Мне лениво это дело отслеживать (да и при работе с xml подобное потребовалось...)

Makswell · 24.11.2009, 09:18

Кулик Алексей aka kpblc, я тут вообще ни во что не вникал, но сразу бросилась в глаза строчка в твоём коде:

Код:

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

(vla-item (vla-getdynamicblockproperties ent))

Что-то здесь явно не так...

Кулик Алексей aka kpblc · 24.11.2009, 09:54

Эт да

Вроде как исправил. Но сомнения в правильности кода все равно остались ))

teplolog · 24.11.2009, 12:08

Ну до этого момента

Код:

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

(vla-item (vla-getdynamicblockproperties ent))

все работает, только тут добавил cdr

Код:

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

(setq dx (cdr (_kpblc-list-assoc "relepos x" dynprop_list)))
           (setq dy (cdr (_kpblc-list-assoc "relepos y" dynprop_list)))

Но я так понимаю, vla-item работаетс vla объектами, а vla-getdynamicblockproperties возвращает variant

23.11.2009, 18:39		#1
Замедление программы из-за vlax-put-property. Свойства дин. блоков teplolog Киев Регистрация: 23.11.2009 Сообщений: 6 Добрый день. Только начинаю осваивать vla-/vlax- . Написал программу работающую с дин блоками. Если запускаю ее последовательно несколько раз в одном сеансе, сильно увеличивается время работы. Если коментирую 3 строки типа Код: [Выделить все] (vlax-put-property (cadr (assoc "RELEPOS X" dyn_name_prop)) "value" 0. ) Работает быстро и время работы одинаковое в каждом запуске. В чем проблема. Заранее спасибо за помощь.
Просмотров: 3083

Опции темы	Поиск в этой теме
	Поиск в этой теме: Расширенный поиск