LISP. Как добраться до формулы поля атрибута дин. блока и изменить её?

kacugu · 21.06.2016, 09:38

День добрый.
Есть динамический блок высотной отметки (см. приложение) с точностью до 3 знаков после запятой. Есть чертёж, в который этот блок вставлен несколько сотен раз (чертёж приложить не могу).
В этом чертеже нужно теперь изменить точность отображения отметки на 2 знака после запятой. Простое переопределение блока тут не помогает.
Подозреваю, что формуле для поля %<\AcExpr (%<\_FldPtr 1195574368>%/1000) \f "%lu2%pr3%ds44">% нужно заменить pr3 на pr2.
Собственно вопрос: как средствами autolisp изменить эту формулу для поля? Или есть какие-то другие варианты?
Заранее спасибо за помощь.

trir · 21.06.2016, 09:53

http://www.cad.dp.ua/sovets/lisp-fun...set.php#func12

dip · 21.06.2016, 10:31

trir, ссылка не работает

kacugu · 21.06.2016, 10:37

У меня работает, но до меня пока не доходит как ей воспользоваться.
Скопировал код по ссылке trir,

Код:

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

 Находит значение указанного блока и атрибута

;;; (ax:GetTagTextString doc "sheet-text" "client-drw")
(defun ax:GetTagTextString (doc bn tagname / layout i atts tag str)
  (vlax-for layout (vla-get-layouts doc)
    (vlax-for i (vla-get-block layout)
      (if (and
            (= (vla-get-objectname i) "AcDbBlockReference")
            (= (strcase (vla-get-name i)) (strcase bn))
          )
        (if (and
              (= (vla-get-hasattributes i) :vlax-true)
              (safearray-value
                (setq atts
                       (vlax-variant-value
                         (vla-getattributes i)
                       )
                )
              )
            )    
          (foreach tag (vlax-safearray->list atts)
            (if (= (strcase tagname) (strcase (vla-get-tagstring tag)))
              (setq str (vla-get-TextString tag))
            )
          )
        )
      )
    )
  )
  str
)

P_S · 21.06.2016, 10:52

Я бы, не мудрствуя, сделал через Express Tools Export Attributes, затем, исправив текстовый файл, Import Attributes

trir · 21.06.2016, 10:52

Код:

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

 ;;; Изменяет атрибуты на всех ссылках блоков, соответствующих 
