Реклама i
Стань нашим партнером - зарабатывай с нами!
| Правила | Регистрация | Пользователи | Поиск | Сообщения за день | Все разделы прочитаны |  Справка по форуму | Файлообменник |

Вернуться   Форум DWG.RU > Программное обеспечение > AutoCAD > Замена шрифта сразу во всех стилях

Замена шрифта сразу во всех стилях

Ответ
Поиск в этой теме
Непрочитано 16.11.2006, 13:16 #1
Замена шрифта сразу во всех стилях
Georg
 
Design
 
Kiev
Регистрация: 27.10.2004
Сообщений: 57

:arrow: Как в чертеже поменять во всех текстовых стилях шрифт на один определенный.

Бывает необходимо, когда приносят распечатать чертежи сторонних контор, а шрифты пиплы забывают прикладывать.
Вот и приходится в сотне чертежей менять шрифт в каждом из десятка стилей

:arrow: Может у кого Лисп есть для такого дела?
Просмотров: 27786
 
Непрочитано 16.11.2006, 13:29
#2
DEM

YngIngKllr
 
Регистрация: 29.03.2005
СПб
Сообщений: 12,968


1.Выделяешь все
2. В окне свойств свойств меняешь на текст(там где написано Все ХХХ)
3. Меняешь в стилях текста на требуемый.
Только будут возможно проблемы с текстом, где нибудь будет вылезать за рамки или символы не прочитаются.
__________________
Работаю за еду.
Working for food.
Für Essen arbeiten.
العمل من أجل الغذاء
Працую за їжу.
DEM вне форума  
 
Непрочитано 16.11.2006, 13:29
#3
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,787


Тебе только шрифт надо поменять? Если тексты поплывут, это как, нормально?
Добавлено: способ DEM'a не сработает на текстах, входящих в блоки; на атрибутах; на текстах, лежащих в пространстве других листов
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 16.11.2006, 15:10
#4
p_sh

новичок
 
Регистрация: 19.06.2005
Ярославль
Сообщений: 3,396


лови на VBA


Public Sub FontChange()
Dim TS As AcadTextStyle
Dim TSs As AcadTextStyles

Set TSs = ThisDrawing.TextStyles

For Each TS In TSs
TS.fontFile = "simplex.shx"
Next

End Sub

соответственнов во всех открытых чертежах

Public Sub FontChange()
Dim DRs As AcadDocuments
Dim DR As AcadDocument

Dim TS As AcadTextStyle
Dim TSs As AcadTextStyles

Set DRs = Application.Documents
For Each DR In DRs
Set TSs = ThisDrawing.TextStyles
For Each TS In TSs
TS.fontFile = "simplex.shx"
Next
Next
End Sub
p_sh вне форума  
 
Автор темы   Непрочитано 16.11.2006, 15:12
#5
Georg

Design
 
Регистрация: 27.10.2004
Kiev
Сообщений: 57


Надо поменять только шрифт, желательно везде – на один
Если текст поплывет нестрашно, главное чтоб читаем был.

Способ DEM срабатывает не полностью
в размерах шрифт все равно остается "чужой"
Georg вне форума  
 
Непрочитано 16.11.2006, 15:17
#6
DEM

YngIngKllr
 
Регистрация: 29.03.2005
СПб
Сообщений: 12,968


ГЫ а кто про размеры говорил?? :shock:
Так же ты можешь поменять и стили размеров и шрифтов в размерах.
Только надо выбрать уже не текст а размеры.
__________________
Работаю за еду.
Working for food.
Für Essen arbeiten.
العمل من أجل الغذاء
Працую за їжу.
DEM вне форума  
 
Непрочитано 16.11.2006, 15:25
#7
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,787


Спробуй так:
Код:
[Выделить все]
(defun setfont (font-name / selset)
  (vl-load-com)
  (if (findfile font-name)
    (progn
      (vlax-for style
                      (vla-get-textstyles
                        (vla-get-activedocument (vlax-get-acad-object))
                        ) ;_ end of vla-get-textstyles
        (vl-catch-all-apply
          '(lambda () (vla-put-fontfile style (findfile font-name)))
          ) ;_ end of VL-CATCH-ALL-APPLY
        ) ;_ end of vlax-for
      ) ;_ end of progn
    ) ;_ end of if
  ) ;_ end of defun
Для блоков с атрибутами может понадобиться выполнять _attsync - я код не тестировал особо.
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Автор темы   Непрочитано 16.11.2006, 16:25
#8
Georg

Design
 
Регистрация: 27.10.2004
Kiev
Сообщений: 57


kpblc, а как его вызвать? :?:
я создал text.lsp с текстом программы
загрузил в КАД
набираю setfont и - фонарь :?
Georg вне форума  
 
Непрочитано 16.11.2006, 16:42
#9
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,787


Прально. Надо вызывать:
Код:
[Выделить все]
Command: (setfont "simplex.shx")
Вместо simplex.shx подставь свой фонт, главное, чтоб файл фонта был находимым по путям ACAD'a
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Автор темы   Непрочитано 16.11.2006, 17:36
#10
Georg

Design
 
Регистрация: 27.10.2004
Kiev
Сообщений: 57


Работает!

а можно за одно и в МТЕКСТе заменить шрифты :?:
Georg вне форума  
 
Непрочитано 17.11.2006, 08:38
#11
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,787


Погляди здесь: http://www.autocad.ru/cgi-bin/f1/board.cgi?t=20905TQ - оно?
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Автор темы   Непрочитано 17.11.2006, 12:04
#12
Georg

Design
 
Регистрация: 27.10.2004
Kiev
Сообщений: 57


ОНО :!:
только вот

Обрабатывать объем [вЕсь файл/Выбор] ? <Весь файл>

вЕсь файл - не могу ввести опцию и по умолчанию не срабатывает
Выбор - работает
Georg вне форума  
 
Непрочитано 17.11.2006, 12:17
#13
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,787


Мелкий, но от этого не менее противный баг там был. Исправляемся
Код:
[Выделить все]
;|=============================================================================
*    Функция сносит форматирование многострочного текста. Удаляются символы "{"
* и "}", поскольку именно символ "}" является окончанием применения определенного
* фонта. Удаляются наборы типа {fTimes New Roman|b0|i0|c204|p18; и т.п.
*    Параметры вызова:
*  string-to-normalize  — строка, которую надо нормализовать
*    Примеры вызова:
(_kpblc-clear-mtext (cdr (assoc 1 (entget(car(entsel))))))
  ; для выбранного многострочного текста очищает форматирование.
=============================================================================|;
(defun _kpblc-clear-mtext (string-to-normalize
                           /                 sub_string
                           sub_pos           left_string
                           right_string
                           )
  (if (or
        (setq sub_pos (vl-string-search "{f" string-to-normalize))
        (setq sub_pos (vl-string-search "{\\" string-to-normalize))
        (setq sub_pos (vl-string-search "\\f" string-to-normalize))
        (setq sub_pos (vl-string-search "{\\f" string-to-normalize))
        ) ;_ end of or
    (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))
      ) ;_ end of progn
    (vl-list->string
      (vl-remove
        (ascii "}")
        (vl-string->list string-to-normalize)
        ) ;_ end of vl-remove
      ) ;_ end of vl-list->string
    ) ;_ end of if
  ) ;_ end of defun

;|=============================================================================
*    Функция удаления форматирования на выбранных элементах
=============================================================================|;
(defun c:unf-mtext
       (/ selset item _error_ _answer_ layer_set_list layer_status_list)

  ;; Локальные функции

  ;; Обработчик ошибок
  (defun kpblc-error (message)
    (if (member message
                '("console break"           "Function cancelled"
                  "Функция отменена"        "quit / exit abort"
                  "выйти прервать"
                  ) ;_list
                ) ;_member
      (princ "\nКоманда прервана пользователем")
      (princ
        (strcat "\ERRNO # "
                (itoa (getvar "ERRNO"))
                ": "
                message
                "\n"
                ) ;_strcat
        ) ;_princ
      ) ;_if
    ;; Завершение активных команд
    (while (/= (getvar "cmdactive") 0)
      (command nil)
      ) ;_while
    (vla-endundomark *kpblc-activedoc*)
    (setq *error* _error_)
    ) ;_ end of defun

  ;; Делает слой включенным, разблокированным и незамороженным (глобально)
  (defun _kpblc-make-layer-free (layer-name / layer_item)
    (if layer_status_list
      (alert (strcat "Остались настройки слоя " layer-name))
      ) ;_ end of if
    (setq layer_status_list nil
          layer_item        (vlax-ename->vla-object
                              (tblobjname "layer" layer-name)
                              ) ;_ end of vlax-ename->vla-object
          layer_status_list (list
                              (cons
                                "LayerOn"
                                (vlax-get-property layer_item "LayerOn")
                                ) ;_ end of cons
                              (cons
                                "Lock"
                                (vlax-get-property layer_item "Lock")
                                ) ;_ end of cons
                              (cons
                                "Freeze"
                                (vlax-get-property layer_item "Freeze")
                                ) ;_ end of cons
                              ) ;_ end of list
          ) ;_ end of setq
    (vlax-put-property layer_item "LayerOn" :vlax-true)
    (vlax-put-property layer_item "Lock" :vlax-false)
    (if (/=
          (vlax-get-property
            (vlax-get-property *kpblc-activedoc* "ActiveLayer")
            "Name"
            ) ;_ end of vlax-get-property
          layer-name
          ) ;_ end of /=
      (vlax-put-property layer_item "freeze" :vlax-false)
      ) ;_ end of if
    ) ;_ end of defun

  ;; Возвращает установки слоя
  (defun _kpblc-restore-layer (layer-name / layer_item)
    (if layer_status_list
      (progn
        (setq layer_item
               (vlax-ename->vla-object (tblobjname "layer" layer-name))
              ) ;_ end of setq
        (foreach loc_item '("LayerOn" "Lock" "Freeze")
          (if (and
                (/=
                  (vlax-get-property
                    (vlax-get-property *kpblc-activedoc* "ActiveLayer")
                    "Name"
                    ) ;_ end of vlax-get-property
                  layer-name
                  ) ;_ end of /=
                (/= loc_item "Freeze")
                ) ;_ end of and
            (vlax-put-property
              layer_item
              loc_item
              (cdr
                (assoc loc_item layer_status_list)
                ) ;_ end of cdr
              ) ;_ end of vlax-put-property
            ) ;_ end of if
          ) ;_ end of foreach
        ) ;_ end of progn
      ) ;_ end of if
    (setq layer_status_list nil)
    ) ;_ end of defun

  ;; Конец локальных функций

  ;; Запросы опций
  (vl-load-com)
  (initget "вЕсь Выбор _ All Selection")
  (setq _error_  *error*
        *error*  kpblc-error
        _answer_ (getkword
                   "Обрабатывать объем [вЕсь файл/Выбор] ? <Весь файл> : "
                   ) ;_ end of getkword
        ) ;_ end of setq
  (if (not *kpblc-activedoc*)
    (setq *kpblc-activedoc* (vla-get-activedocument (vlax-get-acad-object)))
    ) ;_ end of if
  (vla-startundomark *kpblc-activedoc*)
  (if (= _answer_ "Selection")
    (setq selset (ssget '((0 . "MTEXT"))))
    (setq selset (ssget "_X" '((0 . "MTEXT"))))
    ) ;_ end of if
  (while (and
           selset
           (> (sslength selset) 0)
           ) ;_ end of and
    (setq item (ssname selset 0))
    (ssdel item selset)
    (_kpblc-make-layer-free (cdr (assoc 8 (entget item))))
    (vlax-put-property
      (vlax-ename->vla-object item)
      "TextString"
      (_kpblc-clear-mtext
        (vlax-get-property (vlax-ename->vla-object item) "TextString")
        ) ;_ end of _kpblc-clear-mtext
      ) ;_ end of vlax-put-property
    (_kpblc-restore-layer (cdr (assoc 8 (entget item))))
    ) ;_ end of while
  (vla-endundomark *kpblc-activedoc*)
  (setq *error* _error_) ;Возврат старого обработчика ошибок
  (princ)
  ) ;_ end of defun

(princ "\nНаберите unf-mtext для очистки форматирования многострочных текстов"
       ) ;_ end of princ
Проверил, вроде как работает.
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Автор темы   Непрочитано 17.11.2006, 12:49
#14
Georg

Design
 
Регистрация: 27.10.2004
Kiev
Сообщений: 57


Сенкс, все работает :!:
Georg вне форума  
 
Непрочитано 22.07.2010, 16:24
#15
мозг

конструктор ПГС
 
Регистрация: 02.09.2007
Киев
Сообщений: 57


Алексей,
я извиняюсь за наглость, но у меня возникла такая же задача:
заменить шрифт сразу во всех стилях.
загрузил ваш лисп - не работает.
вот разные вариации
Код:
[Выделить все]
Команда: (setfont "isocpeur.ttf")
nil

Команда: (setfont "isocpeur")
nil

Команда: (setfont isocpeur)
; ошибка: неверный тип аргумента: stringp nil
автокад 2008 русский


апдейт.
проблема решена путем занесения папки c\windows\fonts в пути поддержки

Последний раз редактировалось мозг, 22.07.2010 в 16:52.
мозг вне форума  
 
Непрочитано 22.07.2010, 17:51
#16
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,990
<phrase 1= Отправить сообщение для VVA с помощью Skype™


CTS - замена текстовых стилей у всех объектов на выбранный
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
 
Непрочитано 27.05.2013, 00:22
#17
voverrr

гастарбайтер понаехал
 
Регистрация: 07.12.2009
Маскво
Сообщений: 267


обвинят сейчас меня в некрофилии небось.

А как сделать, чтобы менялся шрифт в уже имеющемся текстовом стиле(Standard)?
примерный план:
-берём любой чертёж.
-проверяем, есть ли стиль "standard".
-если нет - создаём.
-назначаем в нём шрифт simplex.shx //например
-назначаем Standard текущим.
voverrr вне форума  
 
Непрочитано 27.05.2013, 00:57
#18
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,787


Самое простое решение - dws.
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 27.05.2013, 01:13
#19
voverrr

гастарбайтер понаехал
 
Регистрация: 07.12.2009
Маскво
Сообщений: 267


А чтобы автоматически?
Открываешь чертёж, оно само всё назначает.
voverrr вне форума  
 
Непрочитано 27.05.2013, 17:32
1 | #20
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,990
<phrase 1= Отправить сообщение для VVA с помощью Skype™


Добавть код в автозагрузку
Код:
[Выделить все]
(vl-load-com)
((lambda ( _style _fontfile  / tmp)
		    (if (not (tblsearch "STYLE" _style))
		      (setq tmp  (vla-add (vla-get-textstyles (vla-get-activedocument (vlax-get-acad-object))) _style))
                      (setq tmp (TBLOBJNAME "STYLE" _style)
			    tmp (vlax-ename->vla-object tmp)
                            )
                      )
			(vla-put-fontfile tmp (findfile _fontfile)) ;_Шрифт
			(vla-put-height tmp 0.0)
;_			(vla-put-obliqueangle tmp (/ (* 15 PI) 180)) ;_15 - Угол наклона в градусах
			(vla-put-width tmp 1) ;_Ширина
		        (vla-put-activetextstyle (vla-get-activedocument (vlax-get-acad-object)) tmp)
		      )
          "MY_STYLE_NAME" ;_Имя стиля
          "simplex.shx"   ;_имя файла шрифта
          )
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > AutoCAD > Замена шрифта сразу во всех стилях

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

Расширенный поиск