Создание спецификации автоматически (Дубль2), Рассматриваются технология и ее реализация по автоматическому создани Опции

[kpblc]

А если попробовать так:

Код

(defun test (exist new / _kpblc-conv-vla-to-list adoc res pos)
           ;|
*    Замена вхождения одного блока на другой. Слои должны быть разморожены и
* разблокированы.
*    Параметры вызова:
    exist    указатель (ename или vla) на вхождение заменяемого блока
    new    имя нового блока.
|;

  (defun _kpblc-conv-vla-to-list (value / res)
                                ;|
*    Преобразовывает vlax-variant или vlax-safearray в список.
|;
    (cond
      ((= (type value) 'variant)
       (_kpblc-conv-vla-to-list (vlax-variant-value value))
       )
      ((= (type value) 'safearray)
       (if (>= (vlax-safearray-get-u-bound value 1) 0)
         (vlax-safearray->list value)
         );_ end of if
       )
      (t value)
      );_ end of cond
    );_ end of defun

  (vl-load-com)
  (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
  (if
    (and (setq
           exist (cond ((= (type exist) 'ename) (vlax-ename->vla-object exist))
                       ((= (type exist) 'vla-object) exist)
                       (t nil)
                       );_ end of cond
           );_ end of setq
         (not (vl-catch-all-error-p
                (vl-catch-all-apply
                  '(lambda () (setq new (vla-item (vla-get-blocks adoc) new)))
                  );_ end of vl-catch-all-apply
                );_ end of vl-catch-all-error-p
              );_ end of not
         (not (equal (vla-get-islayout new) :vlax-true))
         );_ end of and
     (progn
       (setq res (vla-insertblock
                   (vla-objectidtoobject adoc (vla-get-ownerid exist))
                   (vla-get-insertionpoint exist)
                   (vla-get-name new)
                   (vla-get-xscalefactor exist)
                   (vla-get-yscalefactor exist)
                   (vla-get-zscalefactor exist)
                   (vla-get-rotation exist)
                   );_ end of vla-insertblock
             );_ end of setq
       (foreach item '("normal"                "xeffectivescalefactor"
                       "yeffectivescalefactor" "zeffectivescalefactor"
                       "layer"                 "color"
                       "lineweight"            "linetype"
                       )
         (vl-catch-all-apply
           '(lambda ()
              (vlax-put-property res item (vlax-get-property exist item))
              );_ end of lambda
           );_ end of vl-catch-all-apply
         );_ end of foreach
       (if (and (= (vla-get-isdynamicblock exist) :vlax-true)
                (= (vla-get-isdynamicblock res) :vlax-true)
                );_ end of and
         (foreach prop_exist
                  (vl-remove-if
                    '(lambda (x)
                       (= (strcase (vla-get-propertyname x)) "ORIGIN")
                       );_ end of lambda
                    (_kpblc-conv-vla-to-list
                      (vla-getdynamicblockproperties exist)
                      );_ end of _kpblc-conv-vla-to-list
                    );_ end of vl-remove-if
           (foreach prop_new
                    (vl-remove-if
                      '(lambda (x)
                         (= (strcase (vla-get-propertyname x)) "ORIGIN")
                         );_ end of lambda
                      (_kpblc-conv-vla-to-list
                        (vla-getdynamicblockproperties res)
                        );_ end of _kpblc-conv-vla-to-list
                      );_ end of vl-remove-if
             (if (= (vla-get-propertyname prop_new)
                    (vla-get-propertyname prop_exist)
                    );_ end of =
               (vl-catch-all-apply
                 '(lambda ()
                    (vla-put-value prop_new (vla-get-value prop_exist))
                    );_ end of lambda
                 );_ end of vl-catch-all-apply
               );_ end of if
             );_ end of foreach
           );_ end of foreach
         );_ end of if
       (vla-erase exist)
       );_ end of progn
     );_ end of if
  );_ end of defun

Никаких проверок, все "на коленке".

[kpblc]

А если попробовать так:

Код

(defun test (exist new / _kpblc-conv-vla-to-list adoc res pos)
           ;|
*    Замена вхождения одного блока на другой. Слои должны быть разморожены и
* разблокированы.
*    Параметры вызова:
    exist    указатель (ename или vla) на вхождение заменяемого блока
    new    имя нового блока.
|;

  (defun _kpblc-conv-vla-to-list (value / res)
                                ;|
*    Преобразовывает vlax-variant или vlax-safearray в список.
|;
    (cond
      ((= (type value) 'variant)
       (_kpblc-conv-vla-to-list (vlax-variant-value value))
       )
      ((= (type value) 'safearray)
       (if (>= (vlax-safearray-get-u-bound value 1) 0)
         (vlax-safearray->list value)
         );_ end of if
       )
      (t value)
      );_ end of cond
    );_ end of defun

  (vl-load-com)
  (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
  (if
    (and (setq
           exist (cond ((= (type exist) 'ename) (vlax-ename->vla-object exist))
                       ((= (type exist) 'vla-object) exist)
                       (t nil)
                       );_ end of cond
           );_ end of setq
         (not (vl-catch-all-error-p
                (vl-catch-all-apply
                  '(lambda () (setq new (vla-item (vla-get-blocks adoc) new)))
                  );_ end of vl-catch-all-apply
                );_ end of vl-catch-all-error-p
              );_ end of not
         (not (equal (vla-get-islayout new) :vlax-true))
         );_ end of and
     (progn
       (setq res (vla-insertblock
                   (vla-objectidtoobject adoc (vla-get-ownerid exist))
                   (vla-get-insertionpoint exist)
                   (vla-get-name new)
                   (vla-get-xscalefactor exist)
                   (vla-get-yscalefactor exist)
                   (vla-get-zscalefactor exist)
                   (vla-get-rotation exist)
                   );_ end of vla-insertblock
             );_ end of setq
       (foreach item '("normal"                "xeffectivescalefactor"
                       "yeffectivescalefactor" "zeffectivescalefactor"
                       "layer"                 "color"
                       "lineweight"            "linetype"
                       )
         (vl-catch-all-apply
           '(lambda ()
              (vlax-put-property res item (vlax-get-property exist item))
              );_ end of lambda
           );_ end of vl-catch-all-apply
         );_ end of foreach
       (if (and (= (vla-get-isdynamicblock exist) :vlax-true)
                (= (vla-get-isdynamicblock res) :vlax-true)
                );_ end of and
         (foreach prop_exist
                  (vl-remove-if
                    '(lambda (x)
                       (= (strcase (vla-get-propertyname x)) "ORIGIN")
                       );_ end of lambda
                    (_kpblc-conv-vla-to-list
                      (vla-getdynamicblockproperties exist)
                      );_ end of _kpblc-conv-vla-to-list
                    );_ end of vl-remove-if
           (foreach prop_new
                    (vl-remove-if
                      '(lambda (x)
                         (= (strcase (vla-get-propertyname x)) "ORIGIN")
                         );_ end of lambda
                      (_kpblc-conv-vla-to-list
                        (vla-getdynamicblockproperties res)
                        );_ end of _kpblc-conv-vla-to-list
                      );_ end of vl-remove-if
             (if (= (vla-get-propertyname prop_new)
                    (vla-get-propertyname prop_exist)
                    );_ end of =
               (vl-catch-all-apply
                 '(lambda ()
                    (vla-put-value prop_new (vla-get-value prop_exist))
                    );_ end of lambda
                 );_ end of vl-catch-all-apply
               );_ end of if
             );_ end of foreach
           );_ end of foreach
         );_ end of if
       (vla-erase exist)
       );_ end of progn
     );_ end of if
  );_ end of defun

Никаких проверок, все "на коленке".

[Гость_Supermax_*]

О! Какие люди!!! Выздоровел?
Kpblc, у тебя на коленке мазолей еще нет? Ты смотри, что нибудь подкладывай.
Я конечно испытаю, но я сейчас в живой модели размером с город. Испытывать на ней страшновато однако.


Kpblc, entsel вставь куда нибудь.

[kpblc]

Не, не выздоровел
Конечно, на боевой не надо. Потому что я проверял, скажем так, в тепличных условиях. Код старается заменить полностью блок, с исходной точкой вставки, нормалью и коэффициентами; слой, тип, вес и цвет линии копируются. По ходу пытается дин.свойства скопировать.
---
Добавлено:
Для проверки попробуй так:

Код

(test (car (entsel "\nExist")) (vla-get-EffectiveName (vlax-ename->vla-object(car(entsel "\nNew : ")))))

Сначала клик на заменяемый блок, потом - на вставляемый на его место

Сообщение отредактировал kpblc - 22.9.2007, 14:13

[Гость_Supermax_*]

Ну клик на заменяемый я понял, а на вставляемый? Это же он и есть! Я его меняю на него же! Но с новым именем.

[kpblc]

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

[Гость_Supermax_*]

Да обычные у меня блоки. Говорю персонально тебе еще раз. Надо подредактировать группу элементов объединенных в блок. Копий этого блока штук 100. В 101 надо изменить в нутри кое-что.
Предидущие 100 должны остаться прежними. Понятно дело, что подредактированный блок должен быть уже с другим именем. Значит мне надо создать новый блок с новым именем, но все параметры списать с указанного. Потом я этот новый блок открою и подредактирую.
Внешне это будет выглядеть так:
Нажал кнопень, выскачило entsel - указал блок, спросило новое имя - указал новое имя, нажал ентер. Все. В базе новый блок, а вместо старого, на который я указал стоит новый. Внешне это даже не заметно, поскольку они братья близняшки. Как будто я его переименовал.

[Гость_Supermax_*]

В редакторе блоков есть "сохранить как", но это просто в базе создается новое описание блока, а его положение в пространстве не сохраняется. То вхождение, которое было использовано для открытия редактирования блока при этом остается со старым именем. Чтобы вставить новое вхождение надо жать insert block и попадать в цель,. а это не возможно по некоторым причинам.

[Гость_Supermax_*]

Народ! Я забыл как очищать базу от мусора и не использованных блоков Спасите!

[kpblc]

_purge
Код по копированию пробую нарисовать.

[Гость_Supermax_*]

Ой спасибочи, полегшало! Хорошая команда.

[kpblc]

Код

(defun copy-block (exist new / *error* def res)
                 ;|
*    вставляет на место указанного блока новый с новым именем.
*    Параметры вызова:
    exist    указатель на блок
    new    новое имя блока.
*    Примеры вызова:
(copy-block (car(entsel)) "new01")
|;

  (defun *error* (msg)
    (vla-endundomark adoc)
    (princ msg)
    (princ)
    );_ end of defun

  (vl-load-com)
  (vla-startundomark
    (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
    );_ end of vla-StartUndoMark
  (if
    (and (setq
           exist (cond ((= (type exist) 'ename) (vlax-ename->vla-object exist))
                       ((= (type exist) 'vla-object) exist)
                       (t nil)
                       );_ end of cond
           );_ end of setq
         (= (vla-get-objectname exist) "AcDbBlockReference")
         (setq def (vla-item (vla-get-blocks adoc) (vla-get-name exist)))
         (not (tblobjname "block" new))
         );_ end of and
     (progn
       (setq res (vla-add (vla-get-blocks adoc)
                          (vla-get-origin def)
                          new
                          );_ end of vla-add
             );_ end of setq
       (vla-copyobjects
         adoc
         (vlax-make-variant
           (vlax-safearray-fill
             (vlax-make-safearray
               vlax-vbobject
               (cons 0 (1- (vla-get-count def)))
               );_ end of vlax-make-safearray
             ((lambda (/ lst)
                (vlax-for item def
                  (setq lst (cons item lst))
                  );_ end of vlax-for
                lst
                );_ end of lambda
              )
             );_ end of vlax-safearray-fill
           );_ end of vlax-make-variant
         res
         );_ end of vla-copyobjects
       (setq res (vla-insertblock
                   (vla-objectidtoobject
                     adoc
                     (vla-get-ownerid exist)
                     );_ end of vla-objectidtoobject
                   (vla-get-insertionpoint exist)
                   (vla-get-name res)
                   (vla-get-xscalefactor exist)
                   (vla-get-yscalefactor exist)
                   (vla-get-zscalefactor exist)
                   (vla-get-rotation exist)
                   );_ end of vla-InsertBlock
             );_ end of setq
       (foreach item '("normal"                "xeffectivescalefactor"
                       "yeffectivescalefactor" "zeffectivescalefactor"
                       "layer"                 "color"
                       "lineweight"            "linetype"
                       "insertionpoint"
                       )
         (vl-catch-all-apply
           '(lambda ()
              (vlax-put-property res item (vlax-get-property exist item))
              );_ end of lambda
           );_ end of vl-catch-all-apply
         );_ end of foreach
       (vla-erase exist)
       );_ end of progn
     );_ end of if
  );_ end of defun

Код исправлен 22.09.07 в 21:20

Сообщение отредактировал kpblc - 22.9.2007, 20:19

[Гость_Supermax_*]

У меня Select object: Too many actual parameters
Блок остался прежний.

[Гость_Supermax_*]

В базе он создался, а вот в модель не попал.

Сообщение отредактировал Supermax - 22.9.2007, 16:26

[kpblc]

<...>Код удален, см.#282

Сообщение отредактировал kpblc - 22.9.2007, 20:20

[mmax]

А вот и мой набросок, удобно и просто.
(vl-load-com)

(setq blockref (vlax-ename->vla-object (car(entsel))))

(setq vlablcobjs (vlax-safearray->list (vlax-variant-value (vla-explode blockref))))

(setq enameblcobjs
(mapcar 'vlax-vla-object->ename
vlablcobjs))

(setq ss (ssadd))

(mapcar(function(lambda(a)
(ssadd a ss)))
enameblcobjs)



(Command "-block"
"MyName"
(vlax-safearray->list
(vlax-variant-value
(vla-get-InsertionPoint blockref)))
ss "")

[kpblc]

И блок вставлен не будет.

[Гость_Supermax_*]

Kpblc, твой вставился, но улетел вправо. Что-то с координатами вставки не так. А у Mmax-a попросил точку вставки, указал блок, и блок пропал.

[kpblc]

Образец бы... Сильно подозреваю, что это проблема немировой системы координат. попробуй перед выполнениекм дать с ком.строки _ucs _w

[Гость_Supermax_*]

Command: _ucs_w
Unknown command "UCS_W". Press F1 for help.

Сообщение отредактировал Supermax - 22.9.2007, 19:03

Прикрепленные файлы

 Drawing8.rar ( 918,99 килобайт ) Кол-во скачиваний: 67

 

[kpblc]

Код

Comman: _usc<enter>_w<enter>

Файл скачиваю, гляну.
Посмотрел, все ясно. Код исправил (#282), команду можно не вводить.
---
Добавлено: для ускорения обработки можешь попробовать не ставить скругления у кирпичей - эффекта минимум, а нагрузки максимум (ИМХО, конечно).

Сообщение отредактировал kpblc - 22.9.2007, 21:17

[mmax]

У меня только набросок. Там и МСК и ПСК не учтены.
Если блокреф имеет масштаб по осям. Если блок с именем "MyName" уже существует. И многое еще чего там.

Я уже давно собирался сделать чтонибудь нормальное да руки все не доходят.

Автокад 2008 в Висте имеет серьезную проблему с русскими шрифтами в комстроке и в лиспредакторе я вообще в ауте. Все мои старые лиспы с русскоязычными запросами придется переписывать.

[Гость_Supermax_*]

Kpblc, работает! НО! есть одно, так сказать, неудобство. Для переименования блока приходится писать строку, в которой указывать новое имя. Очень хотелось бы выбирать его из списка существующих имен и редактировать. Тогда это бы стало просто вершиной полезности.

По поводу твоего предидущего шедевра появились нужные мысли. Надо сделать четвертую кнопку "Включить избранное" в отличии от "Включить все" включается только то, что принадлежит какому-то конкретному слою (или нескольким слоям), типу элементов (или нескольким типам), имени блока (или нескольким именам).
Если нажать эту кнопку должна выскакивать панель с тремя окнами. В первой - список всех слоев, во второй - список всех примитивов, в третьей- список имен блоков. Через Ctrl отмечаются слои, примитивы и имена блоков и нажимается ОК.
Под окнами нужны кнопки "выбрать все", чтобы выбирать все лои, и т.п.

Я могу написать сам это окно, причем не в DСL виде, а в виде lsp в котором создается DCL. Я у себя очень редко компилирую DCL файл вместе с LSP. Я предпочитаю заставлять прогу создавать такой файл и после окончания диалога его убивать. Мне только надо с тобою договориться о составе переменных.

Очень трудно недооценить значение этих двух макросов. Я без них просто как без рук. Все очень быстро стало делаться и очень легко вращаться, НО! Если нажать "Включить все" последствия будут не предсказуемые. К этой кнопке тоже надо приделать панель диалога типа "А вы точно уверены, что хотите включить все?" и кнопка ОК\Cancel.

[kpblc]

Сделать, конечно, можно... Но несколькими путями:
1. Действительно сделать dcl и пытаться его обучить хорошим манерам. По-моему, в pop_list невозможно выделить несколько строк. Соответственно придется делать отдельную кнопень типа "добавить в фильтр отбора". Мрак.
2. Сделать dll на VB6, к примеру, и работать через СОМ-интерфейс. Минусы: некорректная работа при "неклассической" схеме оформления Windows, и не будет работать в Windows Vista 64bit (на первом мы уже споткнулись; второе мне сказал Александр Ривилис, и я не склонен ему не верить).
3. Нарисовать все то же самое, но на .NET и подгружать через _netload. Минусы: лично я еще не работал с кадом через .NET (соответственно время на обучение надо); придется делать разные версии для 2005(2006) и 2007(2008). Что будет в 2009 - неизвестно пока.
---
А чего со мной договариваться-то? Интерфейс какой угодно можно прикрутить.
P.S. За доброе слово спасибо. Оно, как известно, и кошке приятно

Сообщение отредактировал kpblc - 24.9.2007, 13:28

[Гость_Supermax_*]

Kpblc, возможно. Я уже это сделал. Дает список выбранного. Весь гимор для меня это считать список слоев, список типов примитивов и список имен блоков.
Давай так, ты с начала даешь мне эти три списка, а я тебе возвращаю выбранное из них.

[Гость_Supermax_*]

Kpblc, ты представляешь, твой макрос с включением\выключением может выключать детали в блокэдиторе! Мой просто сваливается от этого, а твой выключает! Правда после выхода из редактора все элементы включаются по прежнему, но все равно круто! Вот ели бы они не включались.... Я мог бы снести целую стену дома, хотя она у меня разбита блоками по рядям.

[kpblc]

Список слоев, сортированный (исключаются слои с "|" - от внешних ссылок которые):

Код

(defun lst-layers (/ adoc res)
  (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
  (vlax-for item (vla-get-layers adoc)
    (setq res (cons (vla-get-name item) res))
    );_ end of vlax-for
  (acad_strlsort res)
  );_ end of defun

Список имен блоков (исключаются анонимные блоки, блоки описаний таблиц, блоки штриховок и размеров)

Код

(defun lst-blocks (/ adoc res tmp)
  (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
  (vlax-for blk_def (vla-get-blocks adoc)
    (if (equal (vla-get-islayout blk_def) :vlax-false)
      (setq res (cons (if (vlax-property-available-p blk_def 'effectivename)
                        (vla-get-effectivename item)
                        (vla-get-name item)
                        );_ end of if
                      res
                      );_ end of cons
            );_ end of setq
      );_ end of if
    );_ end of vlax-for
  (acad_strlsort (vl-remove-if '(lambda (x) (wcmatch (strcase x) "`**")) res))
  );_ end of defun

Список типов примитивов:

Код

(defun lst-entity-types (/ adoc res name)
  (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
  (vlax-for blk_def (vla-get-blocks adoc)
    (if (equal (vla-get-islayout blk_def) :vlax-true)
      (vlax-for ent blk_def
        (if
          (not (member
                 (setq name (strcase (substr (vla-get-objectname ent) 5) t))
                 res
                 );_ end of member
               );_ end of not
           (setq res (cons name res))
           );_ end of if
        );_ end of vlax-for
      );_ end of if
    );_ end of vlax-for
  (acad_strlsort res)
  );_ end of defun

Коды не тестировал.
P.S. > #296: Попробуй после выполнения кода внутри редактора выполнить регенерацию файла. Если не спасет, будем думать
P.P.S. В коде изначально была ошибка, исправил.

Сообщение отредактировал kpblc - 24.9.2007, 13:58

[Гость_Supermax_*]

Kpblc, возьми AutiLisp и Visual Lisp в среде AutoCAD стр. 253 9-я строка с низу.

Добавлено:
Со слоями - гуд.

С блоками - Command: (LST-BLOCKS)
; error: bad argument type: VLA-OBJECT nil

С примитивами - Command: (LST-ENTITY-TYPES)
("blocktablerecord")

*Unnn - оставь.

Сообщение отредактировал Supermax - 24.9.2007, 14:02

[kpblc]

Книги на работе остались, сижу без литературы совсем.

[Гость_Supermax_*]

Ладно, цитирую:

3.3.4.4. Элементы со списками

Листинг 3.6 демонстрирует способ применения элемента list_box, который позволяет размещать в диалоговом окне данные в форме списка.

Код

// Глава 03\Book02\sample4.dcl
sample4: dialog {label="Пример диалога со списком";
:list_box{label="Список данных";key="b1";
list="данное 1\nДанное 2\nданное 3\nДанное 4;fixed_width_font=true;}
ok_button;
}// конец sample 4

На рис. 3.6 показано диалоговое окно со списком. Значение true атрибута multiple_select предоставляет возможность пользователю с помощью клавиш <Chift> или <Ctrl> отметить в списке сразу несколько строк с данными.
Ну и дальше по тексту.

Ну вообще-то окошко я сам напишу, ты только подправь читалку имен блоков.

[Гость_Supermax_*]

Так, сразу возник еще один момент. Вот выбрал я имя блока, или группу имен, а в каких слоях они должны стоять? Я ведь могу например сказать, блок с именем таким-то в слое таком-то. То есть надо либо каждому примитиву и именованному блоку (*U123 - тоже имя) задавать еще и слой? У одного примитива слой такой-то, а у другого слой другой? Либо надо включать губоскатывающую машинку и ограничивать коомбинации выбора. Что посоветуешь?