Re: LISP. Очистка форматирования многострочного текста
> VVA
Ну прямо сказка какая-то! Спасибо!!!
Информационный портал для профессионалов в области САПР
Вы не вошли. Пожалуйста, войдите или зарегистрируйтесь.
Чтобы отправить ответ, вы должны войти или зарегистрироваться
> VVA
Ну прямо сказка какая-то! Спасибо!!!
На мой взгляд в этой программе не хватает настроек. Предлагаю немного подправленный вариант. В функции _kpblc-clear-mtext добавлен аргумент settings, а также убраны строки, удаляющие символ "}", т.к. этот символ просто игнорируется (для его отображения используется "\}"). Также дополнена функция c:unf-mtext и добавлена третья функция ks-flags-window. Для сохранения настроек используются глобальные переменные unf-font, unf-oblique, unf-width, unf-distbetween, unf-height, unf-settingsdefined.
;|============================================================================= * Функция сносит форматирование многострочного текста. Удаляются символы "{" * и "}", поскольку именно символ "}" является окончанием применения определенного * фонта. Удаляются наборы типа {fTimes New Roman|b0|i0|c204|p18; и т.п. * Параметры вызова: * string-to-normalize — строка, которую надо нормализовать * settings - настройки в виде списка строк ("F" "Q" и т.п.) * где F - шрифт; * Q - угол наклона; * T - межсимвольное расстояние; * W - ширина символов; * H - высота. * Примеры вызова: (_kpblc-clear-mtext (cdr (assoc 1 (entget(car(entsel))))) '("F" "T")) ; для выбранного многострочного текста очищает форматирование. =============================================================================|; (defun _kpblc-clear-mtext (string-to-normalize settings / tmpsettings sub_string sub_pos left_string right_string ) (setq tmpsettings (apply 'append (mapcar '(lambda (a) (list (strcat "{" a) (strcat "\\" a) (strcat "{\\" a) ) ;_ list ) ;_ lambda settings ) ;_ mapcar ) ;_ apply ) ;_ setq (if (vl-member-if '(lambda (a) (setq sub_pos (vl-string-search a (strcase string-to-normalize)) ) ;_ setq ) ;_ lambda tmpsettings ) ;_ vl-member-if (progn (setq left_string ;все, что до "{" (vl-string-trim "{" (substr string-to-normalize 1 (vl-string-position (ascii "\\") string-to-normalize sub_pos ) ;_ end of vl-string-position ) ;_ end of substr ) ;_ end of vl-string-trim ) ;_ end of setq (if (vl-string-position (ascii ";") string-to-normalize sub_pos ) ;_ end of vl-string-position (setq right_string ;все, что между {f и ; (substr string-to-normalize (+ (vl-string-position (ascii ";") string-to-normalize sub_pos ) ;_ end of vl-string-position 2 ) ;_ end of + ) ;_ end of substr ) ;_ end of setq (setq right_string "") ) ;_ end of if (_kpblc-clear-mtext (strcat left_string right_string) settings ) ;_ _kpblc-clear-mtext ) ;_ end of progn string-to-normalize ) ;_ end of if ) ;_ end of defun ;|============================================================================= * Функция удаления форматирования на выбранных элементах =============================================================================|; ;;;Глобальные переменные: ;;;unf-font ;;;unf-oblique ;;;unf-width ;;;unf-distbetween ;;;unf-height ;;;unf-settingsdefined (defun c:unf-mtext (/ selset item _answer_ layer_set_list layer_status_list *error* col row _kpblc-layer-status-restore _kpblc-layer-status-save list-of-perem list-of-label settings ) ;;;Настройки (setq list-of-perem '(unf-font unf-oblique unf-width unf-distbetween unf-height) list-of-label '("Шрифт" "Угол наклона" "Ширина" "Межсимвольное расстояние" "Высота" ) ) ;_ setq (if (not unf-settingsdefined) (progn (mapcar 'set list-of-perem '(t t nil nil nil)) (setq unf-settingsdefined t) ) ;_ progn ) ;_ if ;;; ;; Локальные функции ;; Обработчик ошибок (defun *error* (msg) (princ msg) ;; Завершение активных команд (while (/= (getvar "cmdactive") 0) (command)) (_kpblc-layer-status-restore) (vla-endundomark *kpblc-activedoc*) ) ;_ end of defun (defun _kpblc-layer-status-restore () (foreach item layer_status_list (if (not (vlax-erased-p (car item))) (vl-catch-all-apply '(lambda () (vla-put-lock (car item) (cdr (assoc "lock" (cdr item)))) (vla-put-freeze (car item) (cdr (assoc "freeze" (cdr item))) ) ;_ vla-put-freeze ) ;_ end of lambda ) ;_ end of vl-catch-all-apply ) ;_ end of if ) ;_ end of foreach (setq layer_status_list nil) ) ;_ end of defun (defun _kpblc-layer-status-save () (setq layer_status_list nil) (vlax-for item (vla-get-layers *kpblc-activedoc*) (setq layer_status_list (cons (list item (cons "freeze" (vla-get-freeze item)) (cons "lock" (vla-get-lock item)) ) ;_ end of cons layer_status_list ) ;_ end of cons ) ;_ end of setq (vla-put-lock item :vlax-false) (vl-catch-all-apply '(lambda () (vla-put-freeze item :vlax-false)) ) ;_ vl-catch-all-apply ) ;_ end of vlax-for ) ;_ end of defun ;; Конец локальных функций ;; Запросы опций (vl-load-com) (while (progn (initget "вЕсь Выбор Настройки _ All Selection Options") (= (setq _answer_ (getkword "Обрабатывать объем [вЕсь файл/Выбор/Настройки] ? <Весь файл> : " ) ;_ end of getkword ) ;_ end of setq "Options" ) ;_ = ) ;_ = (if (setq tmp (ks-flags-window "Удаление форматирования" (mapcar 'cons list-of-label (mapcar 'eval list-of-perem)) ) ;_ KS-FLAGS-WINDOW ) ;_ setq (mapcar 'set list-of-perem tmp) ) ;_ if ) ;_ while ;;;Запись списка настроек (setq settings nil) (if unf-font (setq settings (cons "F" settings)) ) ;_ if (if unf-oblique (setq settings (cons "Q" settings)) ) ;_ if (if unf-width (setq settings (cons "W" settings)) ) ;_ if (if unf-distbetween (setq settings (cons "T" settings)) ) ;_ if (if unf-height (setq settings (cons "H" settings)) ) ;_ if ;;; (or *kpblc-activedoc* (setq *kpblc-activedoc* (vla-get-activedocument (vlax-get-acad-object)) ) ;_ setq ) ;_ or (vla-startundomark *kpblc-activedoc*) (if (= _answer_ "Selection") (setq selset (ssget '((0 . "MTEXT,ACAD_TABLE")))) (setq selset (ssget "_X" '((0 . "MTEXT,ACAD_TABLE")))) ) ;_ end of if (_kpblc-layer-status-save) (while (and selset (> (sslength selset) 0)) (setq item (ssname selset 0)) (ssdel item selset) (setq item (vlax-ename->vla-object item)) (if (= (vla-get-objectname item) "AcDbTable") (progn (vla-put-regeneratetablesuppressed item :vlax-true) (setq col 0) (repeat (vla-get-columns item) (setq row 0) (repeat (vla-get-rows item) (vla-settext item row col (_kpblc-clear-mtext (vla-gettext item row col) settings) ) ;_ vla-settext (setq row (1+ row)) ) ;_ repeat (setq col (1+ col)) ) ;_ repeat (vla-put-regeneratetablesuppressed item :vlax-false) (vla-update item) ) ;_ progn (if (vlax-property-available-p item "TextString") (vlax-put-property item "TextString" (_kpblc-clear-mtext (vlax-get-property item "TextString") settings ) ;_ _kpblc-clear-mtext ) ;_ vlax-put-property ) ;_ if ) ;_ if ) ;_ end of while (_kpblc-layer-status-restore) (vla-endundomark *kpblc-activedoc*) ) ;_ end of defun ;;;Корнеев С.Н. ;;;KorneevSGASU@rambler.ru ;;;Функция для вывода диалога со списком флагов ;;;<main-label> - название окна ;;;<list-of-params> - список вида '(("Имя параметра" . <T/nil>)...) ;;;Возвращает список вида '(T T nil и т.д.) ;;;Cancel - возвращает nil. ;;;T - флаг включен ;;;nil - выключен (defun ks-flags-window (main-label list-of-params / filename fid i dcl_id list-of-value ) ;;;Создание временного файла диалового окна (setq filename (vl-filename-mktemp "dcl" "" ".dcl") fid (open filename "w") i 1 ) ;_ setq (write-line (strcat "tmp: dialog {label = \"" main-label "\";") fid ) ;_ write-line (foreach a list-of-params (write-line (strcat ":toggle{label = \"" (car a) "\"; key = \"k" (itoa i) "\";}" ) ;_ strcat fid ) ;_ write-line (setq i (1+ i)) ) ;_ foreach (write-line "ok_cancel;}" fid) (close fid) ;;;Файл создан ;;;Открытие диалога (setq dcl_id (load_dialog filename)) (new_dialog "tmp" dcl_id) ;;;Задание значений флагам (setq i 1) (foreach a list-of-params (set_tile (strcat "k" (itoa i)) (if (cdr a) "1" "0" ) ;_ if ) ;_ set_tile (setq i (1+ i)) ) ;_ foreach (action_tile "accept" "(setq i 1) (repeat (length list-of-params) (setq list-of-value (cons (get_tile (strcat \"k\" (itoa i))) list-of-value) i (1+ i))) (DONE_DIALOG)" ) ;_ action_tile (start_dialog) (unload_dialog dcl_id) (mapcar '(lambda (a) (if (= a "1") t ) ;_ if ) ;_ lambda (reverse list-of-value) ) ;_ mapcar ) ;_ defun
Кстати, если есть варианты картинок для этой проги, выкладывайте сюда или присылайте на мыло.
Новая версия программы.
Добавлена возможность удалять форматирование текста в размерах (TextOverride). Также исправлена функция ks-flags-window (добавлено удаление временных файлов диалога). Вот что в итоге получилось. Надеюсь это окончательная версия.
;|============================================================================= * Функция сносит форматирование многострочного текста. Удаляются символы "{" * и "}", поскольку именно символ "}" является окончанием применения определенного * фонта. Удаляются наборы типа {fTimes New Roman|b0|i0|c204|p18; и т.п. * Параметры вызова: * string-to-normalize — строка, которую надо нормализовать * settings - настройки в виде списка строк ("F" "Q" и т.п.) * где F - шрифт; * Q - угол наклона; * T - межсимвольное расстояние; * W - ширина символов; * H - высота. * Примеры вызова: (_kpblc-clear-mtext (cdr (assoc 1 (entget(car(entsel))))) '("F" "T")) ; для выбранного многострочного текста очищает форматирование. =============================================================================|; (defun _kpblc-clear-mtext (string-to-normalize settings / tmpsettings sub_string sub_pos left_string right_string ) (setq tmpsettings (apply 'append (mapcar '(lambda (a) (list (strcat "{" a) (strcat "\\" a) (strcat "{\\" a) ) ;_ list ) ;_ lambda settings ) ;_ mapcar ) ;_ apply ) ;_ setq (if (vl-member-if '(lambda (a) (setq sub_pos (vl-string-search a (strcase string-to-normalize)) ) ;_ setq ) ;_ lambda tmpsettings ) ;_ vl-member-if (progn (setq left_string ;все, что до "{" (vl-string-trim "{" (substr string-to-normalize 1 (vl-string-position (ascii "\\") string-to-normalize sub_pos ) ;_ end of vl-string-position ) ;_ end of substr ) ;_ end of vl-string-trim ) ;_ end of setq (if (vl-string-position (ascii ";") string-to-normalize sub_pos ) ;_ end of vl-string-position (setq right_string ;все, что между {f и ; (substr string-to-normalize (+ (vl-string-position (ascii ";") string-to-normalize sub_pos ) ;_ end of vl-string-position 2 ) ;_ end of + ) ;_ end of substr ) ;_ end of setq (setq right_string "") ) ;_ end of if (_kpblc-clear-mtext (strcat left_string right_string) settings ) ;_ _kpblc-clear-mtext ) ;_ end of progn string-to-normalize ) ;_ end of if ) ;_ end of defun ;|============================================================================= * Функция удаления форматирования на выбранных элементах =============================================================================|; ;;;Глобальные переменные: ;;;unf-font ;;;unf-oblique ;;;unf-width ;;;unf-distbetween ;;;unf-height ;;;unf-settingsdefined (defun c:unf-mtext (/ selset item _answer_ layer_set_list layer_status_list *error* col row _kpblc-layer-status-restore _kpblc-layer-status-save list-of-perem list-of-label settings ) ;;;Настройки (setq list-of-perem '(unf-font unf-oblique unf-width unf-distbetween unf-height) list-of-label '("Шрифт" "Угол наклона" "Ширина" "Межсимвольное расстояние" "Высота" ) ) ;_ setq (if (not unf-settingsdefined) (progn (mapcar 'set list-of-perem '(t t nil nil nil)) (setq unf-settingsdefined t) ) ;_ progn ) ;_ if ;;; ;; Локальные функции ;; Обработчик ошибок (defun *error* (msg) (princ msg) ;; Завершение активных команд (while (/= (getvar "cmdactive") 0) (command)) (_kpblc-layer-status-restore) (vla-endundomark *kpblc-activedoc*) ) ;_ end of defun (defun _kpblc-layer-status-restore () (foreach item layer_status_list (if (not (vlax-erased-p (car item))) (vl-catch-all-apply '(lambda () (vla-put-lock (car item) (cdr (assoc "lock" (cdr item)))) (vla-put-freeze (car item) (cdr (assoc "freeze" (cdr item))) ) ;_ vla-put-freeze ) ;_ end of lambda ) ;_ end of vl-catch-all-apply ) ;_ end of if ) ;_ end of foreach (setq layer_status_list nil) ) ;_ end of defun (defun _kpblc-layer-status-save () (setq layer_status_list nil) (vlax-for item (vla-get-layers *kpblc-activedoc*) (setq layer_status_list (cons (list item (cons "freeze" (vla-get-freeze item)) (cons "lock" (vla-get-lock item)) ) ;_ end of cons layer_status_list ) ;_ end of cons ) ;_ end of setq (vla-put-lock item :vlax-false) (vl-catch-all-apply '(lambda () (vla-put-freeze item :vlax-false)) ) ;_ vl-catch-all-apply ) ;_ end of vlax-for ) ;_ end of defun ;; Конец локальных функций ;; Запросы опций (vl-load-com) (while (progn (initget "вЕсь Выбор Настройки _ All Selection Options") (= (setq _answer_ (getkword "Обрабатывать объем [вЕсь файл/Выбор/Настройки] ? <Весь файл> : " ) ;_ end of getkword ) ;_ end of setq "Options" ) ;_ = ) ;_ = (if (setq tmp (ks-flags-window "Удаление форматирования" (mapcar 'cons list-of-label (mapcar 'eval list-of-perem)) ) ;_ KS-FLAGS-WINDOW ) ;_ setq (mapcar 'set list-of-perem tmp) ) ;_ if ) ;_ while ;;;Запись списка настроек (setq settings nil) (if unf-font (setq settings (cons "F" settings)) ) ;_ if (if unf-oblique (setq settings (cons "Q" settings)) ) ;_ if (if unf-width (setq settings (cons "W" settings)) ) ;_ if (if unf-distbetween (setq settings (cons "T" settings)) ) ;_ if (if unf-height (setq settings (cons "H" settings)) ) ;_ if ;;; (or *kpblc-activedoc* (setq *kpblc-activedoc* (vla-get-activedocument (vlax-get-acad-object)) ) ;_ setq ) ;_ or (vla-startundomark *kpblc-activedoc*) (if (= _answer_ "Selection") (setq selset (ssget '((0 . "MTEXT,ACAD_TABLE,DIMENSION")))) (setq selset (ssget "_X" '((0 . "MTEXT,ACAD_TABLE,DIMENSION")))) ) ;_ end of if (_kpblc-layer-status-save) (while (and selset (> (sslength selset) 0)) (setq item (ssname selset 0)) (ssdel item selset) (setq item (vlax-ename->vla-object item)) (if (= (vla-get-objectname item) "AcDbTable") (progn (vla-put-regeneratetablesuppressed item :vlax-true) (setq col 0) (repeat (vla-get-columns item) (setq row 0) (repeat (vla-get-rows item) (vla-settext item row col (_kpblc-clear-mtext (vla-gettext item row col) settings) ) ;_ vla-settext (setq row (1+ row)) ) ;_ repeat (setq col (1+ col)) ) ;_ repeat (vla-put-regeneratetablesuppressed item :vlax-false) (vla-update item) ) ;_ progn (foreach a '("TextString" "TextOverride") (if (vlax-property-available-p item a) (vlax-put-property item a (_kpblc-clear-mtext (vlax-get-property item a) settings ) ;_ _kpblc-clear-mtext ) ;_ vlax-put-property ) ;_ if ) ;_ foreach ) ;_ if ) ;_ end of while (_kpblc-layer-status-restore) (vla-endundomark *kpblc-activedoc*) ) ;_ end of defun ;;;ks-flags-window ;;;Корнеев С.Н. ;;;KorneevSGASU@rambler.ru ;;;Функция для вывода диалога со списком флагов ;;;<main-label> - название окна ;;;<list-of-params> - список вида '(("Имя параметра" . <T/nil>)...) ;;;Возвращает список вида '(T T nil и т.д.) ;;;Cancel - возвращает nil. ;;;T - флаг включен ;;;nil - выключен (defun ks-flags-window (main-label list-of-params / filename fid i dcl_id list-of-value *error* ) (defun *error* (msg) (vl-catch-all-apply 'close (list fid)) (vl-file-delete filename) (princ msg) ) ;_ defun ;;;Создание временного файла диалового окна (setq filename (vl-filename-mktemp "dcl" "" ".dcl") fid (open filename "w") i 1 ) ;_ setq (write-line (strcat "tmp: dialog {label = \"" main-label "\";") fid ) ;_ write-line (foreach a list-of-params (write-line (strcat ":toggle{label = \"" (car a) "\"; key = \"k" (itoa i) "\";}" ) ;_ strcat fid ) ;_ write-line (setq i (1+ i)) ) ;_ foreach (write-line "ok_cancel;}" fid) (close fid) ;;;Файл создан ;;;Открытие диалога (setq dcl_id (load_dialog filename)) (new_dialog "tmp" dcl_id) ;;;Задание значений флагам (setq i 1) (foreach a list-of-params (set_tile (strcat "k" (itoa i)) (if (cdr a) "1" "0" ) ;_ if ) ;_ set_tile (setq i (1+ i)) ) ;_ foreach (action_tile "accept" "(setq i 1) (repeat (length list-of-params) (setq list-of-value (cons (get_tile (strcat \"k\" (itoa i))) list-of-value) i (1+ i))) (DONE_DIALOG)" ) ;_ action_tile (start_dialog) (unload_dialog dcl_id) (vl-file-delete filename) (mapcar '(lambda (a) (if (= a "1") t ) ;_ if ) ;_ lambda (reverse list-of-value) ) ;_ mapcar ) ;_ defun
Алексей Кулик ака Kpblc, если не сложно, хотелось бы услышать Ваше мнение.
А что мое мнение (кстати, меня один;)? Если опции необходимы, значит, так тому и быть. Есть только один момент: вариант что исходного кода, что последнего не будет обрабатывать элементы, лежащие внутри блоков. То есть надо делать рекурсию с дополнительными проверками (для гарантии полной обработки файла). Учитывая, что в 2008 появились многострочные атрибуты текстов, это тоже надо учитывать. То есть теоретически код требует доработки (чем я, кстати, с утра и займусь, скорее всего).
Попробовал этот лисп. Хорошая вещь. Только у меня он многие из обработанных мтекстов сделал какими-то полужирноватыми, хотя в их редакторе кнопка "Полужирный" не нажата, и они менее жирные, чем если она нажата. И они какие-то стали "лохматые" что ли....Формат у них такой же, как и у "неполужирноватых и нелохматых" Чтоо за ерунда??...
Не поверю, что ни у кого такого не было....(смайл с улыбкой)))
Речь о .ttf шрифтах, благо, отпала необходимость в их использовании, убедил руководство пользоваться gost.shx
Вышеприведенная программа не работает для текстов, получившихся после взрывания таблиц.
Чтобы отправить ответ, вы должны войти или зарегистрироваться
Форум работает на PunBB, при поддержке Informer Technologies, Inc