Помощь - Поиск - Пользователи - Календарь
Полная версия этой страницы: Создание спецификации автоматически (Дубль2)
Диалог специалистов АВОК > ФАЙЛОТЕКА СПЕЦИАЛИСТА > Программы, расчеты
Страницы: 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12
Supermax
На VBA и с панелью кнопок.
Скоро выложу.
Я чесно говоря, на эту строчку и внимание-то не обратил. А зря, зря!
Кнопки приделать к твоему макросу можно прямо кадовские, без напрягов с писанием панели.
Сейчас протестирую.
Все, протестировал.
И Дима Demontage, тобишь, и ты на одни и теже грабли наступили. Во, оказывается болезнь-то заразная, как бы не подхватить..
Когда выделяешь объекты и командуешь "скрыть выделенное" они скрываются, НО! не дезактивируются!
если после этого выделить какой-нибудь объект из оставшихся и его передвинуть, или еще хуже того - грохнуть, то и те, что скрылись, но не дезактивировались тоже сместятся или канут в небытие.
Включаешь "включить все" а их и нетути!
Я пол модели так грохнул, слава богу кад не выключал и назад откатил (2 часа упорного труда по восстановлению).
В конец надо эскейп вставить, а то люди могут пострадать!

Свй макрос я удалил, поскольку он хуже Kpblc-овского.
kpblc
Работает только для пространства модели (то есть набор должен формироваться в пространстве модели).
Код
(defun kpblc-objects-hide (bit
                           /
                           *error*
                           _kpblc-error-catch
                           _kpblc-layer-status-restore
                           _kpblc-layer-status-save
                           selset
                           selset_all
                           msg
                           item
                           )
        ;|
*    Скрытие выбранных объектов / невыбранных объектов / показ всех объектов.
* Сделано в качестве попытки создания аналога ADT-шной команды Isolate objects.
* Работает только в активном пространстве.
*    Параметры вызова:
*  bit  что делать. 0 — показать все; 1 — скрыть выделенные; 2 — скрыть
*    все, кроме выделенных
*    Примеры вызова:
(kpblc-objects-hide 0); Показать все объекты
(kpblc-objects-hide 1); Скрыть выделенные объекты
(kpblc-objects-hide 2); Скрыть все, кроме выделенных
|;

  (defun *error* (msg)
    (_kpblc-layer-status-restore)
    (vla-endundomark *kpblc-activedoc*)
    (princ msg)
    (princ)
    );_ end of defun

  (defun _kpblc-error-catch (protected-function
                             on-error-function
                             /
                             catch_error_result
                             )
                ;|
*** Функция взята из книжной версии ruCAD'a без каких бы то ни было переделок,
*** кроме переименования.
*    Оболочка отлова ошибок.
*    Параметры вызова:
*    protected-function    - "защищаемая" функция
*    on-error-function    - функция, выполняемая в случае ошибки
|;
    (setq catch_error_result (vl-catch-all-apply protected-function))
    (if (and (vl-catch-all-error-p catch_error_result)
             on-error-function
             );_ end of and
      (apply on-error-function
             (list (vl-catch-all-error-message catch_error_result))
             );_ end of apply
      catch_error_result
      );_ end of if
    );_ end of defun

  (defun _kpblc-layer-status-restore (/ item)
                ;|
*    Восстановление состояния слоев из глобального списка
* *kpblc-list-layer-status*
*    Параметры вызова:
*    нет
*    Примеры вызова:
(_kpblc-layer-status-restore)
|;
    (if *kpblc-list-layer-status*
      (progn
        (foreach item *kpblc-list-layer-status*
          (_kpblc-error-catch
            '(lambda ()
               (vla-put-freeze (car item) (cdr (assoc "freeze" (cdr item))))
               );_ end of LAMBDA
            nil
            );_ end of _kpblc-error-catch
          (_kpblc-error-catch
            '(lambda ()
               (vla-put-lock (car item) (cdr (assoc "lock" (cdr item))))
               );_ end of LAMBDA
            nil
            );_ end of _kpblc-error-catch
          );_ end of foreach
        );_ end of progn
      );_ end of if
    (setq *kpblc-list-layer-status* nil)
    );_ end of defun

  (defun _kpblc-layer-status-save (layers-on / item)
                ;|
*    Разблокировка и разморозка всех слоев активного документа. Состояние
* сохраняется в глобальном списке *kpblc-list-layer-status* вида
* '(vla-указатель ("freeze" . :vlax-true) ("lock" . :vlax-false))
*    Параметры вызова:
*    layers-on    включать слои (t) или нет (nil)
*    Примеры вызова:
(_kpblc-layer-status-save t)
|;
    (vlax-for item (vla-get-layers *kpblc-activedoc*)
      (setq *kpblc-list-layer-status*
             (append *kpblc-list-layer-status*
                     (list
                       (list item
                             (cons "freeze" (vla-get-freeze item))
                             (cons "lock" (vla-get-lock item))
                             );_ end of list
                       );_ end of list
                     );_ end of append
            );_ end of setq
      (if layers-on
        (progn
          (_kpblc-error-catch
            '(lambda ()
               (vla-put-freeze item :vlax-false)
               );_ end of LAMBDA
            nil
            );_ end of _kpblc-error-catch
          (vla-put-lock item :vlax-false)
          );_ end of progn
        );_ end of if
      );_ end of vlax-for
    );_ end of defun

  (vl-load-com)
  (or *kpblc-activedoc*
      (setq *kpblc-activedoc* (vla-get-activedocument (vlax-get-acad-object)))
      );_ end of if
  (vla-startundomark *kpblc-activedoc*)
  (_kpblc-layer-status-save t)
  (cond
    ((= bit 1) (setq msg "Скрыть выделенные объекты"))
    ((= bit 2) (setq msg "Скрыть кроме выделенных"))
    );_ end of cond
  (if (= bit 0)
    (progn
      (foreach item
               (mapcar
                 'vlax-ename->vla-object
                 (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget "_A"))))
                 );_ end of mapcar
        (vla-put-visible item :vlax-true)
        );_ end of foreach
      );_ end of progn
    (progn
      (setq selset (ssget "_I"))
      (while (not selset)
        (prompt msg)
        (setq selset (ssget))
        );_ end of while
      (cond
        ((= bit 1); Скрывать выделенные
         (foreach item
                  (mapcar 'vlax-ename->vla-object
                          (vl-remove-if 'listp (mapcar 'cadr (ssnamex selset)))
                          );_ end of mapcar
           (vla-put-visible item :vlax-false)
           );_ end of while
         )
        ((= bit 2); Скрывать кроме выделенных
         (setq selset_all (ssget "_A"))
         (while (and selset_all (> (sslength selset_all) 0))
           (setq item (ssname selset_all 0))
           (ssdel item selset_all)
           (if (not (ssmemb item selset))
             (vla-put-visible (vlax-ename->vla-object item) :vlax-false)
             );_ end of if
           );_ end of while
         )
        );_ end of cond
      );_ end of progn
    );_ end of if
  (sssetfirst nil nil)
  (_kpblc-layer-status-restore)
  (vla-endundomark *kpblc-activedoc*)
  (princ)
  );_ end of defun

