Тема: 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