[Zaghim]

Друзья, помогите оптимизировать код. Он очень долго думает в следующих кусках:

Код:

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

(command "line" tvstav1 tvstav2 "")
	      (setq l0 (ssget "L"))
              (command "change" l0 "" "P" "la" layer "" "")
	      (command "line" tvstav2 tvstav31 "")
	      (setq l0 (ssget "L"))
              (command "change" l0 "" "P" "la" layer "" "")
	      (command "line" tvstav2 tvstav32 "")
      	      (setq l0 (ssget "L"))
              (command "change" l0 "" "P" "la" layer "" "")
	      (command "line" tvstav31 tvstav32 "")
      	      (setq l0 (ssget "L"))
              (command "change" l0 "" "P" "la" layer "" "")
	      (command "line" tvstav3 tvstav4 "")
      	      (setq l0 (ssget "L"))
              (command "change" l0 "" "P" "la" layer "" "")

При этом постоянно появляется надпись Unknown command P1 - имя моей команды

И еще я взрываю блоки и восстанавливаю их цвет:

Код:

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

(vl-cmdf "_explode" name "")
          (setq l1 (ssget "p"))
          (vl-cmdf "_chprop" l1 "" "la" layer "" "")

Здесь те же тормоза и надписи с неизвестной командой... тормоза критические, вместо 5-10 секунд код работает пару минут, а то и больше...

[gomer]

Сообщение от Zaghim Друзья, помогите оптимизировать код.

entmake, entlast, entmod вместо того ужаса, что у вас

[Zaghim]

Т.е. так:

Код:

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

(command "line" tvstav1 tvstav2 "")
	      (setq l0 (entget (entlast)))
	      (setq l0 (subst (cons 8 layer) (assoc 8 l0) l0))
	      (entmod l0)

[gomer]

Сообщение от Zaghim Т.е. так:

такой вариант тоже подтормаживать будет, даже с обнуленной cmdecho

[Zaghim]

А как тогда сделать правильно?
Кстати при расчленении такой вариант вообще не катит, потому что он не линию выбирает, а атрибуты в блоке и меняет их цвет

[Дима_]

Код:

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

 (entmakex (list '(0 . "LINE") (cons 10 tvstav1) (cons 11 tvstav2) (cons 8 layer)))

[CB]

Ради интереса проверил на скорость

Код:

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

 
(BenchMark
  '(
    (progn
     (command "line" tvstav1 tvstav2 "")
     (setq l0 (ssget "L"))
     (command "change" l0 "" "P" "la" layer "")
     (command "line" tvstav2 tvstav31 "")
     (setq l0 (ssget "L"))
     (command "change" l0 "" "P" "la" layer "")
     (command "line" tvstav2 tvstav32 "")
     (setq l0 (ssget "L"))
     (command "change" l0 "" "P" "la" layer "")
     (command "line" tvstav31 tvstav32 "")
     (setq l0 (ssget "L"))
     (command "change" l0 "" "P" "la" layer "")
     (command "line" tvstav3 tvstav4 "")
     (setq l0 (ssget "L"))
     (command "change" l0 "" "P" "la" layer "")
    )

    (mapcar
     '(lambda (pt1 pt2)
        (entmakex
          (list
            '(0 . "LINE")
            (cons 8 layer)
            (cons 10 pt1)
            (cons 11 pt2)
          ) ;_ end of list
        ) ;_ end of entmakex
      ) ;_ end of lambda
     (list tvstav1 tvstav2 tvstav2 tvstav31 tvstav3)
     (list tvstav2 tvstav31 tvstav32 tvstav32 tvstav4)
    ) ;_ end of mapcar
   )
) ;_ end of BenchMark

Результат

Код:

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

