[baaba]

Подскажите пожалуйста простенькую функцию для изменения значения вхождения атрибута блока! нужно что то вроде (att_change ent val) то есть передаю функции выбранный блок и значение атрибута, которое мне требуется. Пробовал написать сам через entmod, но когда увидел dxf коды блока с атрибутом, зашёл в тупик.

PS хорошо было бы создать ветку "подскажите функцию"

[Дима_]

Сообщение от baaba Пробовал написать сам через entmod, но когда увидел dxf коды блока с атрибутом, зашёл в тупик.

Аттрибуты идут "вслед" за блоком (entnext вхождение_блока). Ну или vla.

[Alan]

Сообщение от baaba Подскажите пожалуйста простенькую функцию для изменения значения вхождения атрибута блока! нужно что то вроде (att_change ent val) то есть передаю функции выбранный блок и значение атрибута, которое мне требуется.

На этом форуме многое было уже сделано, много лет назад. Ищите и найдёте!
Пост 8 мой вариант, который использую во многих случаях (работает без VL- VLA- ...)
http://forum.dwg.ru/showthread.php?t...ight=att_value
и куча других вариантов

[baaba]

Сообщение от Alan Пост 8 мой вариант, который использую во многих случаях (работает без VL- VLA- ...)

Укажи пожалуйста, где конкретно запрятана функция в посте № 8. Я что то пока не разобрался -\

[Олег (jr.)]

Возьми за основу:

(defun C:CHATR (/ att_tag blkent blockName ent newvalue	next next_data
		tagName)

  (setq blockName (getstring T "\n >> Имя блока (в регистре!) :  "))

  (setq tagName (strcase (getstring "\n >> Тэг атрибута  :  ")))

  (setq newvalue (getstring T "\n >> Новое значение атрибута  :  "))

  (while

    (setq blkent
	   (entsel
	     "\n >> Выбрать блок (или жми \"Enter\" для завершения): >> \n"
	   )
    )

     (setq ent (car blkent))

     (setq next ent)

     (while (setq next (entnext next))

       (setq next_data (entget next))

       (setq att_tag (cdr (assoc 2 next_data)))

       (if (eq tagName att_tag)

	 (progn

	   (entmod
	     (subst (cons 1 newvalue) (assoc 1 next_data) next_data)
	   )

	   (entupd ent)

	 )
       )
     )
  )

  (princ)
)


(prompt "\n====================================\n")
(prompt "\n\t>>>\tСтарт команда CHATR ... \t>>>\n")
(prompt "\n====================================\n")
(prin1)

~'o'~

[VVA]

Здесь поищи функцию mip-block-setattr-bylist
PS
Собрал все в кучу

Код:

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