;;; (ChangeAttributes (list  '( . ) ...))
;;; (ChangeAttributes (list "testblock" '("TESTTAG2" . "item1") '("NEWTAG" . "tagvalue")))
(defun ChangeAttributes (lst / sset item atts ename i)
  (setq i 0)
  (setq sset (ssget "X" (list '(0 . "INSERT") (cons 2 (car lst)))))
  (if sset
    (repeat (sslength sset)
      (setq ename (ssname sset i))
      (setq i (+ 1 i))
      (if (safearray-value
            (setq atts
                   (vlax-variant-value
                     (vla-getattributes (vlax-ename->vla-object ename))
                   )
            )
          )
        (progn
          (foreach item (cdr lst)
            (mapcar
              '(lambda (x)
                 (if
                   (= (strcase (car item))
                      (strcase (vla-get-tagstring x))
                   )
                    (vla-put-textstring x (cdr item))
                 )
               )
              (vlax-safearray->list atts)
            )
          )
          (vla-update (vlax-ename->vla-object ename))
        )
      )
    )
  )
)

kacugu · 21.06.2016, 11:01

Если я правильно понимаю приведённый код, то отметки-то изменяется. А вот поле пропадёт и в дальнейшем придётся уже вручную перебивать отметки у этих блоков. Но мне всё-таки этом хотелось бы сохранить поле внутри блока.

trir · 21.06.2016, 11:11

http://adndevblog.typepad.com/autoca...tity-data.html
http://through-the-interface.typepad...ing-the-a.html

----- добавлено через ~2 мин. -----
http://adndevblog.typepad.com/autoca...tity-data.html
http://through-the-interface.typepad...ing-the-a.html
http://www.vbaexpress.com/forum/show...lock-attribute

Код:

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

 ;; helper functions 
;;;(C)2005 Jason Piercey 
; Function To determine If a field 
; has been applied To an object. 
; Arguments: 
; [object] - vla-object 
; return: vla-object, IAcadObject Or nil 
; Notes: 
; First stab at doing anything With fields 
; unsure If this Function will cover all 
; instances that are possible. 
(defun field-p (object / result) 
(if 
(and 
(= :vlax-true (vla-get-hasextensiondictionary Object)) 
(setq 
result 
(vl-catch-all-apply 
(function 
(lambda () 
(vla-item 
(vla-getextensiondictionary Object) 
"Acad_field"))))) 
(not (vl-catch-all-error-p result)) ) 
 
(vla-item result 0) 
) 
) 
; based on Function above 
; Function To get handle 
; Arguments: 
; [handle of parent object] - String 
; return: handle of Object, linked by field , String Or empty String 
(defun getholder(handle / atobj doc elist field fieldobj flddict holder) 
(setq doc 
(vla-get-activedocument(vlax-get-acad-object))) 
(setq atobj (vlax-ename->vla-object (handent handle))) 
(setq flddict(vl-catch-all-apply 
(function 
(lambda () 
(vla-item 
(vla-getextensiondictionary atobj) 
"ACAD_FIELD"))))) 
(setq fieldobj (vl-catch-all-apply 
(function 
(lambda () 
(vla-item 
flddict 
"TEXT"))))) 
(setq field (vlax-vla-object->ename fieldobj)) 
(setq elist (entget field)) 
(setq holder (cdr (assoc 5 (entget (cdr (assoc 331(entget (cdr (assoc 360 elist))))))))) 
holder 
)

kacugu · 21.06.2016, 11:17

Спасибо. Буду разбираться

VVA · 21.06.2016, 12:50

kacugu, Здесь есть функция bg:FieldCode
Пример использования

Код:

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

(defun C:TEST ()
  (setq en (car(nentsel "\nВыберите атрибут ")))
  (princ "\nСтрока поля: ")
  (princ(bg:FieldCode en))(princ)
  )
(defun bg:FieldCode (ent / foo elst xdict dict field str)
  ;; credits gile gc:FieldCode
  (defun ObjIdxStr (fld / pos)
  (setq pos (vl-string-search "ObjIdx " (cdr (assoc 2 fldId)) 0))
  (substr fld (1+ pos) (- (vl-string-search ">%" fld pos) pos))
  )
  (defun foo (field str / pos fldID objID)
    (setq pos 0)
    (if (setq pos (vl-string-search "\\_FldIdx " str pos))
      (while (setq pos (vl-string-search "\\_FldIdx " str pos))
        (setq fldId (entget (cdr (assoc 360 field)))
              field (vl-remove (assoc 360 field) field))
        (setq
              str   (strcat
                      (substr str 1 pos)
                      (if (setq objID (cdr (assoc 331 fldId)))
                        (vl-string-subst
                          ;;; (strcat "ObjId " (itoa (gc:EnameToObjectId objID))) ;;; VVA 2015-12-07
                          (strcat "ObjId " (bg:GetObjectIDString objID))
                          ;;; "ObjIdx" ;;; rem VVA 2015-12-07
                          (ObjIdxStr (cdr (assoc 2 fldId))) ;;; add VVA 2015-12-07
                          (cdr (assoc 2 fldId))
                        )
                        (foo fldId (cdr (assoc 2 fldId)))
                      )
                      (substr str (1+ (vl-string-search ">%" str pos)))
                    )
        )
      )
      str
    )
  )
  
  (setq elst (entget ent))
  (if (vlax-property-available-p (vlax-ename->vla-object ent) 'Textstring)
    (cond ((= (cdr(assoc 0 elst)) "MULTILEADER")
           (setq str (cdr(assoc 304 elst)))
           )
          ((and ;;; MTEXT ATTRIB ADD VVA 2011-20-27
             (member (cdr(assoc 0 elst)) '("ATTRIB"))
             (member '(101 . "Embedded Object") elst)
             )
           (setq str (apply 'strcat (append (bg:massoc 3 elst)(bg:massoc 1 (member '(101 . "Embedded Object") elst)))))
           )
          
          ((member (cdr(assoc 0 elst)) '("TEXT" "MTEXT" "ATTRIB"))
           (setq str (apply 'strcat (append (bg:massoc 3 elst)(bg:massoc 1 elst))))
           )
          (t (setq str (vla-get-TextString (vlax-ename->vla-object ent))))
    )
    )
  (if (and
	(member (cdr (assoc 0 elst)) '("ATTRIB" "MTEXT" "TEXT" "MULTILEADER"))
	(setq xdict (cdr (assoc 360 elst)))
	(setq dict (dictsearch xdict "ACAD_FIELD"))
	(setq field (dictsearch (cdr (assoc -1 dict)) "TEXT"))
      )
    (setq str (foo field (cdr (assoc 2 field))))
  )
    str
)
(defun bg:GetObjectIDString ( obj / *util* )
  (if (eq (type obj) 'ENAME)
    (setq obj (vlax-ename->vla-object obj))
    )
  (setq *util* (vla-get-Utility (vla-get-ActiveDocument (vlax-get-acad-object))))
  (if  (vlax-method-applicable-p *util* 'GetObjectIdString)
    (vla-GetObjectIdString *util* obj :vlax-false)
    (itoa (vla-get-ObjectId obj))
  )
 )
(defun bg:massoc (key alist)(mapcar 'cdr (vl-remove-if-not (function (lambda (x) (= key (car x)))) alist)))

----- добавлено через ~4 мин. -----
==== Добавлено ====
Посмотри еще команду DEMO4 отсюда (LISP.Поля (Field). Удаление, Добавление, Изменение)

kacugu · 21.06.2016, 13:07

trir, VVA - спасибо за ссылки - поизучаю ещё)
Пока что решил так (без каких-либо проверок и т.пр.):

Код:

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

 
(defun c:kaa-change-field ( / ent enx lst otm txt_field_new)
  
(vl-load-com)
(while
	(progn
		(setvar 'errno 0)
		(setq ent (car (entsel "\nВыберите блок <Выход>: ")))
		(cond
			(   (= 7 (getvar 'errno))
                       (princ "\nМимо, попробуйте снова.")
            )
			(   (null ent)
                       nil
            )
			(   (/= "INSERT" (cdr (assoc 0 (setq enx (entget ent)))))
                       (princ "\nОбъект не является блоком.")
            )
			(   (/= 1 (cdr (assoc 66 enx)))
                       (princ "\nБлок не содержит атрибутов.")
            )
			(	( not
					(and
						(setq lst (vlax-invoke (vlax-ename->vla-object ent) 'getattributes)
							lst (mapcar '(lambda ( x ) (cons (strcase (vla-get-tagstring x)) x)) lst)
						)
						(setq otm (cdr (assoc "ОТМЕТКА1" lst)))
					)
				)
				(princ "\nБлок не содержит атрибут \"ОТМЕТКА1\".")
			)
			(	(setq txt_field_new
						(strcat
							"%<\\AcExpr (%<\\AcObjProp Object(%<\\_ObjId "
							(LM:ObjectID (vlax-ename->vla-object ent))
							">%).InsertionPoint \\f \"%lu2%pt2%pr2\">%"
							"/1000) \\f \"%lu2%pr2%ds44\">%"
						);;end of strcat
				)

				(vla-put-textstring otm txt_field_new)
				(vla-regen (LM:acdoc) acactiveviewport)
			)
		);;end of cond
	);;end of progn
);;end of while
(princ)
);; end of defun


;;-----------------------------------------------------------------------------------------------
;; ObjectID  -  Lee Mac
;; Returns a string containing the ObjectID of a supplied VLA-Object
;; Compatible with 32-bit & 64-bit systems
 
(defun LM:ObjectID ( obj )
   (eval
	   (list 'defun 'LM:ObjectID '( obj )
		   (if
			   (and
				   (vl-string-search "64" (getenv "PROCESSOR_ARCHITECTURE"))
				   (vlax-method-applicable-p (vla-get-utility (LM:acdoc)) 'getobjectidstring)
			   )
			   (list 'vla-getobjectidstring (vla-get-utility (LM:acdoc)) 'obj ':vlax-false)
			  '(itoa (vla-get-objectid obj))
		   )
	   )
   )
   (LM:ObjectID obj)
)

;;-----------------------------------------------------------------------------------------------
;; Active Document  -  Lee Mac
;; Returns the VLA Active Document Object

(defun LM:acdoc nil
(eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
(LM:acdoc)
)
)

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Изменить точку вставки блока	Apelsinov	AutoCAD	43	04.02.2022 18:34
Запрет на редактирование значения атрибута в составе вхождения блока	hwd	AutoCAD	10	26.01.2016 12:02
Как в автокаде13 редактировать текст атрибута динамического блока - изменить однострочный текст на многострочный	Верра	Динамические блоки	8	18.07.2014 11:25
Присвоение атрибуту блока значения атрибута другого блока.	shartal	Программирование	4	14.11.2013 14:02
Lisp. Как добраться до подсказки атрибута блока	молодой человек	LISP	8	25.11.2010 09:20

Опции темы	Поиск в этой теме
	Поиск в этой теме: Расширенный поиск