(defun c:hideobj (/ answer)
  (vl-load-com)
  (if
    (not (vl-catch-all-error-p
           (vl-catch-all-apply
             '(lambda ()
                (initget
                  "Показать Выделенные Кроме Show SElected Exculde _ 0 1 2 0 1 2"
                  );_ end of initget
                (setq answer
                       (getkword
                         "\nЧто делаем [Показать все/скрывать Выделенные/скрывать Кроме выделенных] <Отмена> : "
                         );_ end of GETKWORD
                      );_ end of setq
                );_ end of lambda
             );_ end of vl-catch-all-apply
           );_ end of vl-catch-all-error-p
         );_ end of not
     (kpblc-objects-hide (atoi answer))
     );_ end of if
  );_ end of defun

P.S. Код из #253 снес
P.P.S. Загружать все, вызов с ком.строки - hideobj.
Supermax
С замком стало все в порядке, вот разморозка не хочет размораживаться, да и у меня при замораживании объекты с экрана исчезают. Вообще-то я этим "холодильником" не пользуюсь может чего-то не так делаю?
Ты можешь мне объяснить зачем нужен этот "Freeze"?

Предлагаю ничего не менять, а просто хелпик в макросе подтереть. Оставить только включение и выключение. И так нормально аж до визгу.

Если ты не против, то давай снесем все наши посты после твоего макроса, а то он уже рабочий, а базар после него будто он кривой.
kpblc
Ну я ж не автодеск... Глобальным Freeze я пользуюсь если надо и объекты скрыть, и защитить их от удаления (простое выключение слоя от ctrl+a не спасает). А вот внутри видовых экранов - очень полезная штука.
Supermax
Kpblc, как тебе краники и прочие детали? Ты говорил, что живешь на DWG.RU. Это я только 20-30 меговые папки кидаю, а у меня еще и 300 меговые есть, да и новый диск ожидаю на днях.
Очень плохо, что там только солиды, да и многие из отдельных солидов состоят (шпильки, гайки и т.п.) все не раскрашенное и без опознавательных данных. Такого понатыкаешь в монтажку, до-о-олго голову будешь ломать над тем ху-из-ху.