;; obj - Ename or Vla object of block
;; att_list - list ((Tag_Name1 . Value1)(Tag_Name2 . Value2) ...)
;;                 Tag_Name - string
;;                    Value - string
;;;Пример:
;;;Изменяем значение атрибута с тагом "Nomer" на 5
;;; (mip-block-setattr-bylist (car(entsel "\nSelect block: ")) (list(cons "NOMER" "5")))
(defun mip-block-setattr-bylist (obj att_list / txt lst)
(defun mip-conv-to-str (dat)
  (cond ((= (type dat) 'INT)(setq dat (itoa dat)))
         ((= (type dat) 'REAL)(setq dat (rtos dat 2 12)))
        ((null dat)(setq dat ""))
        (t (setq dat (vl-princ-to-string dat)))))
(if (= (type obj) 'ENAME)(setq obj (vlax-ename->vla-object obj)))
(setq att_list (mapcar '(lambda(x)(cons(strcase(vl-princ-to-string(car x)))(vl-princ-to-string(cdr x)))) att_list))
  (if (and obj
           (not(vlax-erased-p obj))
           (= (vla-get-ObjectName obj) "AcDbBlockReference")
	   (eq :vlax-true (vla-get-HasAttributes obj))
	   (vlax-property-available-p obj 'Hasattributes)
	   (vlax-write-enabled-p obj)
      )
    (vl-catch-all-apply
      (function
	(lambda	()
          (foreach at (vlax-invoke obj 'Getattributes)
            (if (setq lst (assoc(strcase(vla-get-TagString at)) att_list))
              (vla-put-TextString at (cdr lst))
            )
            )
          )
        )
      )
    )
  )

[Alan]

Сообщение от baaba Укажи пожалуйста, где конкретно запрятана функция в посте № 8. Я что то пока не разобрался -\

Ну чтобы не выдирал из текста даю конкретную функцию

Код:

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

;;; ===================      ЗАМЕНА ЗНАЧЕНИЙ АТРИБУТОВ ========================================
(defun nz_att_ch10
       (el_sp sp_atr / att seqend a_name new_value att0 att)
;;;    el_sp - элемент - блок с атрибутами
;;;     new_value - новое значение
  (setq att (entnext el_sp))
  (setq seqend (cdr (assoc 0 (entget att))))
  (while (not (eq seqend "SEQEND"))  ; пока есть атрибуты в блоке
    (setq a_name (cdr (assoc 2 (entget att)))) ; находим  атрибут 
;;; начинаем проверять по списку для изменений: есть - меняем
    (setq new_value (car (cdr (assoc a_name sp_atr))))
    (if    new_value
      (setq att0 (subst    (cons 1 new_value)
            (assoc 1 (entget att))
            (entget att)
         ) ;_ конец subst
      ) ;_ конец setq
    ) ;_ конец if
    (entmod att0)
    (entupd att)
    (setq att (entnext att))
    (setq seqend (cdr (assoc 0 (entget att))))
  ) ;_ конец while
) ;_ конец defun

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

Код:

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

;;; список атрибутов со значениями на присвоение
(setq sp_atr '(("NAME_ATRIB1" "ИВАНОВ")  ("NAME_ATRIB2" "ПЕТРОВ") ("NAME_ATRIB3" "СИДОРОВ")))
;;; вставляем блок
      (setvar "attreq" 0)
      (command  "_-INSERT"
           mrkb      ; имя блока
           point1    ; точка вставки
           1
           1
           0
      ) ;_ конец COMMAND
      (setq rr3 (entlast))    ;запомним
;;;      корректирование атрибутов из списка sp_atr
      (nz_att_ch10 rr3 sp_atr)

>baaba Действия понятны?

[baaba]

Сообщение от VVA Здесь поищи функцию mip-block-setattr-bylist

пасибо огромное!! это то что надо!

Сообщение от Олег (jr.) Возьми за основу:

Это то же подходит. Спасибо!

Сообщение от Alan >baaba Действия понятны?

Ваш вариант не заработал. Разбираться не стал т. к. первые два работают -) но спасибо!

[baaba]

Теперь ищу функцию для извлечения значения атрибута блока. Что то аналогично тому как мы делаем (assoc N (entget (car (entsel)))) Естественно если нужно значение атрибута блока, эта конструкция работать не будет.
Подскажите пожалуйста!
Смотрел вот тут:
http://www.helloworld.ru/texts/comp/...utolisp.htm#22
Но пока не заработало (не нашёл функцию getval) и я не уверен что это вообще то что надо.

Код:

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

 
(defun istypep (ele typ) (= (gettyp ele) typ))
(defun gettyp (ele) (getval 0 ele))
(defun getval (n e) (cdr (assoc n e))) 
(defun ATTELE (ele attname / rslt)
	(if (and (istypep ele "INSERT") (= (getval 66 ele) 1))
		(progn
			(setq ele (entnext (entity ele)))
			(while (and ele (istypep ele "ATTRIB"))
				(if (= (strcase (getval 2 ele)) (strcase attname))
					(setq rslt (entget ele) ele nil)
					(setq ele (entnext ele))
				)
			) 
		)
	)
	rslt
)

PS мне не понятно как происходит связывание вхождения блока и конкретного атрибута? Пробовал смотреть это на примере DXF файла: там отдельно описан блок и отдельно даётся значение атрибута, но как они связываются?

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

vla-get-textstring

[baaba]

Пока не очень разобрался как применять. Смотрю пример вот тут:
http://www.lee-mac.com/attributefunc...attributevalue

Делаю так:
(LM:VL-GETATTRIBUTEVALUE (car (entsel)) "lev")

Получаю:
Select object: ; error: bad argument type: VLA-OBJECT <Entity name: 7ffffb0cd80>

[VVA]

baaba, Так там есть еще описание

; Get Attribute Value - Lee Mac ;; Returns the value held by the specified tag within the supplied block, if present. ;; blk - [vla] VLA Block Reference Object ;; tag - [str] Attribute TagString ;; Returns: [str] Attribute value, else nil if tag is not found.

Код:

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

(LM:VL-GETATTRIBUTEVALUE (vlax-ename->vla-object(car (entsel))) "lev")

[baaba]

Спасибо огромное!!
Мне понравился вариант "Vanilla LISP" (по странице ниже). В этом случае достаточно дать ему (car (entsel)).