[Supermax]

Хочу программно изменять макрос связи Mtext-a с объектами. В свойствах vla-объекта только результирующая текстовая строка. А где сам макрос лежит? типа такого:

Код:

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

%<\AcObjProp Object(%<\_ObjId 2122639056>%).EffectiveName>%

Наверное опять в словарях искать надо.
Kpblc, ты часом не встречал эту штуку?

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

Это обычный код поля. Часть "%<\AcObjProp Object(%<\_ObjId ", по-моему, постоянна (Добавлено: для случая получения свойств объекта). Следом идет ObjectID в строковом представлении, а потом собственно свойство.

Код:

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

; Получение ObjectID для поля
(_dwgru-conv-value-to-string (_dwgru-property-get (car (entsel "\nБлок : ")) 'objectid))

P.S. Пишу код "насухую", так что скобки проверить не помешает.

[Supermax]

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

Не понял :?

[Krieger]

Кулик Алексей aka kpblc
А где библиотеку функций _dwgru скачать в FAS?

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

У меня пока нет Пока (библиотеке 2 дня от роду) только самому руками собирать. Дайте времени немного - сделается все, никуда не денется.

[VVA]

В текстах есть есть метод FieldCode. Он и возвращает что-то "типа такого". Посмотри здесь LISP.Поля (Field). Удаление, Добавление, Изменение
Однако этого метода нет в атрибутах. В общем случае оприсание полей лежит в словаре "TEXT" словаря "ACAD_FIELD" в группе 360
Вот программа, выдергивающая все имена примитивов, находящихся в поле и подсвечивает их.

Код:

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

(defun C:FldViz ( / txt lst ss _get-en-from-field)
  ;;Возвращает список примитивов, входящих в поле (поля)
;_   txt      - имя примитива хранителя поля (текст или атрибут таблица) [ENAME],
;_              возвращаемое nentsel
(defun _get-en-from-field (txt / dict field field_data lst lst1)
  (and
    (setq dict (cdr (assoc 360 (entget txt)))) ;_Ename Dictionary Словарь примитива
    (setq dict
           (cdr (assoc 360 (member '(3 . "ACAD_FIELD") (entget dict))))
    ) ;_Enable Field Dictionary Есть поля в объекте
    (setq dict (cdr (assoc 360 (member '(3 . "TEXT") (entget dict))))) ;_ Field Record Запись поля
 ;_Sub Field Records Вторичные записи полей
    (setq field (mapcar 'cdr
                        (vl-remove-if
                          '(lambda (x) (/= (car x) 360))
                          (entget dict)
                        ) ;_ end of vl-remove-if
                ) ;_ end of mapcar
    ) ;_ end of setq
    (or (setq lst1 ;_прямые ссылки полей на примитивы
               (apply 'append
                      (mapcar '(lambda (field_data)
                                 (mapcar 'cdr
                                         (vl-remove-if
                                           '(lambda (x) (/= (car x) 331))
                                           (entget field_data)
                                         ) ;_ end of vl-remove-if
                                 ) ;_ end of mapcar
                               ) ;_ end of lambda
                              field
                      ) ;_ end of mapcar
               ) ;_ end of apply
        ) ;_ end of setq
        t
    ) ;_ end of or
    (if (setq ;_вложенные ссылки полей на примитивы (формулы в полях)
          lst (apply 'append
                     (mapcar '(lambda (field_data)
                                (mapcar 'cdr
                                        (vl-remove-if
                                          '(lambda (x) (/= (car x) 360))
                                          (entget field_data)
                                        ) ;_ end of vl-remove-if
                                ) ;_ end of mapcar
                              ) ;_ end of lambda
                             field
                     ) ;_ end of mapcar
              ) ;_ end of apply
        ) ;_ end of setq
      (setq
        lst (apply 'append
                   (mapcar '(lambda (field_data)
                              (mapcar 'cdr
                                      (vl-remove-if
                                        '(lambda (x) (/= (car x) 331))
                                        (entget field_data)
                                      ) ;_ end of vl-remove-if
                              ) ;_ end of mapcar
                            ) ;_ end of lambda
                           lst
                   ) ;_ end of mapcar
            ) ;_ end of apply
      ) ;_ end of setq
    ) ;_ end of if
  ) ;_ end of and
  (append lst lst1)
)
  (and
    (setq txt (car(nentsel "\nУкажите объект с полем")))
    (setq lst (_get-en-from-field txt))
    (setq ss (ssadd ))
    (mapcar '(lambda(x)(ssadd x ss)) lst)
    (sssetfirst ss ss)
    )
  (setq ss nil)
  (princ)
  )

Тебе надо повнимательнее посмотреть _get-en-from-field.
Учитывай, что в полях могут быть формулы.
* Добавлено *
Нюансы работы FldVizM в версиях Автокада 2010-2013

[VVA]

Вот еще для затравочки. Пример меняет точность в поле.
Создай в тексте поле со ссылкой на длинну отрезка с округлением до 2 знаков. С помощью этого примера можешь поменять точность округления на 3 знака

Код:

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

; function to update attribute text mtext field 
; Arguments:
; [attr] - ename [such as nentselp]
; [oldfldch] - string (field change such as %pr1, %lu1 and ect)
; [newfldch] - string (field change such as %pr2, %lu2 and ect) 
; return: t -updated, nil - not
(vl-load-com)
(defun upd_attr_field
       (attr oldfldch newfldch / dict field txt field_data New_field_data)
  (and attr
       (= (type attr) 'ENAME)
       (member (cdr (assoc 0 (entget attr))) '("ATTRIB" "TEXT" "MTEXT"))
       (setq dict (cdr (assoc 360 (entget attr)))) ;_Ename Dictionary
       (setq dict
       (cdr (assoc 360 (member '(3 . "ACAD_FIELD") (entget dict))))
       ) ;_Enable Field Dictionary
       (setq field (cdr (assoc 360 (member '(3 . "TEXT") (entget dict))))) ;_ Field Record
       (setq field (cdr (assoc 360 (entget field)))) ;_Sub Field Record
       (setq field_data (entget field))
       (setq txt (cdr (assoc 2 field_data)))
       (setq New_field_data (subst (cons 2
      (VL-STRING-SUBST newfldch oldfldch txt)
       )
       (assoc 2 field_data)
       field_data
       )
       )
       (setq txt (cdr (assoc 4 New_field_data)))
       (setq New_field_data (subst (cons 4
      (VL-STRING-SUBST newfldch oldfldch txt)
       )
       (assoc 4 New_field_data)
       New_field_data
       )
       )
       (entmod New_field_data)
       (vl-cmdf "_updatefield" attr "")
  )
)
;Test
(defun c:demo1 (/ oldpre newpre attr fc newstr)
  (vl-load-com)
  (and
    (setq oldpre (getint "\nOld precision integer <exit>: "))
    (setq newpre (getint "\nNew precision integer <exit>: "))
    (while
      (setq attr
      (car
        (nentsel "\nSelect attribute containing a field <exit>: "
        )
      )
      )
       (upd_attr_field
  attr
  (strcat "%pr" (itoa oldpre))
  (strcat "%pr" (itoa newpre))
       )
    )
  )
)

[VVA]

Вот еще набрел на прогу, добавляющую поле к объекту. Опубликована T.Willey здесь: EntMake'ing fields
Поучительна как с точки зрения непосредственного использования, так и с точки зрения "раздраконивания" кодов полей и их назначения

Код:

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

;;;;http://www.theswamp.org/index.php?topic=20446.0
;;;EntMake'ing fields
;;;T.Willey
;;; AddToEname - имя объекта для добавления поля ("MTEXT" "ATTRIB" "ATTDEF")
;;; LinkObj Указатель на объект (Vla-OBJECT) у которого берутся свойства
;;; PropName - string имя свойства
(defun VALUE (num ent /)(cdr (assoc num ent)))
(defun AddObjectField (AddToEname LinkObj PropName / EntData ExDict FDict PropType PropValue)
 
 (if
  (and
   (setq EntData (entget AddToEname))
   (vl-position (value 0 EntData) '("MTEXT" "ATTRIB" "ATTDEF"))
   (setq ExDict
    (vlax-vla-object->ename
     (vla-GetExtensionDictionary
      (vlax-ename->vla-object AddToEname)
     )
    )
   )
   (setq PropType
    (type
     (setq PropValue
      (vlax-get LinkObj PropName)
     )
    )
   )
  )
  (progn
   (dictremove ExDict "ACAD_FIELD")
   (setq FDict
    (dictadd ExDict "ACAD_FIELD"
     (entmakex
      '(
       (0 . "DICTIONARY")
       (100 . "AcDbDictionary")
       (280 . 1)
       (281 . 1)
      )
     )
    )
   )
   (dictadd FDict "TEXT"
    (entmakex
     (list
      '(0 . "FIELD")
      '(100 . "AcDbField")
      '(1 . "_text")
      '(2 . "%<\\_FldIdx 0>%")
      '(90 . 1) ;Number of child fields
      (cons 360 ;Child field ID
       (entmakex
        (list
         '(0 . "FIELD")
         '(100 . "AcDbField")
         '(1 . "AcObjProp") ; Field type
         (cons
          2
          (strcat
           "\\AcObjProp Object(%<\\_ObjIdx 0>%)."
           PropName
          )
         )
         '(90 . 0) ; Number of child fields
         '(97 . 1) ; Number of object ids
         (cons 331 (vlax-vla-object->ename LinkObj)) ; Object id
         '(4 . "") ; format string
         '(91 . 63) ; evaluation option
         '(92 . 0) ; filling option
         ;'(94 . 59) ; field state flag
         ;'(95 . 2) ; evaluation status
         ;'(96 . 0) ; evaluation error code
         ;'(300 . "") ; evaluation error message
         '(6 . "ObjectPropertyId")
         '(90 . 64)
         (cons 330 (vlax-vla-object->ename LinkObj))
         '(6 . "ObjectPropertyName") ; key string for the field data
         '(90 . 4) ; data type of field
         (cons 1 PropName) ; name of property
         '(7 . "ACAD_FIELD_VALUE") ; key string for the evaluated cache
         (cons
          90 ;data type of field
          (cond
           ((equal PropType 'STR)
            4
           )
           ((equal PropType 'INT)
            1
           )
           ((equal PropType 'REAL)
            2
           )
           ((equal PropType 'LIST)
            32
           )
          )
         )
         (cond ; field value
          ((equal PropType 'STR)
           (cons 1 PropValue)
          )
          ((equal PropType 'INT)
           (cons 91 PropValue)
          )
          ((equal PropType 'REAL)
           (cons 140 PropValue)
          )
          ((equal PropType 'LIST)
           (cons 11 Propvalue)
          )
         )
         '(301 . "") ; format string
         '(98 . 0) ; length of format string
        )
       )
      )
      '(97 . 0) ; Number of object IDs used in the field code
      '(4 . "") ; Format string
      '(91 . 63) ; Evaluation option
       ;kDisable 0 Disable evaluation. 
       ;kOnOpen (0x1 << 0) Evaluate during drawing load. 
       ;kOnSave (0x1 << 1) Evaluate during drawing save. 
       ;kOnPlot (0x1 << 2) Evaluate during drawing plot. 
       ;kOnEtransmit (0x1 << 3) Evaluate during eTransmit. 
       ;kOnRegen (0x1 << 4) Evaluate during regen. 
       ;kOnDemand (0x1 << 5) Evaluate only on demand by the user or the API. 
       ;kAutomatic (kOnOpen | kOnSave | kOnPlot | kOnEtransmit | kOnRegen | kOnDemand) Automatically evaluate fields during all the operations. 
      '(92 . 0) ;Filling option
       ;kSkipFilingResult (0x1 << 0) Do not file out the cached evaluation result with the field. 
      ;'(94 . 5) ;Field state flag
       ;kInitialized (0x1 << 0) Field is not yet intitalized with any field code or data. 
       ;kCompiled (0x1 << 1) Field has been compiled. 
       ;kModified (0x1 << 2) Field has been modified and not yet evaluated. 
       ;kEvaluated (0x1 << 3) Field has been evaluated. Use evaluationStatus() to get the evaluation status. 
       ;kHasCache (0x1 << 4) The field has a cache of the evaluated result. 
      ;'(95 . 1) ;Evaluation status
       ;kNotYetEvaluated (0x1 << 0) Field is not yet evaluated. 
       ;kSuccess (0x1 << 1) Field is evaluated successfully. 
       ;kEvaluatorNotFound (0x1 << 2) Evaluator was not found. 
       ;kSyntaxError (0x1 << 3) Syntax error in the field expression. 
       ;kInvalidCode (0x1 << 4) Invalid field code or expression. 
       ;kInvalidContext (0x1 << 5) Current context is invalid for evaluating the field. 
       ;kOtherError (0x1 << 6) Evaluation has failed. 
      ;'(96 . 0) ;Evaluation error code
      ;'(300 . "") ;Evaluation error message
      '(93 . 1) ;Number of the data set in the field
      '(6 . "ACFD_FIELDTEXT_CHECKSUM") ;Key string for field data
      '(90 . 2) ;Data type of field value
      '(140 . 33.0) ;Double value
      '(7 . "ACFD_FIELD_VALUE") ;Key string from the evaluated cache, hard coded as is shown here
      '(90 . 0) ;Data type of field value
      '(91 . 0) ;Long value
      '(301 . "") ; format string
      '(98 . 0) ; format string length
     )
    )
   )
   (entupd AddToEname)
  )
 )
)

[VVA]

Еще парочку функций и промеров к ним
DEMO1 - сносит все поля в тексте
DEMO2 - сносит поля AcVar (ссылающиеся на переменные)
DEMO3 втавляет поле с текущей датой в текст
Для проверки:
Рисуем текст и отрезок. Вставляем в текст поле со ссылкой на длинну отрезка. С помощью Demo3 добавляем дату. Дальше Demo1 или DEmo2

Код:

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

;_Удаляет все поля из объекта
;;; obj — VLA-объект
;_Возвращает текстовую строку с удаленным описание поля или строку если поля нет или "" если поля нет
;_обновлять в объекте (vlax-put obj 'TextString newstr)
(defun removeAllFieldFromObject ( obj  / fc fb fe fb1 tmp )
  (and
    (vlax-method-applicable-p obj 'FieldCode) ;_есть метод FieldCode
    (setq fc (vlax-invoke obj 'FieldCode))
    (while (and
             (setq fb (vl-string-search "%<\\Ac" fc))
             (if (null (setq fb1 (vl-string-search "%<\\Ac" fc (1+ fb))))
               (setq fb1 (strlen fc)) T)
             (setq fe fb)
             (while (and
                      (setq tmp (vl-string-search ">%" fc (1+ fe)))
                      (< tmp fb1)
                      )
               (setq fe tmp)
               )
             (if (= fb 1)
               (setq fc (substr fc (+ 4 fe)))
               (setq fc (strcat (substr fc 1 fb)(substr fc (+ 4 fe))))
               )
             )
      )
    )
  (if fc fc "")
  )
;_Удаляет поле  из объекта по указанной маске
;;; obj — VLA-объект
;;FieldPattern — маска поля (начало описания поля, см. в редакторе)
;; !! Обращайте внимание, что одиночная \ заменяется двойной \\
;;Например поле свойств — %<\\AcObjProp
;переменные —  %<\\AcVar и т.д.
;_Возвращает текстовую строку с удаленным описанием
;_обновлять в объекте (vlax-put obj 'TextString newstr)
(defun removeSpecifyFieldFromObject ( obj FieldPattern  / fc fb fe fb1 tmp )
  (and
    (vlax-method-applicable-p obj 'FieldCode) ;_есть метод FieldCode
    (setq fc (vlax-invoke obj 'FieldCode))
    (while (and
             (setq fb (vl-string-search FieldPattern fc))
             (if (null (setq fb1 (vl-string-search FieldPattern fc (1+ fb))))
               (setq fb1 (strlen fc)) T)
             (setq fe fb)
             (while (and
                      (setq tmp (vl-string-search ">%" fc (1+ fe)))
                      (< tmp fb1)
                      )
               (setq fe tmp)
               )
             (if (= fb 1)
               (setq fc (substr fc (+ 4 fe)))
               (setq fc (strcat (substr fc 1 fb)(substr fc (+ 4 fe))))
               )
             )
      )
    )
  (if fc fc "")
  )
 
 
;;Ф-ция добавляет к объекту поле
;; obj — VLA-объект
;; FieldStr — сформированная строка поля (такая же, какая отражается в окне редактора
;;Типа "%<\\AcObjProp Object(%<\\_ObjId 2123408528>%).Length \\f \"%lu2%pr2\">%"
;;Никаких проверок на корректность строки и присутствия оной в строке FieldStr не производится
;; !! Обращайте внимание, что одиночная \ заменяется двойной \\
;;Возвращает T — поле добавлено nil — нет
(defun addFieldToObj (obj FieldStr / fc)
  (and
    (vlax-write-enabled-p obj)
    (vlax-method-applicable-p obj 'FieldCode) ;_есть метод FieldCode
    (vlax-property-available-p obj 'TextString)
    (setq fc (vlax-invoke obj 'FieldCode))
    (setq fc (strcat fc " " FieldStr))
    (vlax-put obj 'TextString fc)
    )
  )
;;====== Примеры испольвания ф-ций и просто полезные команды
;_Пример использования ф-ции removeAllFieldFromObject
;_удалить все поля из текста
(defun C:DEMO1 ( )
  (if (and (setq obj (car(entsel "\nУкажи текст для удаления полей: ")))
           (wcmatch (cdr(assoc 0 (entget obj))) "*TEXT")
           (setq obj (vlax-ename->vla-object obj))
           (vlax-write-enabled-p obj)
           )
    (vla-put-TextString obj (removeAllFieldFromObject obj))
    )
  (princ)
  )
;_Пример использования ф-ции removeSpecifyFieldFromObject
;_удалить определенное поле из текста
(defun C:DEMO2 ( )
  (if (and (setq obj (car(entsel "\nУкажи текст для удаления полей %<\\AcVar: ")))
           (wcmatch (cdr(assoc 0 (entget obj))) "*TEXT")
           (setq obj (vlax-ename->vla-object obj))
           (vlax-write-enabled-p obj)
           )
    (vla-put-TextString obj (removeSpecifyFieldFromObject obj "%<\\AcVar"))
    )
  (princ)
  )
 
;;Пример использования ф-ции addFieldToObj
;добавление поля даты
;;Проверка, естьли уже в поле дата не производиться
(defun C:DEMO3 ( )
  (if (and (setq obj (car(entsel "\nУкажи текст для втавки даты: ")))
           (wcmatch (cdr(assoc 0 (entget obj))) "*TEXT")
           (setq obj (vlax-ename->vla-object obj))
           (vlax-write-enabled-p obj)
           )
    (addFieldToObj obj "%<\\AcVar Date \\f \"yyyy-MM-dd\">%")
    )
  (princ)
  )

[VVA]

Отсюда вариант FldViz с выбором нескольких объектов с полем

Код:

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

(defun C:FldVizM ( / txt lst ss _get-en-from-field txtlist Flag)
  ;;Возвращает список примитивов, входящих в поле (поля)
;_   txt      - имя примитива хранителя поля (текст или атрибут таблица) [ENAME],
;_              возвращаемое nentsel
(defun _get-en-from-field (txt / dict field field_data lst lst1)
  (and
    (setq dict (cdr (assoc 360 (entget txt)))) ;_Ename Dictionary Словарь примитива
    (setq dict
           (cdr (assoc 360 (member '(3 . "ACAD_FIELD") (entget dict))))
    ) ;_Enable Field Dictionary Есть поля в объекте
    (setq dict (cdr (assoc 360 (member '(3 . "TEXT") (entget dict))))) ;_ Field Record Запись поля
;_Sub Field Records Вторичные записи полей
    (setq field (mapcar 'cdr
                        (vl-remove-if
                          '(lambda (x) (/= (car x) 360))
                          (entget dict)
                        ) ;_ end of vl-remove-if
                ) ;_ end of mapcar
    ) ;_ end of setq
    (or (setq lst1 ;_прямые ссылки полей на примитивы
               (apply 'append
                      (mapcar '(lambda (field_data)
                                 (mapcar 'cdr
                                         (vl-remove-if
                                           '(lambda (x) (/= (car x) 331))
                                           (entget field_data)
                                         ) ;_ end of vl-remove-if
                                 ) ;_ end of mapcar
                               ) ;_ end of lambda
                              field
                      ) ;_ end of mapcar
               ) ;_ end of apply
        ) ;_ end of setq
        t
    ) ;_ end of or
    (if (setq ;_вложенные ссылки полей на примитивы (формулы в полях)
          lst (apply 'append
                     (mapcar '(lambda (field_data)
                                (mapcar 'cdr
                                        (vl-remove-if
                                          '(lambda (x) (/= (car x) 360))
                                          (entget field_data)
                                        ) ;_ end of vl-remove-if
                                ) ;_ end of mapcar
                              ) ;_ end of lambda
                             field
                     ) ;_ end of mapcar
              ) ;_ end of apply
        ) ;_ end of setq
      (setq
        lst (apply 'append
                   (mapcar '(lambda (field_data)
                              (mapcar 'cdr
                                      (vl-remove-if
                                        '(lambda (x) (/= (car x) 331))
                                        (entget field_data)
                                      ) ;_ end of vl-remove-if
                              ) ;_ end of mapcar
                            ) ;_ end of lambda
                           lst
                   ) ;_ end of mapcar
            ) ;_ end of apply
      ) ;_ end of setq
    ) ;_ end of if
  ) ;_ end of and
  (append lst lst1)
)
(setvar "ERRNO" 0)
(setq Flag t)
(while Flag
  (setq txt (car(nentsel "\nУкажите объект с полем <готово>: ")))
  (if txt (setq txtlist (cons txt txtlist))
    (if (= (getvar "ERRNO") 52)(setq Flag nil)
      (princ "\nПромахнулись... Попробуйте еще раз"))
    )
  (setvar "ERRNO" 0)
  )
  (and txtlist
    (setq lst (mapcar '_get-en-from-field txtlist))
    (setq lst (apply 'append lst))
    (setq lst (vl-remove-if 'null lst))
    (setq ss nil ss (ssadd))
    (mapcar '(lambda(x)(ssadd x ss)) lst)
    (sssetfirst ss ss)
    )
  (setq ss nil)
  (princ)
  )