Консолидация мозгов и трудовых резервов в интернете не идет пока накак. Говоришь людям: "давайте все вместе, каждый по штучке" а они молчат, попрятались и ждут, когда найдуться человек 100 дураков, все сделают и им дадут на халяву. Наши производители - вообще отдельная песня. Сайты у них - без слез смотреть нельзя. Видно, что напрягаются, да только от напряжения свои извилины выпрямляют.
Предложил серию ППУ труб забацать дин. блоками. Научить готов, хочу взамен 4 штуки таких, каких у меня нет. Наверное много хочу. Самое интересное, что у меня на всю серию графика готова. Осталось взять существующий блок и отредактировать. Нет, и этого оказывается много за знания. Пишут крики о помощи найти литературу по дин. блокам, а принять мое предложение слабо.
ХАЛЯВЩИКИ! Как я их всех ненавижу!
kpblc
ты про download тамошний? Я его не отслеживаю - и без того негрустно (хочешь, посмотри, к примеру, задачку http://dwg.ru/forum/viewtopic.php?p=174368 - у меня что-то логика зашкалила.
Насчет "кто есть ху" - попробуй использовать группы, может, они тож помогут.
Добавлено: Посты почистил по обсуждению кода
mmax
Поробую вернуться к теме создания спецификации.
Мной было замечено и случайно установлено, что
В ОС Vista, если компьютор перезагружен, и после перезагрузки Excel ниразу не запускался, то при выполнении кода
Код
(setq excelobj (vlax-create-object "Excel.Application"))

excelobj получается только если выполнить код 2-3 раза. Первый запуск будет nil 100%.
тоже самое в VS2005
Код
dim excelobj as object
excelobj = createobject("Excel.Application", "")

тут ошибка Err().Number = 429.
при повторных запусках объект получается без проблем.

Если же ексель запускался обычным образом, то объект формируется с первого раза



Если в бейсике можно проигнорировать ошибку без проблем, добавив:
Код
on error resume next

и до end sub все ошибки будут проигнорированы.

То в лиспе вот так вот просто это сделать не получится.
Есть над чем голову поломать.
kpblc
В лиспе есть специальная функция (vlax-get-or-create-object), ею и пользуйся. Ведь и в VB приходится делать аналог:
Код
' VB 6.0, VBA
Sub Main()
Dim objExcel As Object
  On Error Resume Next
  Set objExcel = GetObject("Excel.Application", "")
  If Err.Number <> 0 Then
    Err.Clear
    On Error GoTo 0
    Set objExcel = CreateObject("Excel.Application")
  End If
  ' Ну и тут пошли операции с ним
End Sub

Код
' VB.NET 2002Public Function MyFunc()
        Dim objExcel As Object
        Try
            objExcel = GetObject(, "Excel.Application")
        Catch
            objExcel = CreateObject("Excel.Application"))
        End Try
        ' Ну и так далее
    End Function

В .NET я не работаю (не довелось sad.gif), так что там могут быть проблемы.
mmax
Ты так ничего и не понял.
GETobject, не даст объекта, даже с сотого запуска, если ексель в данный момент не запущен.
CREATEobject дает объект даже если приложение НЕ запущено, если приложение запущено, то она запустит его в отдельном процессе.
Это делаеца одинаково что в VS что в LISP.

Тут ситуация другая: в ос Windows Vista нужна функция create-or-create-object

если я ВКЛЮЧИЛ компьютор, и сразу запустил программу взаимодействующую с екселем, НЕ запуская ексель обычными способами, то функция CREATEobject не даст объекта, с первого раза.
пару раз замечалось, что объект получается только с третьего раза.

если я ВКЛЮЧИЛ компьютор, и запустил Ексель из меню пуск, а потом закрыл его. Или пользовался программами которые используют объектную модель екселя
то CREATEobject сработает сразу.

