[{Smirnoff}]

Преамбула
Писал я тут для человека функцию по вставке в блок невидимых атрибутов http://dwg.ru/forum/viewtopic.php?t=2258&start=30 . Выяснилось что после вставки атрибуты не появляються во вхождениях которые уже на экране, поэтому была написана функция refReinsert которая удаляет и вновь вставляет блок.
Фабула
При попытке сохранить место вставки блока (в Модели или в Листах) выяснилось что (vla-get-OwnerID для вхождений блоков расположенных на листах возвращает число соответствующее Модели.

Как получить метку объекта которому пренадлежал блок?

Функцию можно особо не смотреть, сейчас там только вставка в пространство Модели.

[Alaspher]

Не очень понял, в чём проблема. Вот, глянь такой код для аналогичной задачи:

Код:

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

(defun pl:reinsert (/ doc snam sels sel slst)
  (setq doc  (vla-get-activedocument (vlax-get-acad-object))
        snam "pl-temp-selection"
        sels (vla-get-selectionsets doc)
  )
  (if (vl-catch-all-error-p
        (setq sel (vl-catch-all-apply (function vla-item) (list sels snam)))
      )
    (setq sel (vla-add sels snam))
  )
  (vla-clear sel)
  (vla-selectonscreen
    sel
    (vlax-safearray-fill (vlax-make-safearray vlax-vbinteger '(0 . 0)) '(0))
    (vlax-safearray-fill (vlax-make-safearray vlax-vbvariant '(0 . 0)) '("INSERT"))
  )
  (vlax-for x sel (setq slst (cons x slst)))
  (vla-clear sel)
  (vla-delete sel)
  (foreach x slst
    (vla-insertblock
      (vla-objectidtoobject doc (vla-get-ownerid x))
      (vla-get-insertionpoint x)
      (vla-get-name x)
      (vla-get-xscalefactor x)
      (vla-get-yscalefactor x)
      (vla-get-zscalefactor x)
      (vla-get-rotation x)
    )
    (vla-delete x)
  )
  (princ)
)

Вызов:

Код:

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

(pl:reinsert)

Делал для себя, так что - без нормального интерфейса.

[{Smirnoff}]

Спасибо! (vla-objectidtoobject то что нужно, я не знал о существовании этой функции. Да и на красивое программирование посмотрел

[Alaspher]

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

[{Smirnoff}]

Конечно выкладывай. Я пока считаю себяначинающим, интересно посмотреть на альтернативный красивый код.

Проблемма моя заключалась в том что не имея в арсенале (vla-objectidtoobject я собирал в список все ObjectID модели и листов и сравнивал с OwnerID вхождений блока. Так вот OwnerID вхождений на листах почему то указывал на Модель, где они и оказывались после Reinsert. С вышеописанной функцией все встало на свои места.

Кстати книгу вашу совместную+CD сейчас читаю (незнаю личный вклад, просто принадлежность к "курганской бригаде"). Много интересного нахожу. Правда меню я пишу в ObjectDCL, та тоже "дерево" присутствует. XML прекрасная штука и достаточно развитая технология, во всяком случае чувствуешь свой контроль за происходящим, в отличии от ObjectDCL где скрыто много "глюков" которые от тебя никак не зависят. Но к сожалению я не ПРОГРАММИСТ чтобы писать связки на PASCAL. Хотя кто его знает, VC лежит на диске готовый к установке, как то тут для брата жены делал курсовик с заданием на JavaScript, так минут за 40 справился, просматривая аналогичные примеры и имея на руках тоненькую брошурку с основными понятиями C++... Посмеялись бы наверное профи, хотя курсовик "прокатил", тем более что на Web странице все работало как положено.

Я вообще поражаюсь, курсовик какое то "детство", его можно сделать за день от начала и до конца, может на ПЛАТНЫХ отделениях ВУЗов сейчас так положено? Тем более я вообще непонимаю как он там учится. Впал в личное...

[Alaspher]

Сообщение от Fantomas Проблемма моя заключалась в том что не имея в арсенале (vla-objectidtoobject я собирал в список все ObjectID модели и листов и сравнивал с OwnerID вхождений блока. Так вот OwnerID вхождений на листах почему то указывал на Модель, где они и оказывались после Reinsert.

Если всё делать правильно, то такого быть не должно. Видимо, где-то ошибка вкралась.

Кстати книгу вашу совместную+CD сейчас читаю (незнаю личный вклад, просто принадлежность к "курганской бригаде"). Много интересного нахожу.

Мы старались Про "личный вклад" и "принадлежность" :wink: (я Курган не видел даже ни разу): http://www.kurganobl.ru/cad/structur...rent=1&id=21#b

Обещаная утиль:

Код:

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

(defun pl:reinsert-attval-all (/ doc layfr laylc laylst lays sel sels slst snam tmp)
  (setq doc  (vla-get-activedocument (vlax-get-acad-object))
        snam "pl-temp-selection"
        sels (vla-get-selectionsets doc)
        lays (vla-get-layers doc)
  )
  (if (vl-catch-all-error-p
        (setq sel (vl-catch-all-apply (function vla-item) (list sels snam)))
      )
    (setq sel (vla-add sels snam))
  )
  (vla-clear sel)
  (vla-select
    sel
    acselectionsetall
    nil
    nil
    (vlax-safearray-fill (vlax-make-safearray vlax-vbinteger '(0 . 0)) '(0))
    (vlax-safearray-fill (vlax-make-safearray vlax-vbvariant '(0 . 0)) '("INSERT"))
  )
  (vlax-for x sel (setq slst (cons x slst)))
  (vla-clear sel)
  (vla-delete sel)
  (setq laylst (list (getvar "clayer")))
  (foreach x slst
    (setq tmp (vla-get-layer x))
    (if (not (vl-position tmp laylst))
      (setq laylst (cons tmp laylst))
    )
    (if (= (vla-get-hasattributes x) :vlax-true)
      (foreach y (vlax-safearray->list (vlax-variant-value (vla-getattributes x)))
        (setq tmp (vla-get-layer y))
        (if (not (vl-position tmp laylst))
          (setq laylst (cons tmp laylst))
        )
      )
    )
  )
  (setq laylst (mapcar (function (lambda (x) (vla-item lays x))) laylst)
        layfr  (vl-remove-if-not
                 (function (lambda (x) (= (vla-get-freeze x) :vlax-true)))
                 laylst
               )
        laylc  (vl-remove-if-not
                 (function (lambda (x) (= (vla-get-lock x) :vlax-true)))
                 laylst
               )
  )
  (foreach x layfr (vla-put-freeze x :vlax-false))
  (foreach x laylc (vla-put-lock x :vlax-false))
  (foreach x slst
    (setq tmp (vla-insertblock
                (vla-objectidtoobject doc (vla-get-ownerid x))
                (vla-get-insertionpoint x)
                (vla-get-name x)
                (vla-get-xscalefactor x)
                (vla-get-yscalefactor x)
                (vla-get-zscalefactor x)
                (vla-get-rotation x)
              )
    )
    (foreach y '("layer" "linetype" "linetypescale" "lineweight" "color")
      (vl-catch-all-apply
        (read (strcat "vla-put-" y))
        (list tmp (vl-catch-all-apply (read (strcat "vla-get-" y)) (list x)))
      )
    )
    (pl:attreval x tmp)
    (vla-delete x)
  )
  (foreach x layfr (vla-put-freeze x :vlax-true))
  (foreach x laylc (vla-put-lock x :vlax-true))
  (princ)
)

(defun pl:attreval (from to / att1 att2 layfr laylc laylst lays layto tmp)
  (if (and (setq from (pl:get-att-with-tag from)) (setq to (pl:get-att-with-tag to)))
    (foreach x from
      (if (setq tmp (assoc (car x) to))
        (progn
          (setq att1 (cdr x)
                att2 (cdr tmp)
          )
          (if (= (vla-get-constant att2) :vlax-false)
            (progn (setq lays   (vla-get-layers (vla-get-document att2))
                         laylst (list (vla-item lays (vla-get-layer att2)))
                   )
                   (if (vl-catch-all-error-p
                         (vl-catch-all-apply
                           (function vla-item)
                           (list lays (setq layto (vla-get-layer att1)))
                         )
                       )
                     (setq laylst (cons (vla-add lays layto) laylst))
                   )
                   (setq layfr (vl-remove-if-not
                                 (function (lambda (x) (= (vla-get-freeze x) :vlax-true)))
                                 laylst
                               )
                         laylc (vl-remove-if-not
                                 (function (lambda (x) (= (vla-get-lock x) :vlax-true)))
                                 laylst
                               )
                   )
                   (foreach x layfr (vla-put-freeze x :vlax-false))
                   (foreach x laylc (vla-put-lock x :vlax-false))
                   (foreach y '("alignment"
                                "backward"
                                "height"
                                "insertionpoint"
                                "linetype"
                                "linetypescale"
                                "lineweight"
                                "obliqueangle"
                                "scalefactor"
                                "stylename"
                                "textstring"
                                "thickness"
                                "color"
                                "upsidedown"
                                "layer"
                               )
                     (vl-catch-all-apply
                       (read (strcat "vla-put-" y))
                       (list att2 (vl-catch-all-apply (read (strcat "vla-get-" y)) (list att1)))
                     )
                   )
                   (foreach x layfr (vla-put-freeze x :vlax-true))
                   (foreach x laylc (vla-put-lock x :vlax-true))
            )
          )
          (vl-remove tmp to)
        )
      )
    )
  )
)

(defun pl:get-att-with-tag (ins)
  (if (= (vla-get-hasattributes ins) :vlax-true)
    (mapcar (function (lambda (x) (cons (vla-get-tagstring x) x)))
            (vlax-safearray->list (vlax-variant-value (vla-getattributes ins)))
    )
  )
)

Запуск:

Код:

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

(pl:reinsert-attval-all)

Во всех возможных ситуациях не тестировалась, так что - могут быть и ошибки. Например, функция: (pl:attreval) предназначена для копирования значений и параметров атрибутов, в том числе, между разными документами, но реально в таком виде не использовалась.
Из известных проблем - при наличии атрибутов с одинаковыми тегами, при этом, когда повторяющийся тег есть в новом атрибуте, такие атрибуты могут накладываться один на другой.

[{Smirnoff}]

Приятно познакомится Уже с ходу вижу, несколько полезностей для сокращения собственного кода. Но еще надо разбираться.

Спасибо!

[Alaspher]

Всегда, пожалуйста.