_$ 
Benchmarking ...............Elapsed milliseconds / relative speed for 4096 iteration(s):

    (MAPCAR (QUOTE (LAMBDA (PT1 PT2) (EN...).......1141 / 268.56 <fastest>
    (PROGN (COMMAND "line" TVSTAV1 TVSTA...).....306422 / 1 <slowest>

[Дима_]

Ну если совсем "упираться" можно еще ' на function заменить - еще пару тактов отыграем - хотя и так не плохо вышло.

[Zaghim]

А как быть с блоком? Попробуйте взорвать блок с атрибутами...как выловить нужное, обойдя атрибуты? P.S. в самом блоке только отрезок...

[Дима_]

Тогда надо просто вытащить из блока отрезок - без "фейерверков", vla-CopyObjects - в справке по автокад тебе в помощь.

[Zaghim]

В справке искомая комбинация не найдена... можно хоть какой-то пример кода?

[Дима_]

Сообщение от Zaghim В справке искомая комбинация не найдена...

справка по VBA->object model->document->CopyObject - как использовать объектную модель в автолиспе - ищи на форуме - 500 раз уже расписанно.
p.s. при желании можно и без vla - (cdr (assoc -2 (tblsearch "block" "blockname"))) - ссылка на первый элемент блока "blockname", то есть, например, (entmakex (entget ...)) создаст его в начале координат (относительно точки вставки блока) - откуда его уже можно "перетащить" на нужное место, или через entget- прямо "на месте" померить и пр.

[Zaghim]

Окей, щас попробуем...

Разобрался...но получается немного не то...
Блок динамический... т.е. я выдергиваю оттуда линию и она действительно рисуется вначале координат, но рисуется линия по умолчанию. Например длина лини в блоке 100, а на деле она 4000...
Может быть можно как-то по другому?
Хотя можно ведь выдернуть длину блока и его угол, а потом линию подредактировать...так?

[Frigate]

найди динамические свойства, отвечающие за длину отрезка - они вытягиваются через объектную модель

GetDynamicBlockProperties

поищи на форуме поиском - там и коды есть

[Zaghim]

Я просто боюсь, что скорости это не прибавит, если я буду создавать объект, опять же менять его свойства и двигать и потом удалять блок...


Задача усложнилась. Теперь внутри блока может быть все, что угодно и как быть ума не приложу(((

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

Без проверок:

Код:

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

 (vl-load-com)

(defun get-block-contents (ent / def res _kpblc-conv-vla-to-list)
                          ;|
*    Получение состава блока
*    Параметры вызова:
	ent		указатель на вхождение блока (ename или vla).
*    Возвращает список vla-примитивов блока.
*    Примеры вызова:
(get-block-contents (car (entsel "\nВыберите блок")))
|;
  (defun _kpblc-conv-vla-to-list (value / res) ;|
*    Преобразовывает vlax-variant или vlax-safearray в список.
|;  (cond ((listp value) (mapcar (function _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 (= (type value) 'vla-object) (vlax-property-available-p value 'count))
           (vlax-for sub value (setq res (cons sub res))) ;_ end of vlax-for
           )
          (t value)
          ) ;_ end of cond
    ) ;_ end of defun
  
  (cond ((and ent
              (= (type ent) 'ename)
              (= (cdr (assoc 0 (entget ent))) "INSERT")
              ) ;_ end of and
         (setq res (get-block-contents (vlax-ename->vla-object ent)))
         )
        ((and ent (= (type ent) 'vla-object) (wcmatch (vla-get-objectname ent) "*BLOCK*"))
         (if (equal (vla-get-isxref (setq def (vla-item (vla-get-blocks (vla-get-document ent)) (vla-get-name ent))))
                    :vlax-false
                    ) ;_ end of equal
           (setq res (cons ((lambda (/ _lst) (vlax-for subent def (setq _lst (cons subent _lst))) (reverse _lst)))
                           (_kpblc-conv-vla-to-list (vla-getattributes ent))
                           (_kpblc-conv-vla-to-list (vla-getconstantattributes ent))
                           ) ;_ end of cons
                 ) ;_ end of setq
           ) ;_ end of if
         )
        ) ;_ end of cond
  res
  ) ;_ end of defun

[Zaghim]

Алексей, отработало буквально за доли секунды, но некоторые блоки не разбились. Сейчас выясню почему

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

Так они не должны разбиваться-то, у меня нет explode...

[Zaghim]

Хм...т.е. я просто получаю список всего внутри блока? А как потом это нарисовать...с вижуал лиспом вообще не дружу

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

Стоп, ничего не понял. У тебя уже есть блок, есть его состав. Чего ты хочешь рисовать? И зачем?

[Zaghim]

Мне нужно получить содержимое блока, что бы были примитивы в том же слое и цвете что и блок...а сам блок удалить ну или взорвать. Блок в котором только линия, я сделал, там все просто, а есть блоки в которых может быть все что угодно, кроме еще одного блока...
Точнее не получить, а нарисовать заместо блока

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

Тогда ищи тему "Exress Tools Bugs", таи VVA много чего сделал