[Zaghim]

Друзья, разобрался как вытаскивать все значения атрибутов в дин. блоке. Блок создан с 4 визибл сетами, в каждом имеются атрибуты. Все это дело я вытащил после вставки блока, оно в таком виде:

Код:

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

(("A4" "Kk-1" (858.317 95.3675 0.0) (0.0 0.0 0.0) 0.0) ("B4" "0.000" (858.317 
93.6771 0.0) (0.0 0.0 0.0) 0.0) ("C4" "лот. 0.000" (858.317 91.9686 0.0) (0.0 
0.0 0.0) 0.0) ("A3" "Kk-1" (858.376 97.0163 0.0) (0.0 0.0 0.0) 0.0) ("B3" 
"0.000" (858.347 95.3185 0.0) (0.0 0.0 0.0) 0.0) ("C3" "лот. 0.000" (858.334 
93.6374 0.0) (0.0 0.0 0.0) 0.0) ("D3" "лот. 0.000" (858.305 91.9731 0.0) (0.0 
0.0 0.0) 0.0) ("A2" "Kk-1" (858.445 97.0166 0.0) (0.0 0.0 0.0) 0.0) ("B2" 
"0.000" (858.408 95.3499 0.0) (0.0 0.0 0.0) 0.0) ("C2" "0.000" (858.372 93.6487 
0.0) (0.0 0.0 0.0) 0.0) ("D2" "лот. 0.000" (858.355 91.9818 0.0) (0.0 0.0 0.0) 
0.0) ("A1" "Kk-5" (858.333 98.684 0.0) (0.0 0.0 0.0) 0.0) ("B1" "0.000" 
(858.298 97.004 0.0) (0.0 0.0 0.0) 0.0) ("C1" "0.000" (858.319 95.3469 0.0) 
(0.0 0.0 0.0) 0.0) ("D1" "лот. 0.000" (858.308 93.6627 0.0) (0.0 0.0 0.0) 0.0) 
("E1" "лот. 0.000" (858.256 91.9879 0.0) (0.0 0.0 0.0) 0.0))

Как выдернуть и заменить значения - понятно. А как теперь всю эту прелесть впихнуть назад и вставить блок в чертеж с нужными мне параметрами?

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

Файл с блоком приложи. Потому как (ИМХО) лучше работать через ActiveX, чем через DXF.

[Zaghim]

Вот оно

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

Код:

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

(vl-load-com)

(defun dwgru-block-set-attr (block tag value / att err)
                            ;|
*    Устанавливает значение указанного атрибута для вхождения блока
|;
  (if (and (setq block
                  (cond
                    ((= (type block) 'ename) (vlax-ename->vla-object block))
                    ((= (type block) 'vla-object) block)
                    ) ;_ end of cond
                 ) ;_ end of setq
           (wcmatch (strcase (vla-get-objectname block)) "*BLOCK*")
           (equal (vla-get-hasattributes block) :vlax-true)
           (setq att (car (vl-remove-if-not
                            (function
                              (lambda (x)
                                (= (strcase tag) (strcase (vla-get-tagstring x)))
                                ) ;_ end of lambda
                              ) ;_ end of function
                            ((lambda (/ res)
                               (foreach item (vlax-safearray->list (vlax-variant-value (vla-getattributes block)))
                                 (setq res (cons item res))
                                 ) ;_ end of vlax-for
                               (reverse res)
                               ) ;_ end of lambda
                             )
                            ) ;_ end of vl-remove-if-not
                          ) ;_ end of car
                 ) ;_ end of setq
           ) ;_ end of and
    (if (vl-catch-all-error-p
          (setq err (vl-catch-all-apply
                      (function
                        (lambda ()
                          (vla-put-textstring att value)
                          (vla-update block)
                          ) ;_ end of lambda
                        ) ;_ end of function
                      ) ;_ end of vl-catch-all-apply
                ) ;_ end of setq
          ) ;_ end of vl-catch-all-error-p
      (princ (strcat "\n ** error ** : " (vl-catch-all-error-message err)))
      ) ;_ end of if
    ) ;_ end of if
  ) ;_ end of defun

Пример вызова:

Код:

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

(dwgru-block-set-attr (car (entsel)) "a2" "test3")

[Zaghim]

Ахренеть, круто конечно, но не работает(((
Точнее работает, но ничего не происходит!

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

Какой атрибут меняешь? Этот атрибут показывается или нет?
---
Добавлено: я код специально проверял, у меня в AutoCAD 2008 все работало без вопросов.

[Zaghim]

Попробовал поменять разные, т.е. (dwgru-block-set-attr (car (entsel)) "Тут либо А1, либо В1" "test3")
Атрибут остается прежним

[TararykovDG]

Раз уж Кулик Алексей aka kpblc уже привел код с использованием ActiveX и со всеми проверками и ловушками ошибок, то я покажу как решить задачу через DXF коды. Zaghim, раз уж ты сам добрался до данных об атрибутах, то сам и доделаешь их изменение, по следующей схеме.

Код:

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

(setq obj (car (entsel))) - указали блок на чертеже
(setq obj_atr (entnext obj)
         ed (entget obj_atr)) - получили какой-то атрибут
(setq ed (subst (cons 1 "Новое значение") (assoc 1 ed) ed)) - присвоили новое значение
(setq ed (subst (cons 50 pi) (assoc 50 ed) ed)) - новый угол поворота
(setq ed (subst (cons 40 5) (assoc 40 ed) ed)) - новая высота текста
(entmod ed) - применили изменения
(entupd obj) - перерисовали блок (в книгах пишут, что это надо делать, хотя лично у меня работает и без этой строки)

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

Немного изменил #4.
---
Добавлено: при копировании неправильный код вбил Прошу прощения, исправил.

[Zaghim]

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

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

Сообщение от Zaghim думаю не раз пригодится

Нумераторов блоков на форуме немеряно... Появится еще один

[Zaghim]

Ну это же не нумератор, а "изминятор")))
И тем более с динамическим блоком в котором куча атрибутов.

Код:

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

(defun c:mip ()
  (vl-load-com)
  (setq nambl "путь и имя файла")
  (command "INSERT" nambl)
  (command)
  (setq cl 1)
  (if (= num nil)
    (setq num 1)
  )  
  (while cl
    (setq bp1 (getpoint "\nТыкай точку или <Enter>:"))
      (if (= bp1 nil)
        (setq cl nil)
    (progn
      (setq numbl "Kk-")
          (setq numm (itoa num))
          (setq numbl (strcat numbl numm))
          (setq num (1+ num))
          (vl-cmdf "INSERT" "Kk" bp1 1 1 0 numbl """""""")
      (setq e1 (entlast))
          (setq ed (entget e1))
          (if (and
        (= (cdr (assoc 0 ed)) "INSERT") ;_Блок
        (= (cdr (assoc 66 ed)) 1)       ;_След аттриб
          )
          (progn
            (setq e1 (entnext e1))
            (while (AND e1
          (= (cdr (assoc 0 (setq ed (entget e1)))) "ATTRIB")
              ) 
          (setq imattr (cdr (assoc 2 ed))
                    znattr (cdr (assoc 1 ed))
                    bp1attr (cdr (assoc 10 ed))
                    bp1attr11 (cdr (assoc 11 ed))
                    ugattr (cdr (assoc 50 ed))
              )
          (if (or (= imattr "A1") (= imattr "A2") (= imattr "A3") (= imattr "A4"))
                (progn
              (setq ed (subst (cons 1 numbl) (assoc 1 ed) ed))
              (entmod ed)
              (entupd e1)
            )
          )
            (setq e1 (entnext e1))
            );while
          );progn  
        )
      )
    )
  )
)

Скобки не проверял, но вариант рабочий!

[Kavalergrad]

Что то не работает. В командной строке постоянно стоит: Тыкай точку или <Enter>. Тыкаешь точку , а в ответ: Неизвестная команда "MIP". Для вызова справки нажмите F1.