Тоесть получается вывод, если в процессе работы компьютора, с момента его включения, к екселю не было обращений, то функция CREATEobject возвратит объект только если ее запустить не менее 3х раз, причем это самое количество раз окончательно не установлено.
Если в автокаде выполнить 1раз (vlax-create-object), то возвратится nil, а потом в VS CREATEobject, то объект получается. Тоже самое наоборот VS CREATEobject = ошибка -> (vlax-create-object)=vlaobject, тоже самое c (vlax-get-or-create-object) -- превый раз пролетаем.

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

для того чтобы дотучаться до объекта, пришлось сделать вот так:

Код
Dim eobj As Object
        On Error Resume Next
        Err().Clear()
        eobj = CreateObject("Excel.Application", "")
        MsgBox(eobj) 'если объект найден этого сообщения не будет, если не найден будет сообщение без текста

        If Err().Number = 429 Then
            Err().Clear()
            eobj = CreateObject("Excel.Application", "")
            MsgBox(eobj)
        End If


        If Err().Number = 429 Then
            Err().Clear()
            eobj = CreateObject("Excel.Application", "")
            MsgBox(eobj)
        End If

        If Err().Number = 429 Then
            Err().Clear()
            MsgBox("Excel not found")
        End If


Не знаю, есть ли такая проблема в XP, у меня Vista.
также не установлено проблема это только с объектами офиса, или такая бодяга и с другими приложениями.
У Vistы есть еще одна проблема, ЗАКРЕПЛЕННЫЕ в меню пуск ярлыки AutoCAD2008EN, Excel Word (2003), не работают вообще. А которые в ПУСК->Программы и перетащенные на рабочий стол работают.

Вобщем я хочу поднять вопрос о совместимости.
Если так прикинуть, то в старых программах есть средства обработки событий связанных с отсутствием чего либо и особо страшного ничего не произойдет.
но вот конкретно в моей ситуации это самое "чего либо" присутствует и зарегистрировано, но при первом запуске раньше всегда получалось NOT FOUND, а потом работает нормально. Мелочь но НЕприято mad.gif .
И если моя теперяшняя программа запрашивает объект три раза, и это не гарантирует положительного результата, то при использовании старой прораммы в новой ОС нас может ждать полный Not Found.
kpblc
Ну извини, я Vista не ставил - машина не потянет, да и многие вещи (в том числе и по работе) приходится делать с расчетом на Win2k, максимум на ХР. Скорее всего, у тебя в офисе не установлена поддержка .NET-программирования (это только мои подозрения, не больше). И, как следствие, у тебя идет попытка найти офисные приложения через старые API-функции и не находит. А то, что после запуска обнаруживается - ну бог его знает, по каким причинам. ЯТД, проблема в ОС.
---
Добавлено: хотя на фига открывать Excel, я не очень понимаю. Учитывая тенденции некоторых контор переходить на OpenOffice, решение теряет смысл. Файл можно и так записать - хоть как xls (обычный текстовый файл, с разделением \t), хоть как xml, проанализировав тот вариант, который сделает Excel. Работка муторная, но иногда необходимая.
mmax
Ну не везде так плохо. На завод врядли пустят представителей Microsoft, для проверки компов. Всетаки частная собственность, объект повышенной опасности итп, служба охраны круче ФСБ....

Supermax
Kpblc, с темы в DWG.RU про маркировку я ушел. Не та тусовка. Лично тебе скажу, Свойство длинны дублировать атрибутом DLINA - глупо. Надо читать свойство (тут у нас в теме это описано), округлять значение и прописывать полученное значение этому же свойству. Элементы слегка дернуться и станут видны нахлесты, или недостача. Все *Unnn тоже подравняются и будут готовы к использованию (если то потребуется).
Проставлять на плане вместо номера элемента номер позиции в спецификации, что окрестили как маркировка (хотя маркировка это присвоение марки изделию) - продукт деградации нашего проектного дела. Я не могу так маркировать элементы только по тому, что мне приходится составлять тех. карты в которых я должен описать последовательность установки изделий, даже если они все одинаковые. Вот пронумеровать их так, чтобы одна длина была описана номерами без пропусков 1, 2, 3, ....10, 11 а следующая длина была 12, 13, 14, .... 21, 22 и т.д. дело стоящее. Тогда в спецификации пишется все замечательно Длина 1 эл.ты №1-11. Длина 2 Эл.ты 12-22. Собрать все имена блоков, подравнять длины, сгруппировать, ну и посчитать заодно и промаркировать.
Так, что-то мы забежали очень далеко в перед. Но концепция примерно такая.

