[VVA]

По мотивам Замена текстового стиля
Команды CTS и CTSU подверглись косметическим улучшением.
Добавлена команда TSUP - изменение начертания текстов, атрибутов на основе установок выбранного стиля (начертание, сжатие, угол наклона).
Использована функция ru-textstyle-update любезно предоставленная ShaggyDoc
Описание команд:
Как это работает - см пост #12
CTS - замена текстовых стилей у всех объектов на выбранный
CTSU - замена текстовых стилей у всех объектов на выбранный с очисткой форматирования многострочных текстов
TSUP - Для выбранного стиля изменяется начертания всех существующих ТЕКСТОВ, АТРИБУТОВ во ВСЕХ примитивах, включая блоки в соответствии с установками стиля (начертание, сжатие, угол наклона). Сначала с помощью команды _style задаем необходимые установки стиля (шрифт, наклон, сжатие/растяжение). Затем командой TSUP для всех текстов и атрибутов, вычерченных этим стилем, устанавливается наклон, сжатие/растяжение такой же как и в определении стиля.
UNF-MTEXT - Убрать форматирование мтекста
Допустим у Вас текст, вычерченный стилем Стиль1 с углом наклона 15 градусов. Вызываем команду _style и выставляем в стиле Стиль1 угол 0. В тексте угол остался прежним 15 градусов. Чтобы синхронизировать параметры текста с параметрами стиля (наклон, сжатие/растяжение) и вызываем команду TSUP.

Возможный вариант макроса для пунктов 3-5

Код:

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

(if (null C:CTS)(load "change text styles (cts)"));CTS;(cts:layer-status-save);(ru-textstyle-update "*");_.PURGE;

***Изменения
22.10.2008 Добавлена обработка форматирования МТЕКСТОВ для Автокада с 2008 версии (выравнивание влево, вправо, посередине, по ширине, распределенное)
02.12.2008 Изменена ф-ция cts:msg-yes в соответствии с постом #46 Диалог строится не VBA, а лиспом (dcl)
26.02.2009 Версия 1.3 Исключена обработка блоков внешних ссылок (Спасибо Sleekka). Добавлен выбор игнорируемых стилей
16.03.2009 В версии 1.3 CTSU исправлена ошибка с разным количеством аргументов
05.02.2010 Добавлена обработка дополнительного форматирования в ф-цию mip_MTEXT_Unformat (см. сообщение wetr)
09.03.2010 В версии 1.4 в TSUP исправлена ошибка обработки примитивов только на текущем листе
03.06.2010 Отдельная команда для удаления форматирования мтекста
23.12.2011 UNF-MTEXT (vla-SetCellState item row col acCellStateNone) Снятие блокировки ячейки
21.11.2013 Добавлена обработка MLEADER. Команда CTS
20.04.2016 Добавлена функция CTS:GET-TEXTSTRING (как замена vla-get-textstring. Т.к. неверно возвращает строку при наличии юникод символов)
http://forums.autodesk.com/t5/visual...s/td-p/4365165
26.12.2017 Добавлена для таблиц vla-put-RegenerateTableSuppressed
03.06.2019 Обновление артибутов блоков, включенных в другие блоки
24.12.2021 Обновлена ф-ция mip_MTEXT_Unformat, обработка форматирования //PI
03.04.2024 Изменения в функции CTS (формулы в таблицах остаются) https://forum.dwg.ru/showthread.php?...77#post2065477 post #306

Описание

DESCRIPTION StripMtext v5.0b Copyright© Steve Doman and Joe Burke 2010 StripMtext is an AutoLISP program that runs inside AutoCAD 2000 or above and enables the AutoCAD user to quickly remove unwanted Mtext formatting embedded in Mtext, Mleaders, Dimensions, Tables, and Multiline Attributes objects.

Оригинальный пост (требуется регистрация)

В версии 1.5 добавлена отдельная команда UNF-MTEXT для удаления форматирования MTEXTa
В версии 1.6 добавлено снятие блокировки ячейки таблицы при установке связи Datalink
Важно!!! Начиная с 2021 Автокада может не срабатывать команда stripmtext. Решение - установить системную переменную LISPSYS=0
См пост #281 и #282 или гугл

[dextron3]

что такое деформатирование? (это перевод в обычный текст?)

[VVA]

Это я так перевел unformat. Деформатирование - очистка форматирования многострочного текста. Исправил в #1

[dextron3]

VVA, что то не могу сообразить мне дали чертеж АР там есть мой стиль, я черчу прямыми буквами, а лисп не выправил ни в размерах цыфры не просто буквы может я не понял принцип лиспа?

[VVA]

dextron3, Чем и что делал? Думаю что не понял принципа.

*** Добавлено. Исправлена неточночть в ru-textstyle-update. Обновлен #1.

> ShaggyDoc в ru-textstyle-update добавил проверку (выделена красным). Имя стиля может хранится в нижнем регитре.

Код:

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

    (if (and (or (= "TEXT" ent_type)
                 (= "ATTRIB" ent_type)
                 (= "ATTDEF" ent_type)
             ) ;_ end of or
             (or (= "*" style_name)
                 (= (strcase style_name)(strcase (cdr (assoc 7 ent_data))))
             ) ;_ end of or
        ) ;_ end of and
...

[dextron3]

вот видеоролик у меня не работает ничегошеньки....

[VVA]

В твоем фильме не видны настройки текстового стиля GOST 2.304. TSUP согласовывает настройки СТИЛЯ (начертание, наклон, ширину) и текстов, вычерченных этим стилем

[dextron3]

VVA,

вот мои настройки

[dextron3]

А вот автокадовский файл для разминки

[VVA]

dextron3, Мы наверное не понимаем друг друга. Разминка прошла успешно. Я изменил описание команды TSUP в #1. Может будет немного понятнее. Еще обращаю внимание, что в коде было исправление и нужно было скачать его еще раз. Не знаю, есть ли ты в числе тех 11 на данный момент, но скачай еще раз на всякий случай.

[dextron3]

VVA, теперь я начал Вас понимать, оказывается мы друг друга не понимали:

Почему я не то подумал:


Предыстория.

Изначально я приучился чертить в одном стиле с появления программы СПДС, так как там можно было эффективно использовать масштабы, не ковыряясь в стилях, еще по молодости, когда я сталкнулся с масштабированием, я для каждого масштаба создавал отдельный стиль, но при этом во всех стилях использовал одинаковый текст и наклон, а также сжатие, поэтому и получалось очень много стилей, соответсвенно свои стили приходили из других организаций, иногда доходило что в одном чертеже около 18 стилей. Приносит мне архитектор черчеж, у него площади одним стилем начерчены, размеры другим, надписи другим и тп. вот вам и набралось стилей...

Хотелось просто иметь волшебную кнопку, и когда приносят с дальних краев чертеж, нажал бы эту кнопку, и чертеж превратился в чертеж как будто это рисовал его ты со своим до боли знакомым стилем, а все заморские стили удалялились или пурджелись...


Как я думал это работает.

1. Выбираем мной настроенный стиль.
2. Все стили переводятся в мой настроенный стиль (а не каждый для каждого в отдельности, как теперь я понял работает у вас)
3. В итоге чертеж будет выполнен одним стилем, с соответсвующими ему параметрами (а то получается эти стили из чертежа в черчеж по всему городу таскается)
4. После проведения процедуры все ненужные стили удаляются


Важно:
Сам лисп должен менять стиль, т.е. текст, толщину, наклон, но не должен менять высоту букв.(и размеров это тоже касается, а вот засечки беруться из моего стиля)

PS Если такое возможно, буду ждать ответа, а если не целесообразно то буду ждать аргументов..

заранее спасибо..

[VVA]

Это работает так:
1. CTS приводит все текстовые примитивы к вабранному тобой стилю.
2. TSUP синхронихзирует тексты с выбранным или выбранными (почитай внимательно диалог) стилями., т.е. назначает текстам угол наклона и степень сжатия-растяжения как в стиле, которым они в данный момент написаны.
Толщину задавай весом линии, к этой теме она отношения не имеет.
Высота остается такой как и была.
Лисп стиль не меняет, а берет из него данные (угол наклона и сжатие/растяжение)
Поэтому в твоем случае
1. Создаешь или выбираешь из существующих стиль, который оставишь
2. Выставляешь в этом стиле нужный шрифт, угол наклона и степень сжатия/растяжения
3. CTS (или CTSU) - всем текстам назначается твой стиль
4. TSUP - синхронизирует тексты и описание стиля.
5. PURGE (можно purge выполнить после п. 3.)

[dextron3]

VVA, о то что надо, как и хотел, спасибо!

можно у вас макрос теперь на кнопку попросить, с 3 го по 5й пункт, шоб сразу процесс автоматом шел...

[VVA]

Обновил #1

[dextron3]

VVA, не работает максрос чтото делает непонятное и хде в макросе TSUP

[dextron3]

Код:

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

^C^C(if (null C:CTS)(load "Lisp/CTSU.lsp")) CTS;TSUP;-Purge;a;;n;-Purge;a;;n;-Purge;a;;n

вот мои наброски

[dextron3]

вот кстати принесли чертеж электрики, куча стилей

[VVA]

Код:

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

(if (null C:CTS)(load "change text styles (cts)"));CTS;(cts:layer-status-save);(ru-textstyle-update "*");_.-PURGE;_ALL;*;_No

[dextron3]

Offtop: VVA, TSUP так и не увидел

[gest]

Удалено.

[K_R_H]

VVA,
И все таки хочется чтобы команд CSTU давла возможность поменять вес линий.
Т.е у меня файл в котором очень много маркировок в виде блоков с атрибутами. Можно ли одним махом попенять свойства текста в атрибутах (в частности вес линий).

[VVA]

K_R_H, Давай отделять мух от котлет. Эти команды изменяют начертание текста, зависящее от стиля.
У тебя вопрос по правильной организации блока или приведении существующих блоков к правильной организации. (Наследование цвета, типа линии, веса линии). Тебе скорее всего сюда
LISP. Нормализация блоков текущего файла.

[dextron3]

VVA, у меня в файле в одном тексте наклон не убирается чего только не делал,

[VVA]

файл где?

[dextron3]

VVA, Вы от меня вчера файл получили с лайаутами? или не дошел?

[dextron3]

Вот файло основное подчеркнул...

[VVA]

dextron3, Файл получил, пока нет времени посмотреть.
Если это текст "1. Разрез 1-1 см.л.7." то в команде _style выбери стиль DIM1, задай угол 0 и выполни команду TSUP

[dextron3]

VVA, так лисп должен заменить размер DIM1, моим выбранным, а потом зайдествовать из моего стиля настройки, а там прямые буковки то,
мне потом еще приходится кисточкой дорабатывать,

но вопрос волнует почему все остальные тексты то меняются а вот эти нет...?

[VVA]

dextron3, У меня так и делает. CTS - меняю стиль (на SPDS), TSUP - причесываю тексты как в стиле. Попробуй скачай файл заново, может у тебя старая версия?

[dextron3]

VVA, СПАСИБО!
действительно у меня была старая версия, странно всегда следил за обновлениями

[dextron3]

dextron3, опять вопрос почему размерные стили не меняет, по идеи после отработки лиспа должен быть один стиль текста и один размерный стиль а этого не получается, буду рад ответу...

[dextron3]

вот после использования лиспа стали размерные стили вообще сос трелками что то не могу сообразить вроде было нормально а куда все подевалось...

Мой размер синий

[dextron3]

VVA, Еще БАГ нашел в лиспе, меняет текстовый стиль именно в том лайауте который на данный момент активен, в других же не меняет, попробуйте в том файле который я вам отправил, наделать лайаутов и применить лисп....

[dextron3]

Вот ролик для достоверности:

[VVA]

Беру паузу до среды (8 октября), т.к. еду в командировку.

[dextron3]

VVA, буду бездельничать до 9 октября тогда

[Builder_Drew]

хватит бездельничать! :-) подскажите, есть ли решение как заставить у всех размерных стилей, а также у объектов spdsGrid сменить текстовый стиль на заданный?

[VVA]

Builder_Drew, Предлагаю научный метод: метод тыка. Создай несколько текстовых стилей, несколько размерных стилей и попробуй CTS. Посмотри на результат, сделай выводы.
Если spdsGrid обладает свойством TextStyle, то должет поменяться. Поможет опять таки научный метод.

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

Работа с объектами СПДС из-под лиспа по меньшей мере затруднительна.

[VVA]

Добавлена обработка форматирования МТЕКСТОВ для Автокада с 2008 версии (выравнивание влево, вправо, посередине, по ширине, распределенное)

[dextron3]

VVA, поясните на видеоролике для чего нужно выравнивание если выполняется все по стилю с теми настройками текста которые он имел до использования макроса

[VVA]

Выравнивание - это просто дополнительные коды форматирования, которые появились в 2008 Автокаде. И их нужно обрабатывать, что и было добавлено в ф-цию, снимающую форматирование.

[getr]

Что то нехочет работать TSUP..автокад выдает следующее-

