Тема: LISP.Поля (Field). Удаление, Добавление, Изменение
Мои соображения по поводу вставки, изменения и добавления полей в уже существующем тексте.
Для начала полезные ссылки:
Поля в таблице
LISP. Вставка в таблицу поля, соотвествующего площади примитива
Можно ли программно вставить поле?
Цитата из последный ссылки Александр Ривилис (2005-08-16 20:59:07)
Но тут не все так просто, как хотелось бы. При создании примитива все работает, а вот при его изменении — нет.
При изменении текста тоже работает. Правда пост датирован 2005 годом, может уже все все знают :), но тем не менее парочку функций и команд.
Ф-ции не претендуют на окончательный вариант, все изложенное здесь лишь иллюстрация по работе с полями из лиспа.
;Возвращает T если в объекте есть поле
;;; obj - VLA-объект
(defun isFieldAvailable ( obj / fc )
(and
(vlax-method-applicable-p obj 'FieldCode) ;_есть метод FieldCode
(setq fc (vlax-invoke obj 'FieldCode))
(vl-string-search "%<\\Ac" fc)
(vl-string-search ">%" fc)
)
)
;_Удаляет все поля из объекта
;;; 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 - сформированная строка поля (такая же, какая отражается в окне редактора
;;Никаких проверок на корректность строки и присутствия оной в строке 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)
)
;_Пример команда меняет точность представления чисел в полях
;_Например поле длины с установленной точностью N на новую
(defun c:DEMO4 ( / oldpre newpre obj fc newstr)
(princ "\nМеняет точность представления чисел в полях")
(initget 1)
(setq newpre (getint "\nНовая точность: "))
(if (and
(setq obj (car (entsel "\nУкажите текст, содержаций поле : ")))
(setq obj (vlax-ename->vla-object obj))
(vlax-method-applicable-p obj 'FieldCode)
(vlax-write-enabled-p obj)
)
(progn
(setq fc (vlax-invoke obj 'FieldCode)) ;_Получаем текст + поле
(if (and
(setq oldpre (vl-string-search "%pr" fc))
(vl-string-search "%" fc (1+ oldpre))
)
(progn
(setq oldpre
(substr fc (1+ oldpre)
(- (vl-string-search "%" fc (1+ oldpre))
(1- oldpre))
)
)
(setq newstr (vl-string-subst
(strcat "%pr" (itoa newpre) "%")
oldpre
fc)
)
(vlax-put obj 'TextString newstr)
)
)
(princ)
)
)
(princ)
)
;если нужно просто напечатать в командной строке AutoCAD ID примитива,
;то можно воспользоваться и такой командой:
(defun C:EID ( / )
(vl-load-com)
(vla-get-objectid (vlax-ename->vla-object (car (entsel))))
)
;так - чтобы сразу печатался полный текст поля для длины
(defun C:PFLD ( / en)
(if (setq en (car (entsel))) (progn
(princ (strcat "\n"
"%<\\AcObjProp Object(%<\\_ObjId "
(vl-princ-to-string (vla-get-objectid (vlax-ename->vla-object en)))
">%).Length>%"
))
)) ;_endof if progn
(princ)
) ;_endof defun