Добавил: VVA я сюда завернул, может и пригодится.
kpblc
Я не в силах спорить (температурю со страшной силой), хочу только одно сказать - твой подход может оказаться неприменим в некоторых областях. Например, при проектировании навесных фасадов одинаковые элементы маркируются (им проставляются позиции) одинаково. Может, еще и в ЖБ аналогично - не помню. Я ж не зря в самом начале говорил, что надо определяться с тем, какие критерии важны. Потому что если этого не сделать, то получается нечто типа того чудовища, что я выкладывал.
Supermax
Твое возражение принимаю, но замечу, что голыми цыфрами это делать нельзя. Вот чел. стойки на чертеже указал и спецификацию что, только на стойки выпустил? Интересная спецификация однако... Ладно, на том же листе табличку вставил, а проект что из одного листа состоит? В конце общую спецификацию что Бобринский делать будет? Или при заказе материалов снабженцу все чертежи перелопачивать прийдется?
Чтобы на эту тему больше не болела голова, предлагаю выделить место в атрибутах и для позиции, и для номера элемента. Так будет на все случаи жизни.
К стати надо не в программу вводить буквы, а читать значение в этом атрибуте и соединять с ним цифру из проги.
Атрибут в блоке лежит скажем со значением "Стойка-" Чел. копирует этот блок туда, сюда, а прога все просчитав прибавляет к Стойка- цыфру 5 (к примеру) Получается Стойка-5.
Так какие хочешь обозначения писать можно. И вот тогда, меняя имя блока можно нумеровать в пределах одной группы.
Для длинномеров это не подойдет. Одна группа - труба ППУ ДУ-57, другая группа - Труба ППУ ДУ-159, позиции в спецификации не просто разные, в каждой группе еще и длины разные, а это значит, что в следующей группе первым номером должен стоять следующий после последнего в предидущей группе. На чертеже не укажешь в кружочке "Труба ППУ ДУ-57-номер позиции". Если оставить одни цифры например: 159-22 где 159 это Труба ППУ ДУ-159, а 22 это номер позиции, то 159-22 рядом с элементом никто с набегу понять не сможет. Тем более, что 159 может быть безусловная отметка поверхности земли и вся геоподоснова может ими быть испещрена.

Надо использовать Tolerance.

Так в принципе что-то вырисовывается, Берем и выравниваем длины всем блокам, какие нужно подравнять. Затем, выбираем все, которые надо нумеровать и позиционировать, в смысле присваивать номер позиции. Берем первое имя, анализируем массив, позиционируем и нумеруем, записываем последние значения позиции и номера, берем следующее имя и т.д.
Supermax
Kpblc, как здоровье? Ты что подхватил? Тебе болеть нельзя! Ты Родине нужен!
Павлов когда умирал, он заставил своих учеников стоять над ним и записывать то, что он им говорит. А он им говорил, то что с ним в данный момент происходило. Они плакали, но писали. Не помню, на чем закончилась эта экзекуция, но про то, что ноги у него перестали чувствоваться он им сообщить успел.
Kpblc, можно ли программно переименовать один конкретный блок? Вот их у меня штук сто, а мне надо один изменить, тобишь создать новый с таким же именем и местоположением и заменить им старый. Понятно, что если задавать уже имеещееся имя, прога должна ругаться, но в принципе, ты с такой задачей когда-нибудь сталкивался?
mmax
если не поможет vla-put-name или еще какойнибудь vla-put*, то остается только вычистить его из документа и вставить новый з новым именем.
Supermax
Ты представляешь, что такое "вставить"? В нем сотни две элементов поставленные на элементы предидущего блока, который потом выключается, а эти элементы объединяются в новый блок, потом он копируется и вот доходит до такого места, где он уже чуть-чуть не катит. Если бы его переименовать как-то, я бы его редактором открыл и детальку подвинул, а так, надо все кроме него выключать, взрывать, потом все включать, а это ого-го сколько включется. Мне столько включать не надо, потому, что может слететь. Даже если я все включу, потом выключать опять прийдется.
Не, надо ничего трогать. Надо поменять блоку имя. Но как?

Ну мне понятно, что такое описание блока и описание его вхождения. Надо к существующим описаниям добавить новое, скопированное со старых и в описании вхождения старого блока стереть вхождение о котором мы говорим.
mmax
Вот все работает и не надо ничего чистить.
Код
(vl-load-com)
(setq blockref (vlax-ename->vla-object (car(entsel "\nSelect Block"))))

(setq bloks (vla-get-blocks (vla-get-activedocument(vlax-get-acad-object))))

(setq block (vla-item bloks (vla-get-name blockref)))

(vla-put-name block "MyName")


соответственно переименовываются и все вставленные в модель и листы
Supermax
Не-е брателло, так не пойдет. Так он всем вхождениям меняет имя, так я и через rename сделаю.
Мне надо конкретное 100-ое вхождение старого блока сделать первым вхождением нового.
Говорю же надо описание блока копировать.
Supermax
Mmax, ты не представляешь как я это решил!
Я скопировал в буфер блок, открыл новый файл, вставил туда блок с оригинальными параметрами точки вставки (последняя строчка), переименовал блок, опять скопировал в буфер, вернулся в старый файл, там грохнул существующий и вставил из буфера (опять с оригинальными точками) новый.
Вуаля!

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
Не, не выздоровел sad.gif
Конечно, на боевой не надо. Потому что я проверял, скажем так, в тепличных условиях. Код старается заменить полностью блок, с исходной точкой вставки, нормалью и коэффициентами; слой, тип, вес и цвет линии копируются. По ходу пытается дин.свойства скопировать.
---
Добавлено:
Для проверки попробуй так:
Код
(test (car (entsel "\nExist")) (vla-get-EffectiveName (vlax-ename->vla-object(car(entsel "\nNew : ")))))

Сначала клик на заменяемый блок, потом - на вставляемый на его место
Supermax
Ну клик на заменяемый я понял, а на вставляемый? Это же он и есть! Я его меняю на него же! Но с новым именем.
kpblc
Ну извини, но я, честно говоря , не понимаю смысла городить абсолютно одинаковые блоки, только с разными именами. Если с обычными блоками я такой номер еще могу провернуть, то с динамическими я пас.
Supermax
Да обычные у меня блоки. Говорю персонально тебе еще раз. Надо подредактировать группу элементов объединенных в блок. Копий этого блока штук 100. В 101 надо изменить в нутри кое-что.
Предидущие 100 должны остаться прежними. Понятно дело, что подредактированный блок должен быть уже с другим именем. Значит мне надо создать новый блок с новым именем, но все параметры списать с указанного. Потом я этот новый блок открою и подредактирую.
Внешне это будет выглядеть так:
Нажал кнопень, выскачило entsel - указал блок, спросило новое имя - указал новое имя, нажал ентер. Все. В базе новый блок, а вместо старого, на который я указал стоит новый. Внешне это даже не заметно, поскольку они братья близняшки. Как будто я его переименовал.
Supermax
В редакторе блоков есть "сохранить как", но это просто в базе создается новое описание блока, а его положение в пространстве не сохраняется. То вхождение, которое было использовано для открытия редактирования блока при этом остается со старым именем. Чтобы вставить новое вхождение надо жать insert block и попадать в цель,. а это не возможно по некоторым причинам.
Supermax
Народ! Я забыл как очищать базу от мусора и не использованных блоков bang.gif Спасите!
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
Supermax
У меня Select object: Too many actual parameters
Блок остался прежний.
Supermax
В базе он создался, а вот в модель не попал.
kpblc
<...>Код удален, см.#282
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.
kpblc
Код
Comman: _usc<enter>_w<enter>

Файл скачиваю, гляну.
Посмотрел, все ясно. Код исправил (#282), команду можно не вводить.
---
Добавлено: для ускорения обработки можешь попробовать не ставить скругления у кирпичей - эффекта минимум, а нагрузки максимум (ИМХО, конечно).
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. За доброе слово спасибо. Оно, как известно, и кошке приятно smile.gif
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. В коде изначально была ошибка, исправил.
Supermax
Kpblc, возьми AutiLisp и Visual Lisp в среде AutoCAD стр. 253 9-я строка с низу.

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

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

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

*Unnn - оставь.
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 - тоже имя) задавать еще и слой? У одного примитива слой такой-то, а у другого слой другой? Либо надо включать губоскатывающую машинку и ограничивать коомбинации выбора. Что посоветуешь?
Для просмотра полной версии этой страницы, пожалуйста, пройдите по ссылке.
Форум IP.Board © 2001-2025 IPS, Inc.