Command: TSUP
_vbastmt
Expression: ThisDrawing.SetVariable "USERI1", MsgBox ("
Производится изменение начертания всех существующих
ТЕКСТОВ, АТРИБУТОВ
во ВСЕХ примитивах, включая блоки,
выбранного стиля!

Устанавливается по определению стиля
начертание, сжатие, угол наклона
Пользоваться осторожно!
Будем делать?",4,"ИЗМЕНЕНИЕ СТИЛЕЙ!!!!")
Syntax Error

Работаю на Автокад 2005(eng).

[Builder_Drew]

Коллеги, имеется ли возможность деформатирования не всех текстовых стилей? то есть делать исключение для некоторых постоянно заданных стилей и не трогать их?

[VVA]

Имеется, но нужно править код

[getr]

Так что же там за Syntax Error такой,может кто-нибудь прояснить ситуацию?

[VVA]

getr, Потерпи немного, разгребусь, переделаю на dcl окно.
Пока как временная замена TSUP

Код:

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

(defun C:TSUP1 ( / *error* ret )
  (defun *error* (msg)(princ msg)(cts:layer-status-restore)(princ))
  (cts:layer-status-save)
  (initget "Да Нет Yes No _ Yes No Yes No")
  (setq ret (getkword "\nБудем обновлять? [Да/Нет] <Да>:"))
  (if (or (null ret)(= ret "Yes"))
  (progn
    (foreach style (_DWGRU-GET-USER-DCL (if (= (getvar "DWGCODEPAGE") "ANSI_1251") "Выберите стиль" "Select style") (vl-remove "" (ACAD_STRLSORT(tablelist "STYLE"))) t)
      (ru-textstyle-update style)
       ) ;_ end of foreach
    )
  )
  (cts:layer-status-restore)
  (princ)
  )

Можешь добавить эту команду в лисп из#1 и пока вызывать ее. Запрос будет идти в командной строке.

[getr]

Хорошо,подождем...просто вопрос как то висел в воздухе.

[VVA]

Сообщение от getr Хорошо,подождем...просто вопрос как то висел в воздухе.

Еще ждешь? Обновил #1

[getr]

Ага ...жду,пока работаю по варианту как ты советовал выше.
После запуска обновленного лиспа автокад выдал-
no function definition: VECTOR_LINE
Опять незадача...

[VVA]

getr, Вечная проблема с библиотечными функциями. Исправил #1

[getr]

А вот теперь все океюшки...Спасибо.

[Volodich]

Странно, а у меня вылезает такая вот ошибка:

Команда: (ru-textstyle-update "*") Ждите, привожу стиль '*' к определению... ; ошибка: неверный тип аргумента: lentityp nil

И со стилем ничего не делается...

Может быть потому что автокад 2006 рус?

[VVA]

Volodich, Выложи или скинь файл на почту. Со стилем в ru-textstyle-update ничего делаться и не будет.Тексты будут приводиться к установкам стиля. Почитай про TSUP и чуть ниже в #1

[dextron3]

VVA, А существует лисп который Мульти тексты превращает в обычные тексты?

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

Ага. _explode называется.

[dextron3]

Кулик Алексей aka kpblc, это опасно можно взорвать лишнего, я вот подумал, может в этот лисп интегрировать опцию такую, чтобы работала только с м-текстами, опционально, а то существуют люди которые до сих пор пользуются м-текстами

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

Ага, а _qselect придуман просто так, получается?

[dextron3]

Кулик Алексей aka kpblc, так когда взрываешь м-тексты ведут себя не адекватно, утолщаются расширяются, глаз до глаз нужен...

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

А что ж ты хочешь-то, для принудительно сформатированного текста такое и будет!

[Romanich]

dextron3,

а то существуют люди которые до сих пор пользуются м-текстами

И будут пользоваться, потому что м-текст это мегаудобная вещь.

[DEM]

Romanich
Все удобства на прочь убивают его недостатки.

[dextron3]

Кулик Алексей aka kpblc,
Алгоритм лиспа:
1. Выбираются все м-тексты
2. Взрываются
3. Опять выбираются
4. Дальше обрабатываются существующим лиспом

вот так как то...
буду рад за помощь может максросом тут получиться обойтись..

[Hans667]

VVA в первом посте CSTU поправь на правильный.А то сбивает с упти истинного. Не понимаю чем CTS отличается от замены стиля у всех объектов сразу в панели свойств

[VVA]

А что в CSTU не правильного?

Не понимаю чем CTS отличается от замены стиля у всех объектов сразу в панели свойств

А тем, что меняет стили у ВСЕХ примитивов (в том числе в блоках, атрибутах, размерах, а так же на всех листах. Короче по всей базе чертежа)

[Hans667]

ну CTSU наверно а не CSTU. Иначе выдает что команда не известная

[VVA]

Исправил

[wetr]

VVA, очередной МЕГА РЕСПЕКТИЩЕ!!!
Вот что значит человек занимается своим делом.

[Sleekka]

Есть рац предложения:
функцию:

Код:

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

;Extensions:
;It is possible to add bulged segments too by extending the data structure "segment" with (p1 p2 bulge) for curved segments and use a line-arc resp. arc-arc intersection method for those. Then a straight segment is still representable with (p1 p2) 
;line-arc and arc-arc intersection methods are e.g. in GLNADS.C of the AutoCAD SDK 2.0 and may be easily ported to AutoLISP. Another method is with VLA where it is possible to use (vla-intersect-with obj1 obj2), which works with curves and splines too. 
;;Posted by T.Willey 
;;http://www.theswamp.org/index.php?topic=14247.15
;;Обработка всех примитивов рисунка через VLA
;; Doc - vla указатель на обрабатываемый документ
;; StyName - имя стиля
;; Unformat t - снос форматирования nil - нет
(defun ChangeAllTextObjectsStyle (Doc StyName Unformat / tempObjType IsLo ColCnt RowCnt)
(vlax-for Blk (vla-get-Blocks Doc)
 (setq IsLo (if (= (vla-get-IsLayout Blk) :vlax-true) T nil))
 (if (= (vla-get-IsXref Blk) :vlax-false)
  (vlax-for Obj Blk (setq tempObjType (vla-get-ObjectName Obj))
   (if (and Unformat (vlax-property-available-p Obj 'Textstring))
     (vla-put-Textstring Obj (substr (apply 'strcat (mapcar '(lambda(x)(strcat "\\P" x))
     (mapcar 'mip_MTEXT_Unformat (str-str-lst (vla-get-Textstring Obj) "\\P")))) 3)))
   (cond
    ((vl-position tempObjType '("AcDbText" "AcDbMText" "AcDbAttributeDefinition"))
     (vla-put-StyleName Obj StyName)(if (not IsLo)(vla-put-Layer Obj "0")))
    ((wcmatch tempObjType "AcDb*Dimension")(vla-put-TextStyle Obj StyName))
    ((= tempObjType "AcDbBlockReference")
     (foreach Att (vlax-invoke Obj 'GetAttributes)
      (vla-put-StyleName Att StyName))
     (foreach Att (vlax-invoke Obj 'GetConstantAttributes)
      (vla-put-StyleName Att StyName)))
    ((= tempObjType "AcDbTable")(setq ColCnt 0)
     (repeat (vla-get-Columns Obj)(setq RowCnt 0)
      (repeat (vla-get-Rows Obj)(vlax-invoke Obj 'SetCellTextStyle RowCnt ColCnt StyName)
       (setq RowCnt (1+ RowCnt)))
      (setq ColCnt (1+ ColCnt)))))))))

Поменять на:

Код:

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

;Extensions:
;It is possible to add bulged segments too by extending the data structure "segment" with (p1 p2 bulge) for curved segments and use a line-arc resp. arc-arc intersection method for those. Then a straight segment is still representable with (p1 p2) 
;line-arc and arc-arc intersection methods are e.g. in GLNADS.C of the AutoCAD SDK 2.0 and may be easily ported to AutoLISP. Another method is with VLA where it is possible to use (vla-intersect-with obj1 obj2), which works with curves and splines too. 
;;Posted by T.Willey 
;;http://www.theswamp.org/index.php?topic=14247.15
;;Modify by Sleekka
;;Обработка всех примитивов рисунка через VLA
;; Doc - vla указатель на обрабатываемый документ
;; StyName - имя стиля
;; Unformat t - снос форматирования nil - нет
(defun ChangeAllTextObjectsStyle (Doc StyName Unformat / tempObjType IsLo ColCnt RowCnt)
(vlax-for Blk (vla-get-Blocks Doc)
 (setq IsLo (if (= (vla-get-IsLayout Blk) :vlax-true) T nil))
 (if
   ;start the initial code
	;(= (vla-get-IsXref Blk) :vlax-false) 
   ;end the initial code

   
   ;;start added by Sleekka
   (and
       (= (vla-get-IsXref Blk) :vlax-false)
	(not (wcmatch (_dwgru-property-get blk 'name) "*|*")) 
       )
      ;;end added by Sleekka
  (vlax-for Obj Blk (setq tempObjType (vla-get-ObjectName Obj))
   (if (and Unformat (vlax-property-available-p Obj 'Textstring))
     (vla-put-Textstring Obj (substr (apply 'strcat (mapcar '(lambda(x)(strcat "\\P" x))
     (mapcar 'mip_MTEXT_Unformat (str-str-lst (vla-get-Textstring Obj) "\\P")))) 3)))
   (cond
    ((vl-position tempObjType '("AcDbText" "AcDbMText" "AcDbAttributeDefinition"))
     (vla-put-StyleName Obj StyName)(if (not IsLo)(vla-put-Layer Obj "0")))
    ((wcmatch tempObjType "AcDb*Dimension")(vla-put-TextStyle Obj StyName))
    ((= tempObjType "AcDbBlockReference")
     (foreach Att (vlax-invoke Obj 'GetAttributes)
      (vla-put-StyleName Att StyName))
     (foreach Att (vlax-invoke Obj 'GetConstantAttributes)
      (vla-put-StyleName Att StyName)))
    ((= tempObjType "AcDbTable")(setq ColCnt 0)
     (repeat (vla-get-Columns Obj)(setq RowCnt 0)
      (repeat (vla-get-Rows Obj)(vlax-invoke Obj 'SetCellTextStyle RowCnt ColCnt StyName)
       (setq RowCnt (1+ RowCnt)))
      (setq ColCnt (1+ ColCnt)))))))))

ну и закинуть туды функцию _dwgru-property-get
Потому что если в обрабатываемом чертеже есть внешние ссылки а у ссылок есть блоки у которых есть атрибуты, мтексты и тд, то поменять стили таких атрибутов нельзя и программа возвращает ошибку, хотя конечно посещают мысли что проще все в vl-catch-all_apply оборачивать.

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

Еще один вариант фильтрации внешних ссылок:

Код:

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

(defun is-ent-xref (ent)
                          ;|
*    Функция проверяет, является ли переданный указатель внешней ссылкой
*    ent	указатель на проверяемый примитив
|;
  (if (setq ent (cond
                  ((= (type ent) 'vla-object) ent)
                  ((= (type ent) 'ename) (vlax-ename->vla-object ent))
                  ) ;_ end of cond
            ) ;_ end of setq
    (or (and (vlax-property-available-p ent 'isxref)
             (equal (vla-get-isxref ent) :vlax-true)
             ) ;_ end of and
        (and (= (vla-get-objectname ent "AcDbBlockReference")
                (vlax-property-available-p ent 'path)
                ) ;_ end of =
             ) ;_ end of and
        ) ;_ end of or
    ) ;_ end of if
  ) ;_ end of defun

[Sleekka]

Алексей, вариант, не плохой, но я говорил не об этом.
Дело в том что блоки находящиеся внутри внешней ссылки, светят в текущем чертеже с именами примерно такими: Чертеж1(вертикальная палочка)Блок1. Дак вот эти блоки на isXref возвращают nil, и рассматриваются как блоки текущего чертежа, но у этих блоков нельзя изменить ни одного свойства.

[VVA]

Добавил в #1 версию 1.3. Толком еще не тестировал, поэтому пока не убрил 1.2.
Помимо НЕ обработки блоков и текстовых стилей внешних ссылок добавил еще один запрос на игнорируемые стили (т.е. те, трогать которые не нужно). Если нужно причесать все стили, в 1-м запросе жмем отмена.
> Кулик Алексей aka kpblc По поводу еще одного варианта фильтрации всего, что приходит от внешних ссылок. Я использую snvalid. Имена с символом "|" она не пропускает.
Отсечь текстовые стили внешних ссылок : (vl-remove-if-not '(lambda(x)(snvalid x))(tablelist "STYLE"))
Отсечь слои внешних ссылок : (vl-remove-if-not '(lambda(x)(snvalid x))(tablelist "LAYER"))
ну и так далее

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

Скажу честно - код сейчас смотреть и по-нормальному расковыривать нет времени, поэтому практически оффтоп: просто я сначала запрашиваю все обрабатываемые элементы, из них исключаю внешние ссылки. Потом, если попались блоки, по "внутренностям" блоков опять же с исключением внешних ссылок, вставленных в блок. Добавляя полученный состав к общему списку. Ну и так далее, чистой рекурсией.
P.S. У меня в 2008-м удавалось "поиграться" с составом внешних ссылок текущего документа, и даже что-то там я менял Но это до первой перезагрузки ссылок Потом я просто вставил фильтрацию и подобные извращения прекратились.

[Sleekka]

в 1.3 ошибка
в команде C:CTSU

Код:

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

(ChangeAllTextObjectsStyle (vla-get-activedocument (vlax-get-acad-object)) st t))

передается 3 аргумента а требуется 4.

[VVA]

в 1.3 ошибка в команде C:CTSU

Исправил версию 1.3. Обновил пост #1

[timer]

Кто-нибудь пробовал такой лисп написать и к размерным стилям?

[Sleekka]

там не нужно...

[timer]

Почему не нужно? Было бы неплохо.

[Sleekka]

Изучи стандартные средства автокада - там их достаточно...

[Hans667]

а ширину МТекста сразу на всех примитивах убить не удастся?или обнулить допустим.

[VVA]

Hans667, Это подойдет? Взято здесь

Код:

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

;; Author unknown, modifications by CAB
;;
;;;********************************************************************; 
;;; Change Mtext width                                                 ; 
;;;--------------------------------------------------------------------; 
;;; This function will allow you to change the Mtext width of selected ; 
;;; text. I use this to help in my drafting duties. I hate having to   ; 
;;; do things repetitavly, so this helps me eliaviate some of that.    ; 
;;;********************************************************************; 
(defun C:ChangeTW (/ Obj-list Obj NewWidth ssget->vla-list)
  (vl-load-com)
  ;;===================================================================; 
  ;; SSGET->VLA-LIST                                                   ; 
  ;;-------------------------------------------------------------------; 
  (defun ssget->vla-list (selection-set / index vla-list)
    (setq index (if selection-set (1- (sslength selection-set)) -1))
    (while (>= index 0)
      (setq vla-list (cons (vlax-ename->vla-object
                             (ssname selection-set index)) vla-list)
            index    (1- index)
      )
    )
    vla-list
  )
;;;===================================================================; 

  (vla-StartUndoMark (vla-Get-ActiveDocument (vlax-Get-Acad-Object)))
  (setq Obj-list (ssget->vla-list (ssget '((0 . "MTEXT")))))
  (setq NewWidth (getdist ">>:Enter new Mtext width: "))
  (mapcar
    '(lambda (obj)
       (if (vlax-property-available-p Obj 'Width)
         (vlax-put-property Obj 'Width NewWidth)
         (vlax-Release-Object Obj)
       )
     )
    Obj-list
  )
  (prompt "\>>:Objects Changed, program complete.")
  (vla-EndUndoMark (vla-Get-ActiveDocument (vlax-Get-Acad-Object)))
  (princ)
)
(prompt "\n***  Mtext width change loaded, Enter ChangeTW to run.  ***")
(princ)

[Hans667]

так это надо в код добавить или отделиным лиспом?

[VVA]

Можно и так и так. Как больше нравится

[Рyslan]

Всем привет. Такой вопрос. Работаем с иностранцами, у них под автокад есть свой профиль, там блоки слои много чего. Русский текст печатается с английской раскладкой. когда чертеж открываешь в их профиле все нормально, текст читается, но он был только под 2006 акад. а в русском 2008 вместо русского текста абракадабра из латинских букв. может есть какие то методы борьбы с этим? text- ntrcn, а должно быть текст

[VVA]

Рyslan,
1. Профиль можно экспортировать/ импортировать
2. Твой вариант похож на этот

Чтобы не создавать тему: возможен-ли лисп (а может, уже где-то есть) для перевода текста с английской раскладки клавиатуры на русскую. Т.е. имеется куча файлов, в которых как-бы набирали по-русски текст, забыв переключить язык.

Решение в посте #10

[Рyslan]

я пробовал экспортировать, пока не получается. за лисп спасибо, буду пробовать

[vovan981]

Всем привет. У меня проблема со шрифтом, много говорить не буду, кидаю файл и скриншоты в формате .doc. Верхний файл с ужирненным текстом, как справиться с этой проблемой?

[wetr]

VVA, после "утюжки" файла с помощью CTSU местами не стираются куски из форматирования. И если до проходки элементы форматирования не видны, то после - становятся видны.
Прикладываю проблемный файл с мультитекстом.

[VVA]

Обновил версию 1.3 Не помню, для чего оставил 1.2 Наверное нужно удалить?

[wetr]

VVA, спасибо! В понедельник буду массированно тестировать!

[VVA]

Чтобы в понедельник не было скучно добавил в #1 StripMtext v5

[dextron3]

VVA, поясните для чего новый лисп в двух словах, а то я пропустил все...(

[VVA]

Ну так вроде на картинке все показано. В двух словах StripMtext так же убирает форматирование мтекста, но можно выбирать какой тип форматирования убирать.

[Valery Brelovsky]

Я как то опоздал к раздаче. И имеется несколько вопросов. Первый вопрос работает ли Лисп в 2000. И чем отличаются файлы 1,2 и1,3.

[VVA]

Valery Brelovsky, Никаких специальных мер, чтобы он не работал в 2000 не предпринималось. Проще всего попробовать. По поводу версий я написал в #89. Наверное версию 1.2 нужно удалить.

*** Добавлено. Про версию 1.2 нашел ответ в #72

[Valery Brelovsky]

Но почему то вчера на работе не сработал в 2000. Делал глобальную замену всех стилей на один и результат нулевой. Вечером выложу файл на котором пробовал.

" CTS - замена текстовых стилей у всех объектов на выбранный
CSTU - замена текстовых стилей у всех объектов на выбранный с деформатирование мтексов
TSUP - изменение начертания всех существующих ТЕКСТОВ, АТРИБУТОВ во ВСЕХ примитивах, включая блоки, выбранного стиля.
Устанавливается по определению стиля начертание, сжатие, угол наклона"

Перечитал форум и понял что не правильно использовал Лисп. Посчитал что CTS не изменяет тексты атрибутов и использовал TSUP. Соответственно результат был нулевой. Т.е. CTS он меняет стили в блоках и атрибутах?

[VVA]

Сообщение от Valery Brelovsky Т.е. CTS он меняет стили в блоках и атрибутах?

Должен менять стиль везде (в модели, листе, описании блока) и во всем, что его (стиль) имеет в своих свойствах: тексты, мтексты, атрибуты, определения атрибутов, размеры, таблицы.

[Valery Brelovsky]

Спасибо. Уже вроде разобрался.

[Voltos]

А у меня выходит следующее, что не так?
http://forum.dwg.ru/attachment.php?a...1&d=1267589625

[VVA]

по картинке мне, например, не понятно в чем проблема. Лучше приложи файлик посмотреть

[wetr]

VVA, TSUP обрабатывает примитывы только на текущем листе. Приходится запускать ее на каждом

[VVA]

wetr, Обновил до версии 1.4

[wetr]

VVA, спасибо!

[Voltos]

VVA, все просто, файл получен из другого источника, существующий Мтекст частично правился. Скажем А512 изменили на А552, и после смены стиля получаем А552 тость правленная часть текста не форматируется в группе, только в редакторе Мтекста повторным применением того же стиля. Вот так.

[VVA]

Пример ввиде dwg в студию

[Voltos]

StripMtext v5-0b.lsp работает, спасибо, архиполезная весчь!

[VVA]

Voltos, Что-то я не понял в чем проблема. Для смены форматирования MTEXT'а нужно применять не CTS, а CTSU

[Voltos]

Спасибо, уже разобрался

[Chapter]

Вот чертеж. Нужно заменить стиль STANDARD на Основной 2.5-1, который уже добавлен в чертеж. Это у меня не получается сделать CTS, CTSU.

Это проблема чертежа? или как то можно подправить код? Помогите пожалуйста.

Если перевести из STANDARD в аннотатив, а потом из аннотатив в Основной, то нормально. А если из STANDARD в Основной то что то не получается вот.

[acyxou]

после выполнения команды CTSU на первый взгляд все вроде сработало, но если выбрать любую ячейку таблицы, то все форматирование в ячейках снова становится прежним, т.е. таким, каким было до выполнения команды CTSU. С программой StripMText такого замечено не было.

[VVA]

acyxou, файл покажи

[acyxou]

Обычный файл, созданный через "Open with no template - Metric".

[Wer666]

Извините люди за мою безграмотность, но прочитав все посты данной темы - я так и не понял как поменять текст в выноске спдс((( Обычный текст заменяется, а вот в выносках нет( Подскажите пошагово что нужно сделать что бы поменять текст и в выносках тоже????
Заранее Всем Спасибо!)

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

Объекты СПДС подчиняются своим законам... Там надо использовать отдельные функции, мало связанные со стандартными объектами

[Wer666]

Т.е. никак???((((

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

На данный момент - никак. В зависимости от версии СПДС поведение и программное представление может быть различным.

[Vildar]

Подскажите, а стаблицами она как поступает?
Запустил cts, 15 минут жду, пока акад не отвечает.

[VVA]

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

[Vildar]

Таблицу экспортнул из офиса, теперь в о всех ячейках шрифт colibri, от него нужно избавиться. Т.е. нужно зайти во все ячейки и назначить стиль принудительно иначе никак не меняется.

Файл не очень секретный, можно я его по почте сброшу. Написал письмо об этом.
Буду ждать. Спасибо.

[pan]

Сообщение от Wer666 Как изменить текст в выноске спдс? Извините люди за мою безграмотность, но прочитав все посты данной темы - я так и не понял как поменять текст в выноске спдс((( Обычный текст заменяется, а вот в выносках нет( Подскажите пошагово что нужно сделать что бы поменять текст и в выносках тоже???? Заранее Всем Спасибо!)

СПДС-Настройка:

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

VVA, вспомни про регенерацию таблиц. Сам же на нее мне указывал в свое время ))

[Farest-1]

Всё замечательно всё работает
Но есть одно но.
Например есть чертёж (как у всех он поделён на разные стили текстов)
где-то размерный, основной, текстовый и так далее, понимаю что нужно выбирать в игнорируемые эти стили.
Вот попал текстовый стиль зараза и не удаляется сидит где то в блоках или атрибутах пришлось во всём чертеже заменять на 1-н стиль.
Если возможность замены стиля в выбранных (то есть выбираем область и заменяем на выбранный стиль).
В области могут попадаться блоки и атрибуты .

[Kyxa]

Подкажите в чем причина. Lisp-ом только начинаю пользоваться, похоже чего-то не понимаю... (((
Вопрос #53, такая же песня (но я что-то не нашёл конкретного ответа):

Команда: (ru-textstyle-update "*")
Ждите, привожу стиль
'*' к определению...
; ошибка: неверный тип аргумента: lentityp nil

[VVA]

Kyxa, Нужно использовать команды (CTS CTSU TSUP ) Как - смотри ссылку в моей подписи

[Kyxa]

VVA
Это понятно...
Команда CTS: всплывает окно с выбором стилей, выбираю ненужные (несколько), далее окно со стилем назначения (там остаётся один), двойной щелчок по нему. Всё. Далее _purge. Ничего не меняется. А ошибку выдает, только если макросом пользоваться.

[VVA]

Сообщение от Kyxa далее окно со стилем назначения (там остаётся один)

Ну так у тебя ничено не будет. Оставшиеся в этом окне стили приведутся к выбранному

[Kyxa]

VVA
Всё спасибо! Разобрался!

[Vombat]

Здравствуйте
Подскажите, пожалуйста, как можно избавится от непонятных символов после применения «LISP. Замена текстового стиля». Прилагаю фрагмент с проблемным «MTEXT». Такие чертежи приходят регулярно от архитектора и технолога.
Спасибо.

[VVA]

Непонятные символы - это коды форматирования мтекста
Убрать можно так
1. Использовать не CTS, а CTSU
2. Команда UNF-MTEXT
Учти, что наклон мтекста задан форматированием. Ести хочешь выборочно сносить форматирование, то см. StripMtext

[Vombat]

VVA, спасибо Вам огромное.
Сегодня все получилось за первым разом, а вчера пол дня возился, результата не было (см. скин №2), загадка какая-то...
Спасибо

[seregas]

StripMtext не удаляет высоту текста, оставляет две установки высоты. Как от этого избавится ? И еще не понятно -- при удалении всего форматирования какие параметры он принимает за базовые ?

Может какая новая вверсия есть, кроме той, что в шапке -- на их форуме надо ждать подтверждение регистрации админом. Странный у них форум, наверное, он мои отпечатки по базе проверяет

[VVA]

На форуме последняя версия StripMtext 5-0c, как и здесь. Для удаление всего форматирования можно попробовать UNF-MTEXT или UnFormat String

[Nata1]

Уважаемый VVA, я сохранила код StripMtext 5-0 из поста #1, но у меня вместо букв иероглифы. Это неправильно? Как вернуть буквы?

О, получилось исправить. Сохранила не в Блокноте, а WordPad. Теперь нормальный текст в лиспе.

[Yuzer]

VVA, после использования лиспа (Замена текстового стиля+CTS) все равно остаются текстовые стили в списке текстовых стилей. Найти я их не могу (ни в атрибутах, ни в тТексте, ни в МТексте). Как это можно вылечить?

[VVA]

файл покажи

[Yuzer]

Самфайл. Он немного зависает....

[VVA]

Имя текстового стиля?

[Yuzer]

Нужно, чтобы все было Текст.

[Tayfun-astana]

Добрый день, сорри за вопрос от чайника: а возможно настроить акад так чтобы при открытии чертежа все шрифты во всех стилях были isocpeur. А их высота. наклон и т.д. оставались прежними ? или как настроить так ... чтобы если открываетя чертеж с неизвестыми шрифтам (всмысле нету в папке фонтс) то они заменялись тоже на isocpeur?

[KSI]

Tayfun-astana, а не смущает, что при замене шрифтов все тексты могут "поплыть"? Ведь в разных шрифтах ширина одного и того же символа может отличаться (при одинаковой высоте текста).
А подмена недостающего шрифта прописана переменной FONTALT, или в "Настройке" на закладке "Файлы" искать "Файл альтернативного шрифта".

[Shoorup]

А как бы еще сделать поправку на определенное значение после замены текстового стиля?
Подробнее:
например имеется "стиль1" и вставленные в чертеж тексты с разными коэффициентами сжатия (КСЖ). 0.8 ; 0.765 ; 0.95 и т.д. естественно и с разной высотой текста и др. свойствами.
и имеется "стиль2" под который нужно все перегнать, НО вдобавок ко всем КСЖ прибавить поправку 0.2. Т.е. был текст с КСЖ 0.8 стал 1.0. был 0.765 стал 0.965 и т.д.

[sertor]

Доброго времени суток. Уважаемые форумчане, возник вопрос такого плана. Прислан чертеж от субподрядчика. При использовании вышеописанной программы выполнил очистку форматирования Мтекста и замену текстового стиля. Но, как оказалось, полностью решить вопрос не удалось. В чертеже остались символы "№" с начертанием стиля автора чертежа. Может быть в используемом шрифте отсутствует "№"? Но тогда как сделать замену этой части текста? Программа AutoCAD Civil3D 2012 SP2. Спасибо.

[Киренга]

Подскажите, пожалуйста, а как выполнить задачу, решаемую командой TSUP, применимо к таблицам?

[sertor]

Ну и в продолжение #142. Возможно ли откорректировать программу (внести дополнение) так, чтобы обрабатывались только однострочные тексты (поскольку некоторые многострочные "ломаются")? И еще такой момент. В предыдущих постах поднимался вопрос об автоматической загрузке стиля текста при открытии "чужого" чертежа. Так вот, к чему я веду. Может быть есть такая возможность заложить в самой программе указание стиля текста и шрифта по умолчанию и замену непосредственно при открытии чертежа "со стороны"? (это конечно в идеале). В нашей организации, (я думаю и не только) используют один стиль текста с одной высотой и начертанием (в пространстве модели). Спасибо.

[VVA]

Нужно подумать. Пока у меня нет времени. Где-то числа 17.06 планирую, что появится немного больше свободного времени, гляну что можно сделать

[VVA]

Сообщение от sertor При использовании вышеописанной программы выполнил очистку форматирования Мтекста и замену текстового стиля. Но, как оказалось, полностью решить вопрос не удалось. В чертеже остались символы "№" с начертанием стиля автора чертежа. Может быть в используемом шрифте отсутствует "№"?

В шрифте simplex.shx отсутствует символ №.

Сообщение от sertor Но тогда как сделать замену этой части текста?

1. Использовать шрифт с символом №
2. перед очисткой форматирования и заменой текстового стиля набрать в командной строке _find Заменить № на N

[mechos]

Заголовок окна во всех командах читается некорректно (видимо проблема с кодировкой)

Это Windows 8 rus (русифицированная), чистая, без каких-либо надстроек и твикеров, AutoCAD 2013 x64 английский, так же абсолютно чистый.

Что там написано разобрался, заглянув в lsp файл. Просто довожу до сведения обнаруженную неприятность

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

mechos, AutoCAD, поди, английский?

[mechos]

Сообщение от Кулик Алексей aka kpblc mechos, AutoCAD, поди, английский?

Да ! Это нормально для него ? До этого работал со сторонними скриптами только на английском, соответственно, такая проблема возникла первый раз.

[VVA]

Сообщение от mechos Да ! Это нормально для него ?

AutoCad 2013 En, проблемы с кодировкой в программах
Похоже что пока нормально, к сожалению.

[alldmc]

Выполнил форматирование текста, но некоторый текст остался жирным, а некоторый отформатировался нормально, хотя стиль у всех одинаковым стал. Как убрать жирный текст?

[Nike]

alldmc, координату Z у жирных текстов обнули

[lemurz9]

Добрый день!
Подскажите, пожалуйста, возник вопрос по этой программке:
воспользовалась командой _TSUP, предварительно задав для своего тестового стиля наклон 15 и коэф-т сжатия 0,8. В результате, угол наклона применился ко всем текстовым объектам, а сжатие нет. В чем может быть дело?
Если открыть этот мтекст и просто выбрать тот же самый текстовый стиль, то сжатие срабатывает. Но не открывать же их все. Файлик прилагается.

[pentaone]

Добрый день, скажите а данная программа не заменяет текстовый стиль у мультивыноски?

[VVA]

Сообщение от pentaone Добрый день, скажите а данная программа не заменяет текстовый стиль у мультивыноски?

Уже заменяет. Обновил до версии 1.7 Правда пока только в командах CTS и CTSU

[zvyagaaa]

А можно сделать, чтобы и в настройках размерных стилей тоже менялся текстовый стиль?

[kifa]

Добрый день! А форматирование в многострочных атрибутах, как я понимаю, это лисп не обрабатывает?

[VVA]

kifa, Поподробнее. Какая именно команда. Желательно приложить dwg c примером

[kifa]

TSUP вот это командой пробовал.
http://forum.dwg.ru/showpost.php?p=1...&postcount=211 вот в этой теме боролся с глюком.
в итоге заменил шрифт и вычистил все руками. Почему то не убрать форматирование было с помощью команды

[Alexander88]

CTS -CTSU - TSUP - purge - CTS -CTSU - TSUP - purge - как было 30 стилей, так и осталось...Как они не удалялись, так и не удаляются....

[VVA]

Alexander88,
1. Файл где?
2. Не факт что они должны удалиться. Например - прокси объеты Там речь идет про блоки и типы линий, но это справедливо и для текстовых стилей
3. Поэтому файл где?

[Alexander88]

Файл в два раз больше допустимого, архитектура не автокаде сделана...REMOVEALLPROXY не особо помогло, больше помогли overkill, aectocad.

[Alexander88]

Прошелся еще раз по прокси - не хотят удаляться...

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

Alexander88, во-первых, в файле полно ошибок. Во-вторых, в файле есть следы СПДС GraphiCS. В третьих, после нормальной очистки файл "худеет" в полтора раза

[Alexander88]

Проверял

Код:

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

Команда: _audit
Исправить все обнаруженные ошибки? [Да/Нет] <Н>: Д
Проверка заголовка
Проверка таблиц
Проверка объектов, проход 1
Проход 1: проверено объектов: 131000
Проверка объектов, проход 2
Проход 2: проверено объектов: 131000
Проверка блоков
 Проверено блоков: 332
Проверка AcDsRecords
Всего найдено ошибок: 0, исправлено: 0
Стерто 0 объектов

Выполнял все рекомендации (изначально было 40 МБ)
Как Вы еще в 1,5 сжали?
Кстати текстовые стили по-прежнему остались..

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

Если остались - значит, они где-то используются. Учитывая, сколько в файле блоков копирования-вставки, ничего удивительного. Кстати, блоки вида *X тоже надо бы вычищать
А чистил я стандартно...

[Alexander88]

То есть "CTS - замена текстовых стилей у всех объектов на выбранный" - мне не поможет? Нужно ручками работать?

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

Сообщение от Alexander88 То есть "CTS - замена текстовых стилей у всех объектов на выбранный" - мне не поможет? Нужно ручками работать?

Чего не знаю, того не знаю.
P.S. Может быть, толику порядка добавит команда _.attsync

[VVA]

Команда _-wblock с режимом * уменьшила размер на 30%
Команда CTS заменила текстовые стили

[BIKE-off]

Файл экспортирован из Компаса. Весь многострочный текст содержит внутреннее форматирование вида "\H3.5;\W0.965;\Q15;\Q15;\H5.0" и подобное. При использовании команды CTSU (TSUP для блоков и атрибутов) внутреннее форматирование сбрасывается и высота текста берётся из свойств текстового объекта. Значения высоты не совпадают. Приходится всё править руками. Дело осложняется тем, что при экспорте создаётся большое количество блоков, содержащих текст, а туда так просто не доберёшься.

Есть ли возможность быстрого редактирования файла с сохранением значения высоты текста из внутреннего форматирования?
Файл примера прикладываю.

[A.Hillys]

Столкнулся со следующим - для некоторых мультивыносок не сбрасывается форматирование текста, а именно цвет. Для каких-то - сбрасывается.
Чем эти два типа отличаются - не пойму, прилагаю пример и прошу помощи. Сбрасывал как вручную, через контекстное меню в редакторе текста , так и с помощью StripMtext.

[VVA]

Сообщение от A.Hillys Чем эти два типа отличаются - не пойму

Я так же не могу понять в чем разница.
Пока заметил, что если кисточкой ( _matchprop ) наследовать свойства, то он становится нормальным

[A.Hillys]

Да, это я тоже заметил.
Вдруг (возможно, после применения unnormalize (переопределение свойств объектов, здесь же, на форуме, найденном) все мультивыноски в черетеже стали такими, как мы видим.
С другой стороны, в испытуемом файле при применении unnormalize нормальная выноска остается нормальной.

[posetitel]

скажите, существует ли возможность обрабатывать только выделенные объекты с текстом, а не весь текст во всем файле?

[freese]

Сообщение от posetitel скажите, существует ли возможность обрабатывать только выделенные объекты с текстом, а не весь текст во всем файле?

так и работает, после вызова просит выбрать объекты... или у вас иначе?

[posetitel]

иначе. предлагается выбрать игнорируемые стили, про выбор объектов ничего не спрашивают.

[freese]

Сообщение от posetitel иначе. предлагается выбрать игнорируемые стили, про выбор объектов ничего не спрашивают.

а вы пробовали запускать файл StripMtext v5-0c.lsp , а не change text styles

[posetitel]

по демонстрирующей картинке я понял, что эта прога для работы с мультитекстом, причем для мультитекстов сначала надо будет выставить стиль, а потом внутреннее редактирование программа уже приведет к стилю, а у меня в чертежах есть и просто текст и мультитекст.

[freese]

Сообщение от posetitel по демонстрирующей картинке я понял, что эта прога для работы с мультитекстом

правильно поняли, т.к. в автокаде обычно только мтекст имеет еще внутреннее форматирование (это форматирование программа и исправляет), а однострочный текстдостаточно выбрать и выбрать стиль

[posetitel]

вот и хочется, чтобы change text styles (cts) 1.7.LSP мог менять не только сразу весь текст во всем чертеже, но и отдельно в выделенном фрагменте чертежа

[freese]

что вы хотите от change text styles? Чтобы изменить стиль, лиспов не надо, достаточно выбрать фрагмент и выбрать стиль

[VVA]

Сообщение от posetitel существует ли возможность обрабатывать только выделенные объекты с текстом,

Теоретически такая возможность есть. В программе - нет. Как вариант: вырезать выделенные объекты с текстом и вставить в новый файл, обработать CTS, затем вернуть обратно

[posetitel]

freese, change text styles меняет стили и в блоках и на размерах, простым выбором фрагмента и выбором стиля этого не добьешься.
VVA, а планируется ли доработка лиспа до появления такой возможности?

[CHILD_11]

команда TSUP не изменила текст внутри блоков в соответствии с текущим описанием стиля...
если захожу в блок, выбираю МТекст и "изменяю" его стиль вручную (в кавычках написал, потому что на самом-то деле стиль не меняю, просто еще раз выбираю тот же, что и был), то он обновляется в соответствии с новым описанием.
а вот через TSUP - нет.

----- добавлено через 18 сек. -----
2015 автокад

[VVA]

CHILD_11, выложи файл с примером

[CHILD_11]

VVA, поправка информации: команда не меняет даже текст вне блока. Когда запускал команду в прошлый раз, то уже вручную поменял весь внеблоковый МТекст (поэтому не заметил, что не сработало).

Может, дело в том, что текст аннотативный? Файл прикладываю.

[perpetule]

Возможно ли модифицировать UNF-MTEXT для работы в том числе с многострочными атрибутами?

P.S. Для исключения непечатаемых символов форматирования мтекста.

[fillbear]

Подскажите, почему не работает команда StripMtext?
Файл загружается, команда запущена, идет выбор объектов, настройка параметров, а результат выдает ошибку:

Command: _smt
StripMtext v5.0c
Select objects: Specify opposite corner: 4 found

Select objects:

StripMtext Error: bad argument type: VLA-OBJECT nil

Команды файла "change text styles (cts) 1.7.LSP" работают все, включая реактор.
Спасибо.

[nitc]

Спасибо автору, это гениально!

[EVgen2015]

Здравствуйте, зашел в тупик при использовании lisp. У меня стоит autocad 2014, при попытке поменять текст с помощью CTSU - загружается lisp, но при этом ничего не меняется. В 2008 все работает. Если нужно могу скинуть файл.

[sertor]

Сообщение от EVgen2015 Если нужно могу скинуть файл.

Приложите файл. Пока это все голословно.

[EVgen2015]

Вот, прошу. Может это проблема 2014?

[kacugu]

Сообщение от EVgen2015 Может это проблема 2014?

Работает нормально и в 2014 и в 2015

[EVgen2015]

Спасибо, значит проблемы у меня.

[LKiNg]

Здравствуйте!
Спасибо за замечательную программку!

Есть одна проблемка - текст неизвестно как был создан - но при применении СTSU диаметры, знак Фи и верхний индекс превращаются в вопросы...

99* - (320 кгс/м\U+00B2);
принят {\Fspds|c0;\U+03B3}n=1,2.
-0,3°С.
78 \U+2205325х8мм, \U+2205159х8мм

Если бы они были сделаны %%d - проблем бы не было... А вот квадратный (верхний индекс 2) - тоже вопросом

[VVA]

LKiNg, Текст нормальный. Проблема известная, у Автодеска никак руки не дойдут пофиксить

20.04.2016 Добавлена функция CTS:GET-TEXTSTRING (как замена vla-get-textstring. Т.к. неверно возвращает строку при наличии юникод символов) http://forums.autodesk.com/t5/visual...s/td-p/4365165

Обновил #1 до версии 1.8

[Tamara_N]

А у меня при применении команд CTSU и UNF-MTEXT в начале деформатированного текста вылезает примерно такая строчка: xl1,sm0.8,t8;
Думала, коды форматирования, посмотрела - вроде не так они выглядят, да и команды эти их убирать должны.
Подскажите, что это и как от него избавиться.

P.S. Strip M-Text попробовала, хорошо работает, никаких лишних символов.

[skkkk]

Tamara_N, прикрепите к посту файл, в котором происходят указанные события. Достаточно оставить в нем только "больные" текстовые объекты до применения команд.
UnFormat String от Lee Mac пробовали?

[Tamara_N]

UnFormat String не пробовала. StripMtext хорошо сработал, но, с одной стороны, change text styles мне кажется очень удобным, а с другой - интересно, в чем все-таки дело))
Файл с текстом прилагается.

[Tamara_N]

А вот так текст выглядит после применения команды UNF-MTEXT

[Genf]

Есть ли решение по замене одного шрифта на другой не открывая файлы (пакетная замена)?

Все файлы созданы на основе единого шаблона с одним текстовым стилем, в котором прописан конкретный шрифт - вот его то и нужно заменить на другой.

Задача в замене шрифта в не одной сотне чертежей. Открывать каждый файл и менять ручками долго будет.

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

Два варианта. Подключить файл стандартов dws или использовать механизм ObjectDBX (http://autolisp.ru/2010/04/08/procee...tive-document/ + http://autolisp.ru/2015/10/20/objectdbx-limits/ )

[b00]

Можно как-то дополнить функционал CTS/CTSU/TSUP, добавив возможность назначить не только стиль, но и цвет всем текстовым объектам?

[divanci]

с какими текстовыми объектами работает cts. Атрибуты блоков поддерживаются?

[VVA]

divanci, Нажми на + в 1-м посте. Под словосочетание "у всех объектов" попадают и атрибуты блоков

[Netlog]

Акад2007
В ячейках таблицы, в каждой, применено принудительное форматирование текста.
Команда CTSU визуально приводит таблицы в норму, но в ячейках остаются команды форматирования, и, стоит хоть что=то изменить в таблице, как вся таблица опять возвращается в исходному виду.
Если взорвать (_explode) таблицу - то получившиеся MTEXTы с очищенными атрибутами.

[VVA]

Netlog, выложи файл с примером таблицы

[Netlog]

01, png и dwg - что было до команды CTSU
02, png и dwg - что стало после команды CTSU

[VVA]

Обновил до версии 1.9

[d.mOnII]

странно, у меня акад 2018 полная версия лицензия. подгрузил оба лиспа, но ни одна команда не работает((( кад ее просто не видит(

[Frigate]

VVA,

огромное спасибо за Unf-MTEXT

ни одна другая программа ЛИСП для деформатирования не работала с высотой.

[MFor]

Коллеги, прошу помочь.
SMT не хочет менять цвет текста в мультивыносках
Что не так и как победить?

Почему, даже если поменять в этой выноске цвет текста вручную, то smt возвращает обратно красный?
Почему можно скопировать свойства этой выноски на вновь созданную, но не наоборот?

[VVA]

Сообщение от MFor Почему, даже если поменять в этой выноске цвет текста вручную, то smt возвращает обратно красный?

потому что smt убирает форматирование. В этой выноске изначально без всякого форматирования цвет у мтекста красный. Скорее всего она была создана программно. Добраться до мтекста мультивыноски лиспом пока не смог

[koMon]

Сообщение от VVA Добраться до мтекста мультивыноски лиспом пока не смог

Красный цвет - индекс 1 - никак в тексте не помечается, остальные да:
TextString = "\\pxsm1;{\\C160;5785/35 - 12м 5784/13 - 12м } "
что-то некорректное сделано со стилем мвыноски

[818937]

Сообщение от MFor SMT не хочет менять цвет текста в мультивыносках Почему, даже если поменять в этой выноске цвет текста вручную, то smt возвращает обратно красный?

Сообщение от VVA потому что smt убирает форматирование. В этой выноске изначально без всякого форматирования цвет у мтекста красный. Скорее всего она была создана программно. Добраться до мтекста мультивыноски лиспом пока не смог

У нас на работе ребята форматируют не стили текста/выносок, а вручную каждый элемент в редакторе. Выделают фразу - делают сжатие, меняют цвет.
У меня есть кривые выноски - текст например желтый, а полка и направляющая послою.
Я как только с бубном не прыгал, сейчас уже не помню точно, я смог редактировать текст, но с выносками не получилось - так и сделал себе новые.
В последний раз решил проблему: выноски скопировал по точке, удалил, вставил по точке блоком, в блоке взорвал, изменил цвет текста (изменял цвет в диспетчере свойств, т.е. smt жать не нужно было).
Как я понимаю - цвет текста задан либо в диспетчере свойств либо в редакторе, и соответсвенно smt не умеет скидывать одно из двух. Только что пробывал скидывать smt растяжение текста заданного в ленте - не работает.
Танцы с бубном, метод научного тыка. От некоторых команд бывает еще остаются "останки редактирования", несколько символов форматиирования. Было например "123" красным, очистил формат стало ",;.123"
PS большое спасибо, лиспы иногда очень помогают править разную рукожопость)

[guerre1403]

VVA, Помогите, пожалуйста, макрос не работает, появляется все равно диалоговое окно. (if (null C:CTS)(load "change text styles (cts)"));CTS;(cts:layer-status-save);(ru-textstyle-update "ххх");_.PURGE;
Как изменить код, чтобы можно было запускать с командной строки, указав имя стиля.
Пробовал (ru-textstyle-update "ххх"),
пишет "Ждите, привожу стиль
'ххх' к определению...
nil"
при этом ничего стили не меняются.
С диалоговым окном проблем нет-все работает отменно!

[VVA]

guerre1403, Добавь свою функция в lsp файл

Код:

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

(defun cmdCTS (style unformat / *error*)
  ;;;Переменные
  ;;; style - имя текстового стиля, текст
  ;;; unformat - принимает 2 значения
  ;;;    t - убрать форматирование текста
  ;;;   nil - не изменять форматирования
  ;;;Использование (cmdCTS "МИП_ГОСТ" nil)
  ;;;Использование (cmdCTS "МИП_ГОСТ" t) ;_очищать дополнительное форматирование текста
   (defun *error* (msg)(princ msg)(cts:layer-status-restore)(princ))
 (cts:layer-status-save)
 (ChangeAllTextObjectsStyle (vla-get-activedocument (vlax-get-acad-object)) style nil unformat)
 (ru-textstyle-update style) 
 (cts:layer-status-restore)
 (princ)
  )

и макрос

Код:

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

(if (null C:CTS)(load "change text styles (cts)"));(cmdCTS "XXXXX" nil);_.PURGE;

Вроде должно работать

[guerre1403]

Сообщение от VVA guerre1403, Добавь свою функция в lsp файл Код: [Выделить все] (defun cmdCTS (style unformat / *error*) ;;;Переменные ;;; style - имя текстового стиля, текст ;;; unformat - принимает 2 значения ;;; t - убрать форматирование текста ;;; nil - не изменять форматирования ;;;Использование (cmdCTS "МИП_ГОСТ" nil) ;;;Использование (cmdCTS "МИП_ГОСТ" t) ;_очищать дополнительное форматирование текста (defun *error* (msg)(princ msg)(cts:layer-status-restore)(princ)) (cts:layer-status-save) (ChangeAllTextObjectsStyle (vla-get-activedocument (vlax-get-acad-object)) style nil unformat) (ru-textstyle-update style) (cts:layer-status-restore) (princ) ) и макрос Код: [Выделить все] (if (null C:CTS)(load "change text styles (cts)"));(cmdCTS "XXXXX" nil);_.PURGE; Вроде должно работать

Спасибо большое!Работает! Только возникла одна проблема:он убивает все поля. Эта проблема сидит в лиспе change text styles (cts) 1.9.LSP. С этим можно что-нибудь сделать?

[LcH]

Добрый день, VVA. И все, кто отслеживает и вносит изменения и поправки в программы Замена текстовых стилей.
Эти программы давно подключены у меня в мой файл адаптации, наверное с версии 1.7, но редко использовались.
Теперь возникла необходимость частого использования и не только мной, т.е. нам необходимо перейти не только на другой текстовый стиль, а использовать другой тип шрифта, эти программы очень нужны.
Но при массовом тестировании обнаружились некоторые недочеты, некоторые действительно объяснимы, а есть моменты, которые хотелось бы избежать.
Очень хочется, чтобы вы нашли время и посмотрели файлы, которые я сейчас попытаюсь прикрепить.
На словах хочу пояснить, AutoCAD 2015, сейчас работаю с программой версии 1.9, выполняю команды CTSU, затем TSUP.
Главная неприятность - в МТекстах остаются некоторые управляющие символы, которые не сразу увидишь, особенно если работа массовая.
Надеюсь, мне ответят, можно это исправить или нет, заранее спасибо.

[Рyslan]

чот эти програмки вообще не работают. ничего не меняют
нужно поменять текст стиль 25х22 на 25х22R. если через таблицу свойств менять, вылезают вопросики абракадабра какая то, а эта программа вообще ничего не меняет

[PsixVK]

Сообщение от Рyslan чот эти програмки вообще не работают. ничего не меняют нужно поменять текст стиль 25х22 на 25х22R. если через таблицу свойств менять, вылезают вопросики абракадабра какая то, а эта программа вообще ничего не меняет

вообще не понятно чего вы хотите
(если много текстов) быстрый выбор - текст стиль 25х22 - в свойствах изменить на 25х22R
у вас Текст зачем вам программа для Мтекстов?
кароче хз чего вы хотите

[Хмурый]

dwgconvert
PS один чёрт, он не сможет помочь

[Рyslan]

Сообщение от PsixVK кароче хз чего вы хотите

Прошу прощения, не умею нормально объяснять. Короче, английский текст должен быть в слое Text(E) и стиль 25X22, русский текст Text(R) и стиль 25X22R. Прислали ...русский текст в слое Text(R), но в стиле 25X22. Меняю стиль на 25X22R ----весь текст превращается в кракозябры.

[PsixVK]

[IMG]http://i.*******info/i9/89648ffc006a729ba8148cb7e5e3372f/1539079631/33979/1261320/E.jpg[/IMG]

[IMG]http://i.*******info/i9/0e2de7e941f174dcd9154056f22cb9e9/1539079649/40618/1261320/R.jpg[/IMG]

ну меняет толькол разная величина букв
хз какие кракозябры вы видете.
наверное из за этого:

[IMG]http://i.*******info/i9/4b2de2084b9bfd1b8c524ecbfd3510ee/1539079944/46201/1261320/neponiatnyi.jpg[/IMG]

[Рyslan]

да, я тоже думаю из -за шрифта. вот чтоб еще понятнее стало. в этом файле выстави в свойствах стиль текст 25X22R и посмотри на русский текст

[PsixVK]

Сообщение от Рyslan да, я тоже думаю из -за шрифта. вот чтоб еще понятнее стало. в этом файле выстави в свойствах стиль текст 25X22R и посмотри на русский текст

а что с ним не так?

[IMG]http://i.*******info/i9/9b393bf124b3afad0cdc6c8d11f46763/1539080832/46892/1261320/rus.jpg[/IMG]

[Хмурый]

вот простой simplex из 2014 и simplex8 на всякий
PS если замена шрифта не поможет, то надо будет, скорей всего, поменять кодовую страницу AutoCAD в реестре....

[Рyslan]

Сообщение от PsixVK а что с ним не так?

ну замени текст стиля в свойствах, увидишь

[PsixVK]

Сообщение от Рyslan ну замени текст стиля в свойствах, увидишь

ты не поверишь!
менял все нормально отображается на картинках (которые ты скорее всего не смотрел) показано изменения в свойствах - текст читается.
у тебя проблемы со шрифтами выше человек выложил для скачивания шрифты (которых почему то у тебя нет)
версия автокада какая?

[Хмурый]

Рyslan, вот ещё попробуй https://forum.dwg.ru/showpost.php?p=655669&postcount=30

[PsixVK]

тексты читаются даже при том что у меня нет того шрифта что в файле используется

[Рyslan]

Сообщение от PsixVK тексты читаются даже при том что у меня нет того шрифта что в файле используется

покажи картинку

Сообщение от Хмурый Рyslan, вот ещё попробуй https://forum.dwg.ru/showpost.php?p=655669&postcount=30

Спасибо, пробовал. Так и не понял как она работает )))

[Хмурый]

Рyslan, у меня твой текст тоже читается нормально. Либо шрифт, либо кодовая страница. У меня на R13 и R14 приходилось менять кодовую страницу в реестре
PS кстати, обновления на AutoCAD установлены?

[PsixVK]

Сообщение от Рyslan покажи картинку

хух
картинки все выше!
есть такая штука "+" (плюсик) нажимаешь его он разворачивается.
[IMG]http://i.*******info/i9/5aeb2b79f902b4828482e7db378245a5/1539084542/23758/1261320/pliusyk.jpg[/IMG]

[IMG]http://i.*******info/i9/0dbc8c960abc22d5f43739a5ebb48677/1539084560/30836/1261320/eshche_pliusyk.jpg[/IMG]

[Рyslan]

еще один файл, похоже в предыдущем не было стиля 25X22R, попробуй в русском тексте вот этот стиль выстави и посмотри как изменится русский текст

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

А не пробовали для начала dwg предоставлять полностью?

[PsixVK]

Сообщение от Рyslan еще один файл, похоже в предыдущем не было стиля 25X22R, попробуй в русском тексте вот этот стиль выстави и посмотри как изменится русский текст

слушай ну ты наверно издеваешься?
[IMG]http://i.*******info/i9/5c1d11b79beabd489223796612fd732e/1539085753/52800/1261320/nuy.jpg[/IMG]
скучно стало и ты решил развлечь народ скачиванием твоих файлов и игры со стилями?

[Рyslan]

короче забейте )) наверное у меня только так отображается

[PsixVK]

Сообщение от Рyslan короче забейте )) наверное у меня только так отображается

а как у тебя отображается?
ты хотя бы показал

[Рyslan]

Сообщение от PsixVK а как у тебя отображается? ты хотя бы показал

Хотел принкт скрин сделать чтоб свойства видны были, чот не работает. Вот пдф

[PsixVK]

Сообщение от Рyslan Хотел принкт скрин сделать чтоб свойства видны были, чот не работает. Вот пдф

хз
очень похоже на это
цитата

[rebus]

Файл "change text styles (cts) 1.9.LSP", строка 339, похоже скобку не там поставили, где хотели:

Код:

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

 (if (= (strcase X# "C"))

[divanci]

не работает программа в этом файле (см. вложение) И вообще не понятно почему выбирать нужно игнорируемые стили, что если стилей под сотню а менять нужно всего один.

[VVA]

Сообщение от divanci не работает программа в этом файле (см. вложение)

У меня работает (Автокад 2013)

Сообщение от divanci И вообще не понятно почему выбирать нужно игнорируемые стили

А что с ними еще можно сделать? Если таковых нет жми "отмена". Написано в заголовке окна

[divanci]

Если я хочу поменять один на другой, что мне выбирать, если всего 10 стилей?

[VVA]

CTS - замена текстовых стилей у всех объектов на выбранный

Здесь решалась задача по замене всех текстовых стилей на на выбранный, в итоге должен остаться 1 стиль
Потом попросили добавить возможность делать исключение для некоторых постоянно заданных стилей
Если хочешь из 10 стилей сделать 9, то 8 добавляй в исключение

[divanci]

А можно добавить возможность выбирать переносить все кроме выбранных или переносить только выбранные и опцию отмены форматирования вместо другой команды?

[Пионер]

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

[Composter]

У меня почему то в 2019 автокаде smt не делает ничего.

[eing]

После применения команд, обнаружил объекты на которых они не сработали.
Это оказались блоки внутри блока.

Вопросы
1) Какая глубина вхождения в блоки планировалась?
2) Как её увеличить?

[VVA]

eing,

Сообщение от eing После применения команд, обнаружил объекты на которых они не сработали

Каких команд?

Сообщение от eing Какая глубина вхождения в блоки планировалась?

Полная

(defun ChangeAllTextObjectsStyle (Doc StyName Ignore_Style_List Unformat / tempObjType IsLo ColCnt RowCnt) (vlax-for Blk (vla-get-Blocks Doc)

Идет проход по всем определениям блоков. Поэтому не важно какой блок куда и с какой глубиной вложен
Выложи dwg с проблемным блоком

[eing]

Файл приложен к сообщению.

Технология работ:
1)Чертежи создаются автоматизированно в Autocad 2000.
2)Чертежи дорабатываются в Autocad 2008. На этом этапе требуется произвести нормализацию шрифтов.

Порядок теста:
1)Формат - текстовые стили - редактирую угол наклона текстового стиля Gost 2.304.
2)CTSU. отмена. Gost 2.304. ok.
3)TSUP. yes. Gost 2.304. ok.
90% шрифтов изменено, 10% - нет. Если взорвать блоки, на которые не повлияло, и повторить - все шрифты будут изменены.

[VVA]

eing, Я не нашел таких блоков. Можешь оставить пару блоков, на которые не влияет или как-то их выделить в чертеже.

[eing]

Оставил в файле только проблемные блоки, в которых есть блоки, в которых не весь текст изменился.

При проверке я устанавливал угол наклона текста - 75 градусов. Соответственно измененный текст - не читаемый. Читаемый текст - на котором не сработало.

[eing]

Надеюсь ни чего не нарушаю - даю ссылку на видео где видно срабатывание не на всех объектах. 14Мб = 1минута.
https://drive.google.com/file/d/1WYN...ew?usp=sharing

[Alexorno]

Доброе время суток!
Уважаемые, AutoCAD 2019 и AutoCAD 2020 - не работает в выносках и таблицах. Ниже AutoCAD нет.
В чём может быть проблема?

[Tyhig]

VVA, это уже безразлично, но всё равно большое спасибо.
Или вы ещё живы ?

[VVA]

Tyhig, Жив
eing, Пропустил твое сообщение. Проблема была в атрибутах блоков, которые включены в другие блоки. Обновил до версии 2.0
Alexorno, Пока не имею 2019 и 2020. Скачаю, попробую

[stuff]

Спасибо
Помогла комманда - TSUP

[Wince]

С чем может быть связано, что команда «UNF-MTEXT» удаляет пробелы между словами? Можно ли это как-то решить?
Данная проблема имеется только с одним пакетом чертежей, пробовал в других-все работает как заявлено автором.
Заранее спасибо за ответ.

[skkkk]

Может, там вместо пробела что-то другое? Например, неразрывный пробел? Без файла будут долгие гадания.

[Wince]

Сообщение от skkkk Может, там вместо пробела что-то другое? Например, неразрывный пробел? Без файла будут долгие гадания.

Действительно, был неразрывный пробел. Даже не подумал о нем.
Спасибо за наводку!

[Кукурузо_Джон_Горыныч]

а умеет эта штука очищать/удалять форматирование текста у размеров с перебитыми значениями, оставляя при этом перебитые значения?

[AlexCondor]

Кукурузо_Джон_Горыныч, В принципе могли и сами попробовать. Да, форматирование она очищает, размер не трогает. Но как я понял вам надо сбросить и высоту. А вот высоту у меня, почему-то, сбросить не получилось...

[Кукурузо_Джон_Горыныч]

Спасибо за ответ! Да, мог, но это не так просто, я давно лиспом не пользовался, надо восстановить знания) У меня там куча размеров и шрифт принудительно назначен, высота текста дополнительно не форматировалась, или какую высоту вы имели ввиду?

[AlexCondor]

Да, именно высоту текста. Взял для примера файл из той темы. И попробовал.
Например, был размерный текст "\H3.5;\W0.965;\Q15;\H3.5;\W0.965;\Q15;\Q15;1200", стал "\H3.5;\H3.5;1200". Галочка "Height" стоит.

----- добавлено через ~22 ч. -----
Кукурузо_Джон_Горыныч, Судя по всему проблема в этой строчке: (RE:Replace "" "\\\\H[0-9]*?[.]?[0-9]*?(x|X)+;" str).
Она корректно работает для мультитекста, но не работает для размера. Формат высоты разный, для текста "\H1.1x;",а для размера "\H1;"
Если убрать в этой строчке *?(x|X), то она отработает для размерного текста, и в принципе вашу задачу можно решить.
А сам LISP надо наверное доработать, чтобы он корректно работал и с текстом и с размерами. Но лучше за этим обратиться к автору.

[modest-bp]

Спасибо за очень полезные LISP!!!

Попробовал оба, но, несмотря на то, что в описании Strip MText написано, что убирает форматирование даже в ячейках таблиц - добиться этого не получилось.
Существуют ли какие-либо средства подчистить форматирование в таблицах? Интересно не только форматирование текста, но также форматирование самих ячеек...
Например, к ячейкам, или даже к строке/колонке таблицы применён определённый стиль ячеек, но через properties форматирование ячейки переназначено... скажем, в стиле прописано округление до десятых, а в свойствах ячейки руками выставлено до сотых долей (или в применённом к ячейке стиле формат данных - числа, а в свойствах ячейки записан "текст"). Существуют ли инструменты, которые бы позволяли вычистить это переформатирование как для отдельных ячеек, так и для отдельных колонок/строк, либо всей таблицы целиком? Было бы очень полезно...

[Dniper]

Всем привет. Возможно кому то не будет трудно запилить видео как пользоваться данным лиспом ? Заранее спасибо.

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

https://dwg.ru/pub/9

[PsixVK]

Сообщение от Dniper Всем привет. Возможно кому то не будет трудно запилить видео как пользоваться данным лиспом ? Заранее спасибо.

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

[Coochi]

Джентельмены, работает ли change text styles (cts) 2.0 в 2017 версии Автокада? Чтоб ни делал - реакции никакой.

dwg файл по линку https://drive.google.com/open?id=10G...Q0dAJCmVPQmx05

нужно чтоб использовался стиль GOST 2.304 type B

[VVA]

Coochi, CTSU, первый запрос "Игнорируемые стили", жмешь отмена, второй запрос - выбираешь GOST 2.304 type B

----- добавлено через ~5 мин. -----

Сообщение от modest-bp что в описании Strip MText написано, что убирает форматирование даже в ячейках таблиц - добиться этого не получилось

Там написано не так

to quickly remove unwanted Mtext formatting embedded in Mtext, Mleaders, Dimensions, Tables, and Multiline Attributes objects

Форматирование мтекса и ячеек таблицы это разные вещи

----- добавлено через ~15 мин. -----

Сообщение от modest-bp Существуют ли инструменты, которые бы позволяли вычистить это переформатирование как для отдельных ячеек, так и для отдельных колонок/строк, либо всей таблицы целиком? Было бы очень полезно...

Re: Remove table cell overrides

Here's a snip to try out: (setq flag 0) (vla-ClearTableStyleOverrides (vlax-ename->vla-object (car (entsel))) Flag) Flag: 0 Deletes all table and cell overrides. 1 Deletes all table overrides, but retains cell overrides. 2 Deletes all cell overrides, but retains table overrides.

Код:

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

(vl-load-com)(vla-ClearTableStyleOverrides (vlax-ename->vla-object (car (entsel))) 0)

Скопировать код в командную строку, вместо 0 можно указывать 1 или 2. Описание выше

[Coochi]

Сообщение от VVA жмешь отмена, второй запрос

большое спасибо, сейчас получилось, сам бы не додумался ):

[VVA]

Coochi, Почему? Как нужно спросить чтобы было очевидно. Первый вопрос возник, так как просили дать возможность выбрать игнорируемые стили. Может поменять запросы местами? Игнорируемые стили, мне кажется, нужны реже

[Bubar]

Помогите, пожалуйста разобраться как заменить все шрифты в Gost type B при помощи LISP. Вообще с Автокадом не особо дружу. Предпочитаю чертежи выполнять в Архикаде и транслировать из него в DWG. Раньше транслировал все как есть, сейчас смежники начали возмущаться начертанию текста.
Значит, что я делал: 1. в файле dwg редактировал стили с применение шрифта Gost type B
2. редактировал размерные стили применяя измененный стиль
3. редактировал стили выносок применяя измененный стиль
4. закидывал в файл change text styles (cts) 2.0.LSP
5. вводил команду CTSU (другие команды либо выводят многострочный текст в одну строку с ql;, либо вообще ничего не меняют), отмена, выбирал стиль замены и enter. Действительно поменялся весь текст, но в выносках добавляется ql;. Что это за ql; и как это убрать я не знаю.
Помогите, пожалуйста разобраться.
Файл прикрепляю - ссылка.
Спасибо.

[VVA]

Сообщение от Bubar Что это за ql; и как это убрать я не знаю.

Глюкус обыкновениус
Обновил до версии 2.0a (кое-что было не учтено в функции, убирающей форматирование мтекста)
Действуешь правильно по п.5

[Bubar]

VVA Большое спасибо. Теперь все правильно отображается.

[peltsve]

SMT не стал работать под ACAD 2021. У меня одного?

[Andrey7n]

Всем привет.
CTS 2.0a убивает в таблицах поля, все - ссылающиеся на подшивку и где =2+2 было написано, остаётся только текст. Можете исправить?
Еще бы неплохо добавить в циклы (acet-ui-progress) прогресс-бар, а то операция по замене довольно длительная, на слабых машинах и в захламленных документах занимает около минуты, при этом АвтоКад выглядит будто зависший, нетерпеливые пользователи начинают убивать процесс через Диспетчер задач и больше не хотят пользоваться программой

[VVA]

Andrey7n, выложи пример.

[farookh1]

Почему-то в 2021 автокаде не сбрасывает stripmtext. В 2019 работает нормально, а в 2021 вроде окно появляется, но результата нет

[farookh1]

Нашел решение: LISPSYS=0

[RuslanK]

Огромное спасибо автору лиспа. Очень помог в работе.

[posetitel]

Сообщение от farookh1 Нашел решение: LISPSYS=0

Это что за команда? Где такое нужно указать?

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

Это не команда, а системная переменная. Доступна начиная с ACAD2021. Я у себя на сайтике про нее разгонял в свое время.

[Des501(К)]

А можно ли как-то выполнить команду CTSU и TSUP без диалоговых окон, а просто передав в команду название нужного стиля?
Есть масса чертежей, которые нужно "причесать". Я сделал кнопки, удобно и работает шикарно. Но каждый раз выбирать в меню просто долго. Я бы сделал кнопочки на конкретные стили (их пару штук всего) и очень быстро бы обработал пачку чертежей.

[NewNeo]

Сообщение от VVA Глюкус обыкновениус Обновил до версии 2.0a (кое-что было не учтено в функции, убирающей форматирование мтекста) Действуешь правильно по п.5

Уважаемый автор! Приложение замечательное, спасибо огромное! Пользуюсь уже долгое время, но недавно столкнулся с такой же проблемой, попробовал новую версию (2.0а), помогло, но сейчас еще раз выскакивают эти служебные символы даже при использовании версии 2.0а, в чем может быть проблема? Файл с примером проблемного текста прикладываю.

[VVA]

Сообщение от NewNeo но сейчас еще раз выскакивают эти служебные символы даже при использовании версии 2.0а

Обновил до версии change text styles (cts) 2.0b.LSP. Не было учтено форматирование

[NewNeo]

Сообщение от VVA Обновил до версии change text styles (cts) 2.0b.LSP. Не было учтено форматирование

Благодарю Вас, все работает!

[NewNeo]

Обнаружил еще один баг( Приложение удаляет блоки вставленные внутри таблица автокада... Можно это как-то исправить?

[VVA]

Сообщение от NewNeo Обнаружил еще один баг

Обновил до версии change text styles (cts) 2.0c.LSP

[NewNeo]

все работает! спасибо огромадное! за оперативность отдельное! 🤝

все работает! спасибо огромадное! за оперативность отдельное! 🤝

[Nike]

Вот спасибо! я чуть с ума не сошел что мне так все время так гадило

[konstryktor]

Добрый день! При использовании приложения Change text style стили текста, назначенные в размерных стилях не меняются?

[Taridaks]

Размеры спокойно меняются через стандартные инструменты автокада. Выбираете нужный стиль размера и в настройках задаёте стиль текста.

[Dimas77]

Вопрос: При установке замена сработала, но теперь при попытке редактировании однострочного текста двойным кликом всегда выскакивает окно замены текстовых стилей, Autocad 2016, 2021 как сделать чтобы при редактировании не вызывалась команда CTS? Удалил эти лисп надстройки с компьютера из папок и автозагрузки, перегрузил, теперь при редактировании однострочного текста двойным кликом: Команда: _CTS Неизвестная команда "CTS". Для вызова справки нажмите F1. Невозможно просто изменить однострочный текст двойным нажатием.

[VVA]

Dimas77, Команда никуда себя не записывает. Как вариант, посмотри что у тебя записано на текст в файле меню узел "Операции при двукратном нажатии". (Команда _.QUICKCUI, далее "Операции при двукратном нажатии")

[Domovoj]

Добрый день. Запускаю команду CTSU. Текстовый стиль меняется. В многострочном тексте угол наклона 0, в однострочном -угол наклона 15. Как сделать угол наклона везде 0.
п.с. разобрался. После запуска команды TSUP все стало хорошо.

[dovserg]

Спасибо большое автору! Не с первого раза (нуб), но получилось!)

[Amiens]

Добрый день. в SMT не очищает параметр высоты в 2020 и 2021 акаде

[engngr]

... И шрифт не сбрасывает в AC2021.
282 пост же нашелся -
https://forum.dwg.ru/showpost.php?p=...&postcount=282
- но уже после гугла и https://forums.augi.com/showthread.p...n-AutoCAD-2021

[baaba]

А можно сделать так, в чертеже 10 разных стилей. Каждому из этих стилей изменить гарнитуру шрифта (isocpeur italic)? И больше ничего не торогать.

[VVA]

Сообщение от baaba Каждому из этих стилей изменить гарнитуру шрифта (isocpeur

Font Style в дампе не нашел

Код:

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

 (vl-load-com)(VLAX-FOR t_s(vla-get-textstyles(vla-get-activedocument(vlax-get-acad-object)))(vla-put-fontfile t_s "isocpeur.ttf"))

Еще можно посмотреть здесь How to Add "Bold" font style in a lisp
и здесь Lisp .... textfontstyle bold, italic, bolditlaic

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

Offtop: Ttf-шрифты в текстовых стилях вообще боль.

[VVA]

И кстати у меня в isocpeur.ttf нет стиля itallic. Возможно потребуется подкорректировать имя шрифта ttf

[ElectricSib]

Есть файл с таблицами, в которых вбиты формулы наподобие Екселя, типа "=A1+B2", "=sum(B3:B12)" и т.д.
Заметил, что при применении скрипта CTS эти формулы убиваются, ячейки становятся пустыми. Никто не наблюдал этот глюк?

Update: Применение последней версии скрипта change text styles (cts) 2.0c.LSP не уничтожает данные, но формула становится просто текстом.

Возможно ли изменить код CTS таким образом, чтобы он не повреждал формулы в таблицах?

[VVA]

Сообщение от ElectricSib Возможно ли изменить код CTS таким образом, чтобы он не повреждал формулы в таблицах?

Возможно. Обновил до версии change text styles (cts) 2.0d

[nikola88]

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

[VVA]

пример файла выложи, посмотрю

[nikola88]

Сообщение от VVA пример файла выложи, посмотрю

Пытаюсь изменить стиль на любой гостовский, так как текущий simplex, при печати очень бледный

[Nikilin]

Здравствуйте коллеги.
Много лет пользовался бесплатным Lisp приложением StripMtext
Недавно возникла проблема.
Лисп не сбрасывает высоту у МТЕКСТА.
Пример в dxf code 1 следующее содержание \A1;{\fD431|c1|b1|i1;\H1.06;\l\C0;834,65} [
После применения StripMtext с выбором всех встроенных функций остается следующее значение "\Н1.06:834.65".
Может кто в курсе как это пофиксить. Покопался в лиспе, код у него благо открытый. Вроде должно сбрасывать все верно, но не работает именно на высоте.
Если я верно понял в коде за это отвечает данная строка (RE:Replace "" "\\\\H[0-9]*?[.]?[0-9]*?(x|X)+;" str)

[ElectricSib]

Сообщение от VVA Возможно. Обновил до версии change text styles (cts) 2.0d

Спасибо.
Кстати, такой же глюк с уничтожением формул наблюдается при применении UNF-MTEXT по таблицам.

[AlexCondor]

Nikilin, Как-то сталкивался с подобным. Посмотрите, может поможет.

[name02]

Обнаружил что StripMtext не удаляет форматирование зачеркнутого мтекста (код форматирования \K). Решается добавлением в буквально в трех местах кода аналогично коду удаления "надчеркнутого" текста (код \O). Если есть возможность и желание можно переделать. Ну и окно программы тоже надо исправить, по-хорошему.

[SultanovNS]

Владимир, здравствуйте!

Просто превосходный LISP! Большое Вам спасибо!

Протестировали работу в nanoCAD - работает на 99%! Но есть проблема с командой TSUP:

Команда: TSUP
TSUP - TSUP
ошибка: load_dialog failed to load file "C:\Tmp\mip49C4.tmp"

Подскажите пожалуйста, в чем может быть проблема и возможные пути её решения?

[SultanovNS]

Во вложении письма dwg на котором приводил тестирование LISP.

В нем представлены объекты:
1) Стандартный блок
2) Блок с атрибутами (открытые параметры текста)
3) Блок с атрибутами (в параметрах текста, у основного атрибута недоступны для редактирования "Степень растяжения" и "Угол наклона")
4) МТекст
5) Текст
6) МТекст

На объектах 1, 4, 6 LISP работает прекрасно, CTSU сразу всё меняет. На объектах 2, 3 , предполагаю что без TSUP не обойтись, т.к. после CTSU в блоках меняется "Стиль текста", а вот "Степень растяжения" и "Угол наклона" остаются прежними (не изменяются в соответствие со стилем). C объектом 5 вообще странно, вроде обычный Текст, но ситуация после CTSU аналогична 2, 3.

К сожалению без TSUP, LISP переваривает не все элементы.

[SultanovNS]

Владимир, здравствуйте!

Представители профессионального сообщества, которые вынуждены работать в nanoCAD, на одном из форумов утверждают, что Ваш LISP "change text styles (cts) 1.8" не нуждается в адаптации и изумительно работает под nanoCAD!

Обрадовался - протестировал - расстроился

Дело в том, что в версии 1.8 при запуске TSUP уже появляется окно ИЗМЕНЕНИЕ СТИЛЕЙ!!!!, в отличии от версии 2.0, а это уже прогресс. Но в итоге всё равно приходим к сбою!

Алгоритм действий:

1) Загружаем LISP:
APPLOAD,ЗАГПРИЛ - Загрузка приложения...
Наберите CTSU, CTS,UNF-MTEXT или TSUP в командной строкеCTS:MASSOC
change text styles (cts) 1.8.LSP загружен. Команды: UNF-MTEXT,CTS,TSUP,CTSU

2) Запускаем CTSU:
Команда: CTSU
CTSU - CTSU
2 COUNT_COL=1
3 FL=C:\Tmp\dwg5CE1.tmp.dcl
5 _LOC_FINISH
2 COUNT_COL=1
3 FL=C:\Tmp\dwg62DF.tmp.dcl
6 _LOC_CLEAR
5 _LOC_FINISH

3) Запускаем TSUP (открывается окно ИЗМЕНЕНИЕ СТИЛЕЙ!!!!), в командной строке видим следующее:
Команда: TSUP
TSUP - TSUP
2 COUNT_COL=1
3 FL=C:\Tmp\dwgD592.tmp.dclошибка: неверный тип аргумента: numberp: "BSAM"

4) В окне ИЗМЕНЕНИЕ СТИЛЕЙ!!!! на вопрос "Будем делать?" отвечаем "Yes", в командной строке видим следующее:
Команда: TSUP
TSUP - TSUP
2 COUNT_COL=1
3 FL=C:\Tmp\dwgEDFB.tmp.dcl
5 _LOC_FINISH
OdError - Object of class AcDbDimStyleTableRecord can't be cast to AcDbEntity.

В итоге команда не срабатывает! Может быть эта информация, поможет в поиске решения по адаптации LISP под nanoCAD!

[unton]

Жаль, что с размерами не работает. В них тоже текст есть и его тоже нужно обнулять иногда.

[sergey12]

Имеются размеры. В текстовой строке в размерах прописаны параметры (\H5.0;\H5.0;\H3.50;400\H5.00;\H5.0;*), где-то пусто.
Как исправить текстовый стиль размеров под нужный мне размер? Примитивы пришли с компаса, вот и заморочки.
Если два раза ЛКМ по размеру и выбрать стиль текста "standart 350", то текст нормальным, большим становится.

Пробовал CTS, CTSU, TSUP, UNF-MTEXT, SMT.
LISPSYS=0

Установлен ACAD 2024.


UPD:
"В правильно заданном вопросе кроется 90% ответа))"

Всё выделил, выбрал свойства -> все размеры -> Текстовая строка (у меня там было *различные*), очистил кнопкой del. И всё норм стало)

[name02]

По всей видимости указанные программы не работают, потому что в текстовой строке размера записано \H5.0;\H5.0;\H3.50;400\H5.00;\H5.0;*, в то время как у "правильных" автокадовских размеров, при наличии кодов форматирования, эта же строка выглядит как {\H0.01167x;400\H1.42857x;*}
"Разформатирование" текста ориентируется на эти фигурные скобки (насколько я помню код этих программ) - при их отсутствии, программа "думает" что это текст и не "разформатирует" его.
Попробуй такой вариант:

Код:

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

 (defun c:test (/ LM:UnFormat *adoc* e i s)

  (vl-load-com)

  ;;-------------------=={ UnFormat String }==------------------;;
  ;;                                                            ;;
  ;;  Returns a string with all MText formatting codes removed. ;;
  ;;------------------------------------------------------------;;
  ;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
  ;;------------------------------------------------------------;;
  ;;  Arguments:                                                ;;
  ;;  str - String to Process                                   ;;
  ;;  mtx - MText Flag (T if string is for use in MText)        ;;
  ;;------------------------------------------------------------;;
  ;;  Returns:  String with formatting codes removed            ;;
  ;;------------------------------------------------------------;;

  (defun LM:UnFormat (str mtx / _replace rx)

    (defun _replace (new old str)
      (vlax-put-property rx 'pattern old)
      (vlax-invoke rx 'replace str new)
    ) ;_ end of defun
    (if	(setq rx (vlax-get-or-create-object "VBScript.RegExp"))
      (progn
	(setq str
	       (vl-catch-all-apply
		 (function
		   (lambda ()
		     (vlax-put-property rx 'global actrue)
		     (vlax-put-property rx 'multiline actrue)
		     (vlax-put-property rx 'ignorecase acfalse)
		     (foreach pair
				   '(
				     ("\032" . "\\\\\\\\")
				     (" " . "\\\\P|\\n|\\t")
				     ("$1"
				      .
				      "\\\\(\\\\[ACcFfHLlOopQTW])|\\\\[ACcFfHLlOopQTW][^\\\\;]*;|\\\\[ACcFfHLlOopQTW]"
				     )
				     ("$1$2/$3" . "([^\\\\])\\\\S([^;]*)[/#\\^]([^;]*);")
				     ("$1$2" . "\\\\(\\\\S)|[\\\\](})|}")
				     ("$1" . "[\\\\]({)|{")
				    )
		       (setq str (_replace (car pair) (cdr pair) str))
		     ) ;_ end of foreach
		     (if mtx
		       (_replace "\\\\"
				 "\032"
				 (_replace "\\$1$2$3" "(\\\\[ACcFfHLlOoPpQSTW])|({)|(})" str)
		       ) ;_ end of _replace
		       (_replace "\\" "\032" str)
		     ) ;_ end of if
		   ) ;_ end of lambda
		 ) ;_ end of function
	       ) ;_ end of vl-catch-all-apply
	) ;_ end of setq
	(vlax-release-object rx)
	(if (null (vl-catch-all-error-p str))
	  str
	) ;_ end of if
      ) ;_ end of progn
    ) ;_ end of if
  ) ;_ end of defun

  (setq *adoc* (vla-get-activedocument (vlax-get-acad-object)))
  (vla-startundomark *adoc*)
  
  (if (setq s (ssget '((0 . "*DIMENSION"))))
    (repeat (setq i (sslength s))
      (setq e (entget (ssname s (setq i (1- i)))))
      (entmod
	(subst
	  (cons 1 (LM:UnFormat (cdr (assoc 1 e)) T))
	  (assoc 1 e)
	  e
	) ;_ end of subst
      ) ;_ end of entmod
    ) ;_ end of repeat
  ) ;_ end of if

  (vla-endundomark *adoc*)
  (princ)
) ;_ end of defun

[SultanovNS]

Коллеги, здравствуйте!

Может у кого-нибудь случайно завалялась ранняя версия change text styles (cts) 1.9.lsp.

Поделитесь пожалуйста!

[posetitel]

Сообщение от SultanovNS Коллеги, здравствуйте! Может у кого-нибудь случайно завалялась ранняя версия change text styles (cts) 1.9.lsp. Поделитесь пожалуйста!

скопировал текст из лиспа. у меня он назывался change text styles (cts) 1.9.LSP

Код:

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

 ;| Команды предназначены для замены и обновления текстовых стилей во всех примитивах рисунка

По мотивам работ форума dwg.ru
Собрал воедино: Владимир Азарко aka VVA
Использованы программы: ru-textstyle-update Сергей Зуев aka ShaggyDoc
Ссылки на форум:
http://dwg.ru/f/showthread.php?t=18854
http://dwg.ru/f/showthread.php?t=21492&page=2


   CTS - замена текстовых стилей у всех объектов на выбранный
   CTSU - замена текстовых стилей у всех объектов на выбранный с деформатирование мтексов
   TSUP - изменение начертания всех существующих ТЕКСТОВ, АТРИБУТОВ во ВСЕХ примитивах, включая блоки, выбранного стиля.
          Устанавливается по определению стиля начертание, сжатие, угол наклона
          
   CTS - replacement of text styles at all objects on chosen
   CSTU - replacement of text styles at all objects on chosen with деформатирование мтексов
   TSUP - change of a tracing of all existing TEXTS, ATTRIBUTES in ALL примитивах, including the blocks, the chosen style.
          The tracing, compression, corner of an inclination is established by definition of style
          
22.10.2008 добавлена обработка форматирования МТЕКСТОВ для Автокада с 2008 версии (выравнивание влево, вправо, посередине, по ширине, распределенное)
02.12.2008 Заменена ф-ция cts:msg-yes-no - диалоговым окном
26.02.2009 Спасибо Sleekka. Исключена обработка блоков внешних ссылок.
           Добавлен выбор игнорируемых стилей
05.02.2010 Добавлана обработка дополнительного форматирования в ф-цию mip_MTEXT_Unformat
           http://forum.dwg.ru/showpost.php?p=515671&postcount=88
03.06.2010 Отдельная команда для удаления форматирования мтекста
23.12.2011 UNF-MTEXT (vla-SetCellState item row col acCellStateNone) Снятие блокировки ячейки
21.11.2013 Добавлена обработка MLEADER. Команда CTS
20.04.2016 Добавлена функция CTS:GET-TEXTSTRING (как замена vla-get-textstring. Т.к. неверно возвращает строку при наличии юникод символов)
           http://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/vla-get-textstring-u-symbols/td-p/4365165
26.12.2017 Добавлена для таблиц vla-put-RegenerateTableSuppressed

|;
;;; ОГРАНИЧЕНИЕ ГАРАНТИЙ
;;; ПРОГРАММА РАСПРОСТРАНЯЕТСЯ НА УСЛОВИЯХ "КАК ЕСТЬ".
;;; АВТОРЫ НЕ БЕРУТ НА СЕБЯ И НЕ ПОДРАЗУМЕВАЮТ КАКИХ-ЛИБО ГАРАНТИЙНЫХ ОБЯЗАТЕЛЬСТВ.
;;; ВЫ ИСПОЛЬЗУЕТЕ  ПРОГРАММУ НА СВОЙ РИСК.
;;; АВТОРЫ НЕ БЕРУТ НА СЕБЯ ОТВЕТСТВЕННОСТЬ ЗА ПОТЕРЮ ДАННЫХ, УЩЕРБ, ПОТЕРЮ ПРИБЫЛИ ИЛИ ЛЮБЫЕ
;;; ДРУГИЕ ПОТЕРИ, ПРОИЗОШЕДШИЕ ВО ВРЕМЯ ИСПОЛЬЗОВАНИЯ ИЛИ НЕПРАВИЛЬНОГО ИСПОЛЬЗОВАНИЯ
;;; ДАННОГО ПРОГРАММНОГО ОБЕСПЕЧЕНИЯ.
;;;*****************************************************************************************
;;; Разрешается   использовать,  копировать,  изменять,  и  распространять  это  программное
;;; обеспечение бесплатно, при  условии, что программное обеспечение, полностью или частично
;;; включающее данное ПО, будет распространяться  на тех-же условиях, а указанные  выше знак
;;; авторского права и примечания об ограничениях гарантий будут приводиться во всех копиях.
;;;*****************************************************************************************


;; ************************************************************************
;;; * Библиотека DWGruLispLib Copyright ©2008  DWGru Programmers Group
;;; *
;;; * _dwgru-get-user-dcl (Кандидат)
;;; *
;;; * Запрос значения у пользователя через диалоговое окно
;;; *
;;; *
;;; * 26/01/2008 Версия 0002. Редакция Владимир Азарко (VVA)
;;;              - Выход по двойному клику, если запрещен множественный выбор (multi-nil)
;;;              - Обработка нескольких колонок
;;; * 21/01/2008 Версия 0001. Редакция Владимир Азарко (VVA)
;;; ************************************************************************
 
;;; ************************************************************************
;;; * Library DWGruLispLib Copyright © 2008 DWGru Programmers Group
;;; *
;;; * _dwgru-get-user-dcl (Candidate)
;;; *
;;; * Inquiry of value at the user through a dialogue window
;;; *
;;; *
;;; * 26/01/2008 Version 0002. Edition Vladimir Azarko (VVA)
;;; - the Output on double a clique if the plural choice (multi-nil) is forbidden
;;; - Processing of several columns
;;; * 21/01/2008 Version 0001. Edition Vladimir Azarko (VVA)
 
(defun _DWGRU-GET-USER-DCL (ZAGL        INFO-LIST   MULTI
                            /           FL          RET
                            DCL_ID      MAXROW      MAX_COUNT_COL
                            COUNT_COL   I           LISTBOX_HEIGHT
                            LST         _LOC_FINISH _LOC_CLEAR
                            NCOL
                           )
;|
* ENGLISH
* Inquiry of value at the user through a dialogue window
* Dialogue is formed to "strike"
* the Quantity of lines on page without скроллинга is set by variable MAXROW.
* It is necessary to remember, that number MAXROW increases on 3.
* the Maximum quantity of columns is set by variable MAX_COUNT_COL
* It is published
     http://dwg.ru/f/showthread.php?p=203746#post203746
* Parameters of a call:
    zagl - heading of a window [String]
    info-list - the list of line values[List of String]
    multi - t - the plural choice is resolved, nil-is not present
 
* Returns:
 The list of the chosen lines or nil - a cancelling
* the Example
 (_dwgru-get-user-dcl " Specify a variant " ' ("First " Second " " Third ") nil); _-> ("First") 
 (_dwgru-get-user-dcl " Specify a variant " ' ("First " Second " " Third ") t); _-> ("First " Second ")
 (_dwgru-get-user-dcl " Specify a variant "
   (progn (setq i 0 lst nil) (repeat 205 (setq lst (cons (strcat "Значение-" (itoa (setq i (1 + i)))) lst))) (reverse lst)) nil)
 (_dwgru-get-user-dcl " Specify a variant, using CTRL and SHIFT for a choice "
   (progn (setq i 0 lst nil) (repeat 205 (setq lst (cons (strcat "Значение-" (itoa (setq i (1 + i)))) lst))) (reverse lst)) t)
|;
 
 
;|
* RUS         
* Запрос значения у пользователя через диалоговое окно
* Диалог формируется "налету"
* Количество строк на страницу без скроллинга задается переменной MAXROW.
* Необходимо помнить, что число MAXROW увеличивается на 3.
* Максимальное количество колонок задается переменной MAX_COUNT_COL
* Опубликована
     http://dwg.ru/f/showthread.php?p=203746#post203746
* Параметры вызова:
    zagl - заголовок окна [String]
    info-list - список строковых значений[List of String]
    multi - t - разрешен множественный выбор, nil- нет
 
* Возвращает:
 Список выбранных строк или nil - отмена
* Пример
 (_dwgru-get-user-dcl "Укажите вариант" '("Первый" "Второй" "Третий") nil) ;_->("Первый") 
 (_dwgru-get-user-dcl "Укажите вариант" '("Первый" "Второй" "Третий") t) ;_->("Первый" "Второй")
 (_dwgru-get-user-dcl "Укажите вариант"
   (progn (setq i 0 lst nil)(repeat 205 (setq lst (cons (strcat "Значение-" (itoa (setq i (1+ i)))) lst)))(reverse lst)) nil)
 (_dwgru-get-user-dcl "Укажите вариант, используя CTRL и SHIFT для выбора"
   (progn (setq i 0 lst nil)(repeat 205 (setq lst (cons (strcat "Значение-" (itoa (setq i (1+ i)))) lst)))(reverse lst)) t)
|;
 ;_ ===== КОНСТАНТЫ ============
  (setq MAXROW 40) ;_макc. кол-во строк без скроллинга (К нему дальше добавится еще 3 строчки)
                   ;_  max lines without scrolling (To it 3 more lines further will be added)
  (setq MAX_COUNT_COL 5) ;_максимальное количество колонок
                         ;_ ; _ a maximum quantity of columns
;;;==================== Локальные фунцкции START==================================
;;;==================== Local functions START==================================
  (defun _LOC_FINISH ()
    (setq I   0
          RET NIL
    ) ;_ end ofsetq
    (repeat COUNT_COL
      (setq I (1+ I))
      (setq RET (cons (cons I (get_tile (strcat "info" (itoa I)))) RET))
    ) ;_ end ofrepeat
    (setq RET (reverse RET))
    (done_dialog 1)
  ) ;_ end ofdefun
  (defun _LOC_CLEAR (NOMER)
    (setq I 0)
    (repeat COUNT_COL
      (setq I (1+ I))
      (if (/= I NOMER)
        (progn
          (start_list (strcat "info" (itoa I)))
          (mapcar 'add_list (nth (1- I) LST))
          (end_list)
        ) ;_ end ofprogn
      ) ;_ end ofif
    ) ;_ end ofrepeat
  ) ;_ end ofdefun
;;;==================== Локальные фунцкции END ==================================
;;;==================== Local functions END ==================================
;;;==================== MAIN PART ===============================================
  (if (null ZAGL)
    (if (= (getvar "DWGCODEPAGE") "ANSI_1251")
      (setq ZAGL "Выбор")
      (setq ZAGL "Select")
    ) ;_ end ofif
  ) ;_ end if
  (if (zerop (rem (length INFO-LIST) MAXROW)) ;_Целое количество столбцов
    (setq COUNT_COL (/ (length INFO-LIST) MAXROW)) ;_Его и оставляем
    (setq COUNT_COL (1+ (fix (/ (length INFO-LIST) MAXROW 1.0)))) ;_Берем ближайшее целое
  ) ;_ end ofif
  (if (> COUNT_COL MAX_COUNT_COL)
    (setq COUNT_COL MAX_COUNT_COL)
  ) ;_Ограничиваем max количеством
  (setq LISTBOX_HEIGHT (+ 3 MAXROW)) ;_  добавляем 3 строчки для красоты и для исключения пограничного скроллинга
                                     ;_ We add 3 lines for appearance and for exception boundary scroll
  (if (and (= COUNT_COL 1) (<= (length INFO-LIST) MAXROW))
    (setq LISTBOX_HEIGHT (+ 3 (length INFO-LIST)))
  ) ;_ end ofif
  (setq I 0)
  (setq FL (vl-filename-mktemp "dwgru" NIL ".dcl"))
  (setq RET (open FL "w")
        LST NIL
  ) ;_ end ofsetq
  (mapcar '(lambda (X) (write-line X RET))
          (append (list "dwgru_get_user : dialog { "
                        (strcat "label=\"" ZAGL "\";")
                        ": boxed_row {"
                        (if (= (getvar "DWGCODEPAGE") "ANSI_1251")
                          "label = \"Значение\";"
                          "label = \"Value\";"
                        ) ;_ end ofif
                  ) ;_ end oflist
                  (repeat COUNT_COL
                    (setq LST
                           (append
                             LST
                             (list
                               " :list_box {"
                               "alignment=top ;"
                               (if MULTI
                                 "multiple_select = true ;"
                                 "multiple_select = false ;"
                               ) ;_ end ofif
                               "width=31 ;"
                               (strcat "height= " (itoa LISTBOX_HEIGHT) " ;")
                               "is_tab_stop = false ;"
                               (strcat "key = \"info" (itoa (setq I (1+ I))) "\";}")
                             ) ;_ end oflist
                           ) ;_ end ofappend
                    ) ;_ end ofsetq
                  ) ;_ end ofrepeat
                  (list
                    "}"
                    ":row{"
                    "ok_cancel_err;}}"
                  ) ;_ end oflist
          ) ;_ end of list
  ) ;_ end of mapcar
  (setq RET (close RET))
  (if (and (null (minusp (setq DCL_ID (load_dialog FL))))
           (new_dialog "dwgru_get_user" DCL_ID)
      ) ;_ end and
    (progn
      (setq LST INFO-LIST)
      ((lambda (/ RET1 BUF ITM)
         (repeat (1- COUNT_COL)
           (setq I '-1)
           (while (and (setq ITM (car LST))
                       (< (setq I (1+ I)) MAXROW)
                  ) ;_ end ofand
             (setq BUF (cons ITM BUF)
                   LST (cdr LST)
             ) ;_ end ofsetq
           ) ;_ end ofwhile
           (setq RET1 (cons (reverse BUF) RET1)
                 BUF  NIL
           ) ;_ end ofsetq
         ) ;_ end ofrepeat
         (setq RET RET1)
       ) ;_ end oflambda
      )
      (if LST
        (setq RET (cons LST RET))
      ) ;_ end ofif
      (setq LST (reverse RET))
      (setq I 0)
      (mapcar '(lambda (THIS_LIST)
                 (if (<= (setq I (1+ I)) COUNT_COL)
                   (progn
                     (start_list (strcat "info" (itoa I)))
                     (mapcar 'add_list THIS_LIST)
                     (end_list)
                   ) ;_ end ofprogn
                 ) ;_ end ofif
               ) ;_ end oflambda
              LST
      ) ;_ end ofmapcar
      (set_tile "info1" "0")
      (setq I 0
            NCOL 1
      ) ;_ end ofsetq
      (repeat COUNT_COL
        (action_tile
          (strcat "info" (itoa (setq I (1+ I))))
          (strcat "(progn (setq Ncol "
                  (itoa I)
                  ")(if (not multi)(_loc_clear Ncol))"
                  "(if (and (not multi)(= $reason 4))(_loc_finish)))"
          ) ;_ end ofstrcat
        ) ;_ end ofaction_tile
      ) ;_ end ofrepeat
      (action_tile "cancel" "(done_dialog 0)")
      (action_tile "accept" "(_loc_finish)")
      (if MULTI
        (set_tile "error"
                  (if (= (getvar "DWGCODEPAGE") "ANSI_1251")
                    "Используйте CTRL и SHIFT для выбора"
                    "Use CTRL and SHIFT for a choicet"
                  ) ;_ end ofif
        ) ;_ end ofset_tile
        (set_tile "error"
                  (if (= (getvar "DWGCODEPAGE") "ANSI_1251")
                    "Можно выбирать двойным щелчком"
                    "It is possible to choose double click"
                  ) ;_ end ofif
        ) ;_ end ofset_tile
      ) ;_ end ofif
      (if (zerop (start_dialog))
        (setq RET NIL)
        (progn
          (setq
            RET (apply
                  'append
                  (mapcar
                    '(lambda (ITM)
                       (setq THIS_LIST (nth (1- (car ITM)) LST))
                       (mapcar
                         (function (lambda (NUM) (nth NUM THIS_LIST)))
                         (read (strcat "(" (cdr ITM) ")"))
                       ) ;_ end ofmapcar
                     ) ;_ end oflambda
                    RET
                  ) ;_ end ofmapcar
                ) ;_ end ofapply
          ) ;_ end ofsetq
        ) ;_ end ofprogn
      ) ;_ end if
      (unload_dialog DCL_ID)
    ) ;_ end of progn
  ) ;_ end of if
  (vl-file-delete FL)
  RET
) ;_ end ofdefun
(defun str-str-lst (str pat / i)
  (cond ((= str "") nil)
        ((setq i (vl-string-search pat str))
         (cons (substr str 1 i)
               (str-str-lst (substr str (+ (strlen pat) 1 i)) pat)
         ) ;_  cons
        )
        (t (list str))
  ) ;_  cond
) ;_  defun
(defun VECTOR_LINE (LINELIST@ / REP# X# Y# X1# Y1# X2# Y2# COLOR#)
  (if (= (type LINELIST@) 'list)
    (progn (setq REP# 0)
	   (repeat (/ (length LINELIST@) 2)
	     (setq X# (nth REP# LINELIST@)
		   Y# (nth (+ REP# 1) LINELIST@)
	     ) ;_ end of setq
	     (if (and (= (type X#) 'STR) (= (type Y#) 'INT))
	       (if (= (strcase X# "C"))
		 (setq COLOR# Y#
		       X1# NIL
		       Y1# NIL
		       X2# NIL
		       Y2# NIL
		 ) ;_ end of setq
	       ) ;_ end of if
	       (if (and (= (type X#) 'INT) (= (type Y#) 'INT))
		 (if (and (= X1# NIL) (= Y1# NIL))
		   (setq X1# X#
			 Y1# Y#
		   ) ;_ end of setq
		   (progn (setq	X2# X#
				Y2# Y#
			  ) ;_ end of setq
			  (vector_image X1# Y1# X2# Y2# COLOR#)
			  (setq	X1# X2#
				Y1# Y2#
				X#  NIL
				Y#  NIL
			  ) ;_ end of setq
		   ) ;_ end of progn
		 ) ;_ end of if
	       ) ;_ end of if
	     ) ;_ end of if
	     (setq REP# (+ REP# 2))
	   ) ;_ end of repeat
    ) ;_ end of progn
  ) ;_ end of if
) ;_ end of defun
;;;; Функция выводит диалоговое окно Да-Нет
;;;;title - заголовок
;;;;message - сообщение
;;;; Возвращает t - Да
;;;;            nil - Нет
;;; Пример (cts:MSG-YES-NO "Привет" "Пойдем в кино?")

(defun cts:msg-yes-no ( title message)
  (= (mip_button2 title message "exclam" "Yes" "No") "Yes")
)
(defun mip_button2 ( TITLE$ MSG$ ICON$ Button1$ Button2$ / fl ret i tmp DCL_ID% maxlen)
  ;;;; идея и реализация значков взята у Terry Miller
  ;;;; Program Name: GetIcon.lsp [Get Icon R6]
  ;;;; Created By:   Terry Miller (Email: terrycadd@yahoo.com)
  ;;;;               (URL: http://web2.airmail.net/terrycad)

  ;;;TITLE$ - заголовок, строка
  ;;;MSG$   - сообщение, строка, разделенная \n

  ;;;ICON$  - строка. Возможные варианты
  ;;;                 "" - нет значка
  ;;;                 "DELETE" - значек корзины
  ;;;                 "ALERTX" - значек X в красном круге
  ;;;                 "EXCLAM" - предупреждение
  ;;;                 "LIGHT"  - лампочка
  ;;;                 "INFORM" - информация
  ;;;                 "QUEST"  - вопрос
  ;;;Button1$ - название кнопки 1
  ;;;Button2$ - название кнопки 2
  (vl-load-com)
  (if (= ICON$ "")(setq ICON$ "none"))
  (setq MSG$ (str-str-lst MSG$ "\n"))
  ;;; Оставляем не больше 20 строк
  (setq i 0)
  (setq MSG$ (vl-remove-if-not '(lambda(x)(< (setq i (1+ i)) 20)) MSG$))
  (setq maxlen (apply 'max (mapcar 'strlen MSG$)))
  (setq tmp nil i 0)
  (setq fl (vl-filename-mktemp "mip.dcl"))
  (setq ret (open fl "w"))
  (repeat (length MSG$)
			(setq tmp
			  (append tmp
			    (list
			      ": text {"
			      (strcat "key = \"msg" (itoa i) "\";")
			         "label = \"\";"
                                 (cond ((< maxlen 11)"width = 12.609;")
                                       ((< maxlen 21)"width = 20;")
                                       ((< maxlen 31)"width = 30;")
                                       ((< maxlen 41)"width = 40;")
                                       ((< maxlen 51)"width = 50;")
                                       ((< maxlen 61)"width = 65;")
                                       ((< maxlen 71)"width = 75;")
                                       ((< maxlen 81)"width = 85;")
                                       (t "width = 15;")
                                       )
			         "fixed_width = true;"
			         "vertical_margin = none;"
			        "}"
			      )))
			(setq i (1+ i))
			)
  (mapcar '(lambda (x) (write-line x ret))
	   (append
            (list "dcl_settings : default_dcl_settings { audit_level = 3; } "
		  "MIPTemp : dialog {"
		  "key = \"title\";"
		  "label = \"\";"
		  ": row {"
		      ": column {"
		        "fixed_width = true;"
		        ": row {"
		        ": column {"
		          " spacer;"
		           ": image {"
		              "key = \"mip_image\";"
		              "width = 5.42;"
		              "height = 2.51;"
		              "fixed_width = true;"
		              "fixed_height = true;"
		              "aspect_ratio = 1;"
		              "color = -15;"
		            "}"
		            "spacer;"
		          "}"
		        ": column {"
		            "spacer;")
	    
		      tmp
	    (list "spacer;"
		        "}"
		       " }"
		     " }"
		  "spacer;"
		  "}"
		  ": row {"
		    "fixed_width = true;"
		    "alignment = centered;"
		     ": button {"
		     "is_default = true;"
		      "key = \"OK\";"
		      (strcat "label = \"" Button1$ "\";")
		  "}"
		  ": button {"
		  "is_cancel = true;"
		  "key = \"Cancel\";"
		  (strcat "label = \"" Button2$ "\";")
		  "}"
		  "}"
		  "}"
		  )
	    )
	  )
	    
    (setq ret (close ret))
  (setq DCL_ID% (load_dialog fl))
    (if (not (new_dialog "MIPTemp" DCL_ID%))
    (exit)
  ) ;_ end of if

  (if (= TITLE$ "")(setq TITLE$ "AutoCAD Message")) ;_ end of if
    (set_tile "title" (strcat " " TITLE$))

  (setq i 0)
  (repeat (length MSG$)
    (set_tile (strcat "msg" (itoa i))(nth i MSG$))
    (setq i (1+ i))
    )
    (if (/= ICON$ "none")
    (eval (read (strcat "(" ICON$ ":)")))
  ) ;_ end of if
   (action_tile "OK" "(done_dialog 1)")
   (action_tile "Cancel" "(done_dialog 2)")
   (setq CHOICE# (start_dialog))
   (unload_dialog DCL_ID%)
  (vl-file-delete fl)
   (if (= CHOICE# 1)
	   BUTTON1$
	   BUTTON2$
    ) ;_ end of if
  )
;;;(defun cts:msg-yes-no ( title message / usri1 ret)
;;;(setq usri1 (getvar "USERI1"))
;;;(SETVAR "USERI1" 0)
;;;(command "_vbastmt"
;;;(strcat "ThisDrawing.SetVariable \"USERI1\", "
;;;"MsgBox \(\""
;;;message
;;;"\","
;;;(itoa vlax-VBYesNo)
;;;",\""
;;;title
;;;"\"\)"
;;;)
;;;)
;;;(setq ret (= (getvar "USERI1") 6))
;;;(SETVAR "USERI1" usri1)
;;;ret	 
;;;)
(defun EXCLAM: ()
  (start_image "mip_image")
  (VECTOR_LINE
    (list "C" 2	  2   25  2   28  3   29  3   23  "C" 2	  4   21  4   29  5   29
	  5   19  "C" 2	  6   17  6   29  7   29  7   15  "C" 2	  8   13  8   29
	  9   29  9   11  "C" 2	  10  9	  10  29  11  29  11  7	  "C" 2	  12  5
	  12  29  13  29  13  18  "C" 2	  13  3	  13  9	  14  9	  14  2	  15  2
	  15  9	  16  9	  16  3	  17  4	  17  9	  "C" 2	  14  21  14  22  16  22
	  16  21  17  22  17  18  "C" 2	  14  27  14  29  15  29  15  27  16  27
	  16  29  17  29  17  27  "C" 2	  18  6	  18  29  19  29  19  8	  "C" 2
	  20  10  20  29  21  29  21  12  "C" 2	  22  14  22  29  23  29  23  16
	  "C" 2	  24  18  24  29  25  29  25  20  "C" 2	  26  22  26  29  27  28
	  27  24  "C" 2	  28  27  28  26
	 ) ;_ end of list
  ) ;_ end of vector_line
  (VECTOR_LINE
    (list "C" 54  3   30  1   28  1   25  2   24  2   23  3   22  3   21  4   20
	  4   19  5   18  5   17  6   16  6   15  7   14  7   13  8   12  8   11
	  9   10  9   9	  10  8	  10  7	  11  6	  11  5	  12  4	  12  3	  14  1
	  16  1	  "C" 54  13  16  13  16  "C" 54  14  19  14  19  "C" 54  16  19
	  16  19  "C" 54  17  16  17  16
	 ) ;_ end of list
  ) ;_ end of vector_line
  (VECTOR_LINE
    (list "C" 9	  13  10  13  10  "C" 9	  17  10  17  10  "C" 9	  13  17  13  17
	  "C" 9	  17  17  17  17  "C" 9	  14  20  14  20  "C" 9	  16  20  16  20
	  "C" 9	  14  23  14  23  "C" 9	  17  23  17  23  "C" 9	  14  26  14  26
	  "C" 9	  17  26  17  26  "C" 9	  16  2	  17  3	  "C" 9	  18  5	  18  5
	  "C" 9	  19  7	  19  7	  "C" 9	  20  9	  20  9	  "C" 9	  21  11  21  11
	  "C" 9	  22  13  22  13  "C" 9	  23  15  23  15  "C" 9	  24  17  24  17
	  "C" 9	  25  19  25  19  "C" 9	  26  21  26  21  "C" 9	  27  23  27  23
	  "C" 9	  28  25  28  25  "C" 9	  28  28  27  29
	 ) ;_ end of list
  ) ;_ end of vector_line
  (VECTOR_LINE
    (list "C" 250 13  15  13  11  14  10  14  18  "C" 250 15  21  15  10  16  10
	  16  18  "C" 250 17  11  17  15  "C" 250 14  25  14  24  15  23  15  26
	  16  26  16  23  17  24  17  25  "C" 250 4   30  27  30  29  28  29  25
	  28  24  28  23  27  22  27  21  26  20  26  19  25  18  25  17  24  16
	  24  15  23  14  23  13  22  12  22  11  21  10  21  9	  20  8	  20  7
	  19  6	  19  5	  18  4	  18  3	  17  2
	 ) ;_ end of list
  ) ;_ end of vector_line
  (VECTOR_LINE
    (list "C" 8	  32  27  32  30  30  32  6   32  5   31  30  31  31  30  31  25
	  30  25  30  30  28  30  29  29  "C" 8	  19  3	  19  4	  20  4	  20  6
	  21  5	  21  8	  22  7	  22  10  23  9	  23  12  24  11  24  14  25  13
	  25  16  26  15  26  18  27  17  27  20  28  19  28  22  29  21  29  24
	  30  23  30  24
	 ) ;_ end of list
  ) ;_ end of vector_line
  (end_image)
) ;_ end of defun

;; Pablished ShaggyDoc http://dwg.ru/f/showthread.php?t=21492&page=2
(defun ru-textstyle-update
       (style / ent_name ent_data old_style style_angle style_width tbe _modify-style)
  (defun _modify-style (style_name
                        new_style_name
                        ent_data
                        style_width
                        style_angle
                        /
                        ent_type
                       )
    (setq ent_type (cdr (assoc 0 ent_data)))
    (if (and (or (= "TEXT" ent_type)
                 (= "ATTRIB" ent_type)
                 (= "ATTDEF" ent_type)
             ) ;_ end of or
             (or (= "*" style_name)
                 (= (strcase style_name)(strcase (cdr (assoc 7 ent_data))))
             ) ;_ end of or
        ) ;_ end of and
      (entmod (subst (cons 51 style_angle)
                     (assoc 51 ent_data)
                     (subst
                       (cons 41 style_width)
                       (assoc 41 ent_data)
                       (subst
                         (cons 7 new_style_name)
                         (assoc 7 ent_data)
                         ent_data
                       ) ;_ end of subst
                     ) ;_ end of subst
              ) ;_ end of subst
      ) ;_ end of entmod
    ) ;_ end of if
  ) ;_ end of defun
  ;; размеры
  (princ
    (if (= (getvar "DWGCODEPAGE") "ANSI_1251")
      (strcat "Ждите, привожу стиль\n '" style "' к определению...\n")
      (strcat "Wait, I result style \n  '" style "' in definition ...\n")
      )
      
  ) ;_ end of princ
  (setq ent_name    (tblnext "DIMSTYLE" t)
        old_style   (tblobjname "STYLE" style)
        tbe         (entget old_style)
        style_width (cdr (assoc 41 tbe))
        style_angle (cdr (assoc 50 tbe))
  ) ;_ end of setq
  (while ent_name
    (setq ent_data (entget (tblobjname "DIMSTYLE" (cdr (assoc 2 ent_name)))))
    (if (or
          (= "*" style)
          (= old_style (cdr (assoc 340 ent_data)))
        ) ;_ end of or
      ;; (print
      (entmod
        (subst
          (cons 340 old_style)
          (assoc 340 ent_data)
          ent_data
        ) ;_ end of subst
      ) ;_ end of entmod
    ) ;_ end of if
    (entupd (cdr (assoc -1 ent_data)))
    (setq ent_name (tblnext "DIMSTYLE"))
  ) ;_ end of while
  
  ;; блоки
  ;|
  (setq ent_name (tblnext "BLOCK" t))
  (while ent_name
    (setq ent_data (cdr (assoc -2 ent_name)))
    (while ent_data
      (setq ent_data (entget ent_data))
      (_modify-style style style ent_data style_width style_angle)
      (setq ent_data (entnext (cdr (assoc -1 ent_data))))
    ) ;_ end of while
    (setq ent_name (tblnext "BLOCK"))
  ) ;_ end of while
  |;
  ;;;Modyfied VVA 2010-03-09
  (vlax-for Blk (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))
    (if (= (vla-get-isxref Blk) :vlax-false)
      (progn
        (vlax-for Obj Blk
          (setq ent_data (entget (vlax-vla-object->ename Obj)))
          (_modify-style style style ent_data style_width style_angle)
          )
        )
      )
    )
  ;; примитивы
  (setq ent_name (entnext))
  (while ent_name
    (_modify-style style style (entget ent_name) style_width style_angle)
    (entupd ent_name)
    (setq ent_name (entnext ent_name))
  ) ;_ end of while
) ;_ end of defun

(defun cts:layer-status-restore ()
    (foreach item *PD_LAYER_LST*
      (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))))
             ) ;_ end of lambda
          ) ;_ end of vl-catch-all-apply
        ) ;_ end of if
      ) ;_ end of foreach
    (setq *PD_LAYER_LST* nil)
    ) ;_ end of defun

  (defun cts:layer-status-save ()
    (setq *PD_LAYER_LST* nil)
    (vlax-for item (vla-get-layers (vla-get-activedocument (vlax-get-acad-object)))
      (setq *PD_LAYER_LST* (cons (list item
                                  (cons "freeze" (vla-get-freeze item))
                                  (cons "lock" (vla-get-lock item))
                                  ) ;_ end of cons
                            *PD_LAYER_LST*
                            ) ;_ end of cons
            ) ;_ end of setq
      (vla-put-lock item :vlax-false)
      (if (= (vla-get-freeze item) :vlax-true)
      (vl-catch-all-apply '(lambda () (vla-put-freeze item :vlax-false))))
      ) ;_ end of vlax-for
    ) ;_ end of defun


;Extensions:
;It is possible to add bulged segments too by extending the data structure "segment" with (p1 p2 bulge) for curved segments and use a line-arc resp. arc-arc intersection method for those. Then a straight segment is still representable with (p1 p2) 
;line-arc and arc-arc intersection methods are e.g. in GLNADS.C of the AutoCAD SDK 2.0 and may be easily ported to AutoLISP. Another method is with VLA where it is possible to use (vla-intersect-with obj1 obj2), which works with curves and splines too. 
;;Posted by T.Willey 
;;http://www.theswamp.org/index.php?topic=14247.15
;;Обработка всех примитивов рисунка через VLA
;; Doc - vla указатель на обрабатываемый документ
;; StyName - имя стиля
;; Ignore_Style_List - список игнорируемых стилей или nil
;; Unformat t - снос форматирования nil - нет
(defun ChangeAllTextObjectsStyle (Doc StyName Ignore_Style_List Unformat / tempObjType IsLo ColCnt RowCnt)
(vlax-for Blk (vla-get-Blocks Doc)
 (setq IsLo (if (= (vla-get-IsLayout Blk) :vlax-true) T nil))
 (if (and (= (vla-get-IsXref Blk) :vlax-false)
	  (not (wcmatch (vla-get-Name blk) "*|*"))  ;;;thanks Sleekka
	  )
  (vlax-for Obj Blk (setq tempObjType (vla-get-ObjectName Obj))
   (vl-catch-all-apply '(lambda()
;_REM VVA 2016-04-20                          
;;;   (if (and Unformat (vlax-property-available-p Obj 'Textstring))
;;;     (vla-put-Textstring Obj (substr (apply 'strcat (mapcar '(lambda(x)(strcat "\\P" x))
;;;     (mapcar 'mip_MTEXT_Unformat (str-str-lst (vla-get-Textstring Obj) "\\P")))) 3)))

;_ADD VVA 2016-04-20     QWEASDZXC                     
(if (and Unformat
         (vlax-property-available-p Obj 'Textstring)
         (not(member (vla-get-StyleName Obj) Ignore_Style_List))
         )
     (vla-put-Textstring Obj (substr (apply 'strcat (mapcar '(lambda(x)(strcat "\\P" x))
     (mapcar 'mip_MTEXT_Unformat (str-str-lst (cts:get-TextString (vlax-vla-object->ename Obj)) "\\P")))) 3)))
                          
   (cond
    ((vl-position tempObjType '("AcDbMLeader"))
     (if (not(member (vla-get-StyleName Obj) Ignore_Style_List))
     (vla-put-TextStyleName Obj StyName))
     ) 
    ((vl-position tempObjType '("AcDbText" "AcDbMText" "AcDbAttributeDefinition"))
     (if (not(member (vla-get-StyleName Obj) Ignore_Style_List))
     (vla-put-StyleName Obj StyName))
     ;;;(if (not IsLo)(vla-put-Layer Obj "0"))
     )
    ((wcmatch tempObjType "AcDb*Dimension")
     (if (not(member (vla-get-textstyle Obj) Ignore_Style_List))
     (vla-put-TextStyle Obj StyName))
     )
    ((= tempObjType "AcDbBlockReference")
     (foreach Att (vlax-invoke Obj 'GetAttributes)
       (if (not(member (vla-get-StyleName Att) Ignore_Style_List))
      (vla-put-StyleName Att StyName)))
     (foreach Att (vlax-invoke Obj 'GetConstantAttributes)
       (if (not(member (vla-get-StyleName Att) Ignore_Style_List))
      (vla-put-StyleName Att StyName))))
    ((= tempObjType "AcDbTable")(setq ColCnt 0)
     (vla-put-RegenerateTableSuppressed Obj :vlax-true)
     (repeat (vla-get-Columns Obj)(setq RowCnt 0)
      (repeat (vla-get-Rows Obj)
	(if (not(member (vla-GetCellTextStyle Obj RowCnt ColCnt) Ignore_Style_List))
	(vlax-invoke Obj 'SetCellTextStyle RowCnt ColCnt StyName))
        (vla-settext
	      Obj
	      RowCnt
	      ColCnt
	      (mip_MTEXT_Unformat (vla-gettext Obj RowCnt ColCnt))
	    )
       (setq RowCnt (1+ RowCnt)))
      (setq ColCnt (1+ ColCnt)))
     (vla-put-RegenerateTableSuppressed Obj :vlax-false)
	(vla-update Obj)
     ))))))))
;;;================================================================================
;;;Written By Michael Puckett. 
;;;Список элементов символьных таблиц АвтоКАДа 
;;; - s- имя таблицы
;;;Пример - список всех слоев - (setq all_layers (tablelist "LAYER"))
;;;(setq all_layers (tablelist "LAYER"))
;;;
;;;AutoLisp should return something like this :
;;;Start Coding Here 
(defun tablelist (s / d r)
  (while (setq d (tblnext s (null d)))
    (setq r (cons (cdr (assoc 2 d)) r))))
;;;End Coding Here

(vl-load-com)

(defun mip_MTEXT_Unformat ( Mtext / text Str )
  ;;;http://www.caduser.ru/forum/index.php?PAGE_NAME=read&FID=44&TID=20992
  (setq Text "")
;;;  (if (wcmatch (strcase Mtext) "\\PI-#*,\\PT*") ;;_список
;;;    (setq Mtext (substr Mtext (+ 2 (vl-string-search ";" Mtext)))))
   (while (/= Mtext "")
        (cond
          ((wcmatch (strcase (setq Str (substr Mtext 1 2))) "\\[\\{}]")
            (setq Mtext (substr Mtext 3) Text   (strcat Text Str)))
          ((wcmatch (substr Mtext 1 1) "[{}]")(setq Mtext (substr Mtext 2)))
          ((wcmatch (strcase (setq Str (substr Mtext 1 2))) "\\[LO`~]")
	   (setq Mtext (substr Mtext 3)))
          ((wcmatch (strcase (substr Mtext 1 8)) "\\FSYMBOL") ;;;Add VVA remove Symbol
            (setq Mtext (substr Mtext (+ 2 (cond ((vl-string-search "}" Mtext))((vl-string-search ";" Mtext)))))))
          ((wcmatch (strcase (substr Mtext 1 2)) "\\[ACFHQTW]")
            (setq Mtext (substr Mtext (+ 2 (vl-string-search ";" Mtext)))))
	  ((wcmatch (strcase Mtext) "\\PI-#*,\\PT*")           ;;;VVA 2011-01-20
	   (setq Mtext (substr Mtext (+ 2 (vl-string-search ";" Mtext)))))
	  ((wcmatch (strcase (substr mtext 1 4)) "\\PQ[CRJD],\\PTZ")  ;;;Add by KPblC
	   (setq mtext (substr mtext (+ 2 (vl-string-search ";" mtext))))
	   )
          ((wcmatch (strcase (substr mtext 1 3)) "\\PX")  ;;;абзац и междустрочный интервал \\PX[QITSBA]
	   (setq mtext (substr mtext (+ 2 (vl-string-search ";" mtext))))
	   )
          ((wcmatch (strcase (substr Mtext 1 2)) "\\P")
            (if (or
		   (zerop (strlen Text))
		   (= " " (substr Text (strlen Text)))
		   (= " " (substr Mtext 3 1)))
               (setq Mtext (substr Mtext 3))
               (setq Mtext (substr Mtext 3) Text (strcat Text " "))))
	  ((wcmatch (strcase (substr Mtext 1 2)) "\\S")
            (setq Str   (substr Mtext 3 (- (vl-string-search ";" Mtext) 2))
                  Text  (strcat Text (vl-string-translate "#^\\" "/^\\" Str))
                  Mtext (substr Mtext (+ 4 (strlen Str)))))
          
	  (t (setq Text (strcat Text (substr Mtext 1 1)) Mtext (substr Mtext 2)))))
  Text)
;|=============================================================================
*    Функция удаления форматирования на выбранных элементах
=============================================================================|;
;;; mtext unformat
(defun cts-unf-mtext ( / selset item  _answer_ layer_set_list layer_status_list *error* col row)
  ;; Локальные функции
  ;; Обработчик ошибок
  (defun *error* (msg)
    (princ msg)
    ;; Завершение активных команд
    (while (/= (getvar "cmdactive") 0)(command))
    (cts:layer-status-restore)
    (vla-endundomark *activedoc*)) ;_ end of defun
  (vl-load-com)
  (initget "вЕсь Выбор _ All Selection")
  (setq  _answer_ (getkword
         "Обрабатывать объем [вЕсь файл/Выбор] ? <Весь файл> : "
         ) ;_ end of getkword
    ) ;_ end of setq
  (or *activedoc*
    (setq *activedoc* (vla-get-activedocument (vlax-get-acad-object))))
  (vla-startundomark *activedoc*)
  (if (= _answer_ "Selection")
    (setq selset (ssget '((0 . "MTEXT,ACAD_TABLE"))))
    (setq selset (ssget "_X" '((0 . "MTEXT,ACAD_TABLE"))))
    ) ;_ end of if
  (cts: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-SetCellState item row col acCellStateNone)
            (vla-settext item row col (mip_MTEXT_Unformat (vla-gettext item row col)))
            (setq row (1+ row))
            )
          (setq col (1+ col))
          )
        (vla-put-RegenerateTableSuppressed item :vlax-false)
        (vla-update item)
        )
      (if (vlax-property-available-p item "TextString")
        (vlax-put-property item "TextString"
          (mip_MTEXT_Unformat (vlax-get-property item "TextString")))
        )
      )
    ) ;_ end of while
  (cts:layer-status-restore)
  (vla-endundomark *activedoc*)
  ) ;_ end of defun

;;Change Text Style  
(defun CTS ( unformat / st *error* ignore_style)
    (defun *error* (msg)(princ msg)(cts:layer-status-restore)(princ))
  (cts:layer-status-save)
(and
  (setq st (ACAD_STRLSORT(vl-remove-if-not '(lambda(x)(snvalid x))(tablelist "STYLE"))))
  (or
  (setq ignore_style (_DWGRU-GET-USER-DCL (if (= (getvar "DWGCODEPAGE") "ANSI_1251") "Выберите игнорируемые стили или жми ОТМЕНА" "Select ignore style or press Cancel") st  t))
  t
  )
  (or
  (mapcar '(lambda(x)(setq st (vl-remove x st))) ignore_style)
  t)
  st
  (setq st (_DWGRU-GET-USER-DCL (if (= (getvar "DWGCODEPAGE") "ANSI_1251") "Выберите назначаемый стиль" "Select target style") st  nil))
  (setq st (car st))
  (ChangeAllTextObjectsStyle (vla-get-activedocument (vlax-get-acad-object)) st ignore_style unformat))
  (cts:layer-status-restore)
   (princ)
  )
;;Change Text Style  
(defun C:CTS ()(cts nil))
;;Change Text Style with Unformat text
(defun C:CTSU ()(cts t))
(defun C:UNF-MTEXT ()(cts-unf-mtext))
;;; Text Style Update
(defun C:TSUP ( / *error* )
  (defun *error* (msg)(princ msg)(cts:layer-status-restore)(princ))
  (cts:layer-status-save)
  (if
  (cts:msg-yes-no (if (= (getvar "DWGCODEPAGE") "ANSI_1251") "ИЗМЕНЕНИЕ СТИЛЕЙ!!!!" "CHANGE STYLES!!!!")
    (if (= (getvar "DWGCODEPAGE") "ANSI_1251")
    (strcat
        "\nПроизводится изменение начертания всех существующих \nТЕКСТОВ, АТРИБУТОВ \nво ВСЕХ примитивах, включая блоки, \nвыбранного стиля!"
        "\n\nУстанавливается по определению стиля\n начертание, сжатие, угол наклона"
        "\nПользоваться осторожно!\nБудем делать?"
      ) ;_ end of strcat
      (strcat
        " \nChange of a tracing of all existing \n TEXTS, ATTRIBUTES \n in ALL entities, including blocks, \n the chosen style Is made! "
        " \n \nThe tracing, compression, a corner of an inclination \n Is established by definition of style \n"
        " \nTo use cautiously! \n we Shall do?"
	); _ end of strcat
      )
    )
  (progn
    (foreach style (_DWGRU-GET-USER-DCL (if (= (getvar "DWGCODEPAGE") "ANSI_1251") "Выберите стиль" "Select style") (ACAD_STRLSORT(vl-remove-if-not '(lambda(x)(snvalid x))(tablelist "STYLE"))) t)
      (ru-textstyle-update style)
       ) ;_ end of foreach
    )
  )
  (cts:layer-status-restore)
  (princ)
  )
(if (= (getvar "DWGCODEPAGE") "ANSI_1251")
  (princ "\nНаберите CTSU, CTS,UNF-MTEXT или TSUP в командной строке")
  (princ "\nType CTSU, CTS, UNF-MTEXT or TSUP in command line")
  )
  (princ)

;;====================================================================

(defun cts:get-TextString (ent / elst str)
  ;;; ent -entity name
  ;;; return - text string
    (setq elst (entget ent))
  (if (vlax-property-available-p (vlax-ename->vla-object ent) 'Textstring)
    (cond ((= (cdr(assoc 0 elst)) "MULTILEADER")
	   (if (and
                 (cdr (assoc 360 elst));_VVA 2015-05-23
                 (dictsearch (cdr (assoc 360 elst)) "ACAD_FIELD") ;;; (BG:FIELDCODE ent) ;;;VVA 2015-03-27
                 )
	     (setq str (vla-get-TextString (vlax-ename->vla-object ent)))
	     (setq str (cdr(assoc 304 elst)))
	     )
           )
          ((and ;;; MTEXT ATTRIB ADD VVA 2011-20-27
             (member (cdr(assoc 0 elst)) '("ATTRIB"))
             (member '(101 . "Embedded Object") elst)
             )
           (setq str (apply 'strcat (append (cts:massoc 3 elst)(cts:massoc 1 (member '(101 . "Embedded Object") elst)))))
           )
          
          ((member (cdr(assoc 0 elst)) '("TEXT" "MTEXT" "ATTRIB"))
           (setq str (apply 'strcat (append (cts:massoc 3 elst)(cts:massoc 1 elst))))
           )
          (t (setq str (vla-get-TextString (vlax-ename->vla-object ent))))
    )
    )
str
  )
(defun cts:massoc (key alist)
  ;;;lib:massoc mip_lib.lsp
  (mapcar 'cdr (vl-remove-if-not (function (lambda (x) (= key (car x)))) alist)))

(princ "\nchange text styles (cts) ver 1.9 loaded ")(princ)

[SultanovNS]

posetitel большое спасибо!