[Андрей Будзинский]

Добрый день!
Уважаемые форумчане, если кто знает, подскажите, каким образом мне добавить во все существующие блоки атрибут с определённым именем?
Заранее большое спасибо!

[VVA]

1. Добавить атрибут в описание блока (_BEDIT)
2. Синхронизировать описание с вхождением (_ATTSYNC)

Можно попробовать лиспом
-AddAtt(0.8) Утилита для добавления атрибутов во вставку блока, версия: 0.8 (бета)

[Андрей Будзинский]

Да, конечно это способ, но вопрос идёт именно о програмном создании атрибута для абсолютно всех блоков в чертеже. Т.е. хочется получить команду, при вызове которой можно было бы выделить необходимые (или все) блоки и создать в них атрибут с определённым именем. Мне это необходимо для того, чтобы запустить Вашу программу по присвоению значения длины 3д тела в блоке атрибуту этого блока!
Может выручите ещё разок

[VVA]

Андрей Будзинский,
Модифицировал код Петра Лоскутова (Alaspher) AddAtt для использования совместно с этим кодом

Код:

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

;;; На основе AddAtt.LSP Модифицировано Владимир Азарко (VVA) для dwg.ru ( http://dwg.ru/dnl/6638 )
;;; *****************************************************************************************
;;; AddAtt.LSP
;;; *****************************************************************************************
;;; Copyright ©2005 Пётр Лоскутов (Alaspher)
;;; e-mail: alaspher@hotmail.com
;;; *****************************************************************************************
;;; ВЕРСИЯ: 0.8 beta
;;; *****************************************************************************************
;;; ОГРАНИЧЕНИЕ ГАРАНТИЙ
;;; ПРОГРАММА РАСПРОСТРАНЯЕТСЯ НА УСЛОВИЯХ "КАК ЕСТЬ".
;;; АВТОР НЕ БЕРЕТ НА СЕБЯ И НЕ ПОДРАЗУМЕВАЕТ КАКИХ-ЛИБО ГАРАНТИЙНЫХ ОБЯЗАТЕЛЬСТВ.
;;; ВЫ ИСПОЛЬЗУЕТЕ  ПРОГРАММУ НА СВОЙ РИСК.
;;; АВТОР НЕ БЕРЕТ НА СЕБЯ ОТВЕТСТВЕННОСТЬ ЗА ПОТЕРЮ ДАННЫХ, УЩЕРБ, ПОТЕРЮ ПРИБЫЛИ ИЛИ ЛЮБЫЕ
;;; ДРУГИЕ ПОТЕРИ, ПРОИЗОШЕДШИЕ ВО ВРЕМЯ ИСПОЛЬЗОВАНИЯ ИЛИ НЕПРАВИЛЬНОГО ИСПОЛЬЗОВАНИЯ
;;; ДАННОГО ПРОГРАММНОГО ОБЕСПЕЧЕНИЯ.
;;; *****************************************************************************************
;;; Разрешается   использовать,   копировать,   изменять,  и  распространять  это программное
;;; обеспечение бесплатно, при  условии, что программное обеспечение,  полностью или частично
;;; включающее данное ПО,  будет распространяться  на тех-же условиях,  а указанные выше знак
;;; авторского права и примечания об ограничениях гарантий будут приводиться во всех копиях.
;;; *****************************************************************************************
;;; 
(defun dwgru:add-att-to-ins (/ adoc atrib atg blget block blold dxf66 freeze isatt lays layus lock ntag oldlst seqend tlst ss)
  (vl-load-com)
  (setq adoc (vla-get-activedocument (vlax-get-acad-object))
        lays (vla-get-layers adoc)
  )
  (if (and (setq ss
                  (ru-ssentget-by-type "Выбери вставку блока" '("INSERT") 14)
           ) ;_ end of setq
           (setq atrib '((0 . "ATTDEF")
                          (100 . "AcDbEntity")
                          (8 . "0")
                          (100 . "AcDbText")
                          (10 0.0 0.0 0.0) ;;;Точка вставки
                          (40 . 10.0)  ;;;Высота
                          (3 . "Длина 3d тела") ;;;Подсказка
                          (2 . "SOLIDLENGTH") ;;;Имя атрибута
                          (1 . "")
                          (50 . 0.0)
                          (41 . 1)
                          (51 . 0.0)
                          (7 . "Standard")
                          (71 . 0)
                          (72 . 0)
                          (11 0.0 0.0 0.0)
                          (210 0.0 0.0 1.0)
                          (100 . "AcDbAttributeDefinition")
                          (70 . 0)
                          (73 . 0)
                          (74 . 0)
                         )
           ) ;_ end of setq
      ) ;_ end of and
    (progn
       (vla-endundomark adoc)
       (vla-startundomark adoc)
      (foreach block (pl:sel-to-list ss)
         (setq blget  (entget block)
                 blold  block
                 oldlst (list blget)
           )
        (setq atrib (subst (assoc 10 blget)(assoc 10 atrib) atrib)) ;;_Замена точки вставки на точку втавки блока
           (if (and (setq dxf66 (assoc 66 blget)) (= 1 (cdr dxf66)))
             (progn (while (and (setq block (entnext block))
                                (/= (cdr (assoc 0 (setq blget (entget block)))) "SEQEND")
                           )
                      (setq oldlst (cons blget oldlst)
                            tlst   (cons (cdr (assoc 2 blget)) tlst)
                      )
                    )
                    (setq seqend blget)
             )
             (setq oldlst (list (if dxf66
                                  (subst '(66 . 1) dxf66 (car oldlst))
                                  (append (car oldlst) '((66 . 1)))
                                )
                          )
             )
           )
           (if (not seqend)
             (setq seqend (append '((0 . "SEQEND") (100 . "AcDbEntity"))
                                  (pl:dxf-mltclr (last oldlst) '(67 410 8) t)
                          )
             )
           )
           (setq atg    (mapcar (function (lambda (a) (pl:dxf-mltclr a '(-1 3 5 330) nil))) (list atrib))
                 layus  (mapcar (function (lambda (a) (vla-item lays a)))
                                (pl:list-del-double
                                  (cons (cdr (assoc 8 seqend))
                                        (mapcar (function (lambda (a) (cdr (assoc 8 a)))) (append oldlst atg))
                                  )
                                )
                        )
                 lock   (vl-remove-if (function (lambda (a) (= (vla-get-lock a) :vlax-false))) layus)
                 freeze (vl-remove-if (function (lambda (a) (= (vla-get-freeze a) :vlax-false))) layus)
           )
           (foreach a lock (vla-put-lock a :vlax-false))
           (foreach a freeze (vla-put-freeze a :vlax-false))
           (foreach a (reverse oldlst) (entmake (pl:dxf-mltclr a '(-2 -1 5 330) nil)))
           (foreach a atg
             (setq isatt (assoc 0 a))
             (if (= (cdr isatt) "TEXT")
               (setq a    (append a (list (cons 2 (setq ntag (pl:get-unic-str tlst))) '(70 . 8)))
                     tlst (cons ntag tlst)
               )
             )
             (entmake (subst '(0 . "ATTRIB") isatt a))
           )
           (if (entmake seqend)
             (foreach a (list blold) (entdel a))
           )
           (foreach a lock (vla-put-lock a :vlax-true))
           (foreach a freeze (vla-put-freeze a :vlax-true))
        )
      (vla-endundomark adoc)
    )
  )
)

(defun ru-ssentget-by-type (msg types bits / sel cmd_lst)
  (setq msg     (strcat "\n"
                        (if msg
                          (strcat msg " ")
                          "Selection "
                        )
                        (if (= (strcase (getvar "SYSCODEPAGE")) "ANSI_1251")
                          "<Выход>: "
                          "<Exit>: "
                        )
                )
        cmd_lst (if (= (logand bits 2) 0)
                  ":S"
                  ""
                )
        cmd_lst (if (= (logand bits 4) 0)
                  (strcat cmd_lst ":E")
                  cmd_lst
                )
        cmd_lst (if (= (logand bits 1) 0)
                  (strcat cmd_lst ":L")
                  cmd_lst
                )
        cmd_lst (if (/= cmd_lst "")
                  (list (strcat "_" cmd_lst))
                )
        types   (mapcar (function (lambda (x) (cons 0 x))) types)
  )
  (if (and types (> (length types) 1))
    (setq types (append (cons '(-4 . "<OR") types) '((-4 . "OR>"))))
  )
  (if types
    (setq cmd_lst (append cmd_lst (list types)))
  )
  (setvar "ERRNO" 0)
  (while (and (/= (getvar "ERRNO") 52) (not sel))
    (princ msg)
    (setvar "nomutt" 1)
    (vl-catch-all-error-p (setq sel (vl-catch-all-apply (function ssget) cmd_lst)))
    (setvar "nomutt" 0)
    (if (and (not sel) (= (logand bits 2) 2))
      (setq sel t)
    )
  )
  (cond ((not sel) nil)
        ((= (type sel) 'pickset)
         (if (= (logand bits 14) 0)
           (ssname sel 0)
           sel
         )
        )
        ((= (type sel) 'vl-catch-all-apply-error) (princ (vl-catch-all-error-message sel)) nil)
        (t nil)
  )
)

(defun pl:dxf-mltclr (_list _codes _t)
  (cond ((null _list) nil)
        ((/= _t (= (type (member (caar _list) _codes)) 'list))
         (pl:dxf-mltclr (cdr _list) _codes _t)
        )
        (t (cons (car _list) (pl:dxf-mltclr (cdr _list) _codes _t)))
  )
)

(defun pl:list-del-double (_lst / _tmp _i)
  (if _lst
    (progn (setq _i   (car _lst)
                 _tmp (pl:list-del-double (cdr _lst))
           )
           (if (vl-position _i _tmp)
             _tmp
             (cons _i _tmp)
           )
    )
  )
)

(defun pl:get-unic-str (_lst / _tmp _i)
  (setq _tmp "ID1"
        _i   1
  )
  (if _lst
    (while (vl-position _tmp _lst) (setq _tmp (strcat "ID" (itoa (setq _i (1+ _i))))))
  )
  _tmp
)

(defun pl:sel-to-list (ss / i ename result)
  (setq i -1)
  (while (setq ename (ssname ss (setq i (1+ i)))) (setq result (cons ename result)))
)

(defun c:addatt () (dwgru:add-att-to-ins) (princ))

(progn (princ "\nType - 'addatt' in the command string for beginning.") (vl-load-com))