Скрипт для создания "нового стиля текста" Civil3D

@Егор84 · Регистрация: 15.08.2018

Студворк — интернет-сервис помощи студентам

Добрый вечер господа сочувствующие. Может кто сталкивался: среди сотен листов каждый раз нужно создавать один и тот же тип стиля текста для подписи высот. Пытался реализовать через запись скрипта встроенными средствами( Управление->запись макроса). Но на каждом новом листе просто вылазит окно стили текста без ранее заданных параметров - Шрифта/Высота текста/Названия нового стиля. Буду рад любому совету или помощи.

@Егор84 · 03.02.2023, 16:38 **[ТС]**

Простите я не силён в VBA - скопировал код -> нажал F5. Та же ошибка. Передвинул курсор -> f5 -> ошибка .

@Dinoxromniy · 03.02.2023, 16:42

Сообщение от Егор84

Простите я не силён в VBA

попробуйте в командной строке написать _VBARUN и пробел, потом он запросит имя макроса - соответственно pocket

@Егор84 · 04.02.2023, 09:51 **[ТС]**

Та же история ... Выполнил из командной строки -> Expected End sub

@Dinoxromniy · 04.02.2023, 09:55

Егор84, добавьте в конце последней процедуры end sub

@Егор84 · 04.02.2023, 10:10 **[ТС]**

Скрипт для создания "нового стиля текста" Civil3D

@Dinoxromniy · 04.02.2023, 10:40

Егор84, попробуйте закрыть civil, очистить папку temp (по идее - в C:\Users\_ваше_имя_\AppData\Local\Temp\), открыть снова и создать новый документ. Код должен работать.

@Егор84 · 04.02.2023, 11:18 **[ТС]**

Нашёл причину -> нужно в главном окне модели обязательно активировать изменяемый объект. Но тут же всплыл второй баг-> в заданных параметрах стиля высота текста вместо целого значения остаются стандартные настройки. А так же стили не прописываются в окно аннотации с водимыми в скрипте параметрами -> :
Sub pocket()
Call dwg_add_style("Coord", "Arial.ttf", 20, 0, 1)
Call dwg_add_style("DepthINT", "AIGDT.ttf", 20, 0, 1)
Call dwg_add_style("DepthFLOAT", "AIGT.ttf", 16, 0, 1)

End Sub

Sub dwg_add_style(ByVal nameOfStyle As String, setfontFile As String, setheight As Double, setObliqueAngle As Double, setwidth As Double)

Dim styOb As AcadTextStyle
For Each styOb In ActiveDocument.TextStyles
If styOb.Name = nameOfStyle Then Exit Sub
Next styOb
ThisDrawing.TextStyles.Add (nameOfStyle)
ThisDrawing.TextStyles.Item(nameOfStyle) .fontFile = setfontFile
ThisDrawing.TextStyles.Item(nameOfStyle) .ObliqueAngle = setObliqueAngle * 3.141592654 / 180
ThisDrawing.TextStyles.Item(nameOfStyle) .Height = setheight
ThisDrawing.TextStyles.Item(nameOfStyle) .Width = setwidth

End Sub

@Dinoxromniy · 05.02.2023, 07:44

Сообщение от Егор84

нужно в главном окне модели обязательно активировать изменяемый объект.

Ничего не понял.

Сообщение от Егор84

AIGDT.ttf

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

@Егор84 · 12.02.2023, 07:51 **[ТС]**

Если не трудно можно привести примеры макрокоманды ( -СТИЛЬ имя txt 0 1 0 н н н) при решаемой задачи Шрифт Arial - высота 20 - наклон и центрирование отсутствует.

Новые блоги и статьи Все статьи Все блоги /
Запустил конкурс "тем и промптов для текстовых квестов созданных почти чисто ИИ" Adler 06.10.2026 Всем привет! За последние три-четыре дня я создал более 16 текстовых квестовых игр используя преимущественно по одному запросу к ИИ на игру. Мне так понравилось смотреть все ветки/ сцены во всех. . .	ИИ не может найти нужный язык в списке Supersumestria 05.10.2026 Я ему даю вот такое изображение и прошу найти и подчеркнуть немецкий язык. Возвращает он вот это: https:/ / i. **********/ vqBWLe2. png Нужную строчку в 3й колонке просто выдумал. . Это. . .	Новая последняя моя музыка в SUNO zorxor 05.10.2026 Здравствуйте, дорогие мои друзья! С большой радостью я хотел бы представить вам свою новую последнею музыку, которую сгенерировала мне по моей просьбе нейросеть SUNO. С уважением, zorxor. Это. . .	Программный домашний кинотеатр russiannick 27.09.2026 Сподобился на программный домашний кинотеатр. В качестве ЯВУ по традиции выбрал js. В помощники взял Яндекс-Алису. Было создано три зала на разные интересы. исторические и ретро сериал Хичкок. . .
Беседа с ИИ о программистах, недопускающих к созданию и правке кода генеративные ИИ и причины этого zorxor 21.09.2026 Раньше я радовался или получал некоторые эмоции, пусть небольшие, но всё же, от самого процесса написания кода, рекомпиляции и запуска, видя постепенное развитие программы и прочее. А теперь лень. . .	Мобильное приложение ColorStep pavlinmavlin 17.09.2026 Реализовал приложение Красный, Зеленый, Синий в Unity3d + c#. Название изменил на ColorStep. Приложение прошло модерацию и теперь доступно для скачивания. Делал его сам, шаг за шагом — и вот,. . .	Запрет дублирования строк в табличной части Maks 13.09.2026 Реализация из решения ниже выполнена на нетиповом справочнике "Нормы ТО" с табличной часть "Виды ТО", разработанного в КА2, со следующими реквизитами: - ВидТО (СправочникСсылка. ВидыТО); - ВидГСМ. . .	Скрипты Tampermonkey для CyberForum, ChatGPT, Claude и пр. Jin X 06.09.2026 Скрипты Tampermonkey для CyberForum, ChatGPT, Claude и пр. Работая с форумом и нейросетями в браузере часто хочется что-то подкорректировать или добавить какого-то функционала. Ниже прикреплён. . .

@Егор84 0 / 0 / 0 Регистрация: 15.08.2018 Сообщений: 117

	Скрипт для создания "нового стиля текста" Civil3D 01.02.2023, 17:18. Показов 3432. Ответов 28 Метки нет (Все метки) Добрый вечер господа сочувствующие. Может кто сталкивался: среди сотен листов каждый раз нужно создавать один и тот же тип стиля текста для подписи высот. Пытался реализовать через запись скрипта встроенными средствами( Управление->запись макроса). Но на каждом новом листе просто вылазит окно стили текста без ранее заданных параметров - Шрифта/Высота текста/Названия нового стиля. Буду рад любому совету или помощи. 0

@Егор84 0 / 0 / 0 Регистрация: 15.08.2018 Сообщений: 117
	03.02.2023, 16:38 [ТС]
	Простите я не силён в VBA - скопировал код -> нажал F5. Та же ошибка. Передвинул курсор -> f5 -> ошибка . 0

@Егор84 0 / 0 / 0 Регистрация: 15.08.2018 Сообщений: 117
	04.02.2023, 09:51 [ТС]
	Та же история ... Выполнил из командной строки -> Expected End sub Миниатюры 0

@Dinoxromniy Динохромный 1640 / 777 / 288 Регистрация: 22.12.2015 Сообщений: 2,432
	04.02.2023, 09:55
	Егор84, добавьте в конце последней процедуры `end sub` 0

@Егор84 0 / 0 / 0 Регистрация: 15.08.2018 Сообщений: 117
	04.02.2023, 10:10 [ТС]
	0

@Dinoxromniy Динохромный 1640 / 777 / 288 Регистрация: 22.12.2015 Сообщений: 2,432
	04.02.2023, 10:40
	Сообщение было отмечено Егор84 как решение Решение Егор84, попробуйте закрыть civil, очистить папку temp (по идее - в C:\Users\_ваше_имя_\AppData\Local\Temp\), открыть снова и создать новый документ. Код должен работать. 1

@Егор84 0 / 0 / 0 Регистрация: 15.08.2018 Сообщений: 117
	04.02.2023, 11:18 [ТС]
	Нашёл причину -> нужно в главном окне модели обязательно активировать изменяемый объект. Но тут же всплыл второй баг-> в заданных параметрах стиля высота текста вместо целого значения остаются стандартные настройки. А так же стили не прописываются в окно аннотации с водимыми в скрипте параметрами -> : Sub pocket() Call dwg_add_style("Coord", "Arial.ttf", 20, 0, 1) Call dwg_add_style("DepthINT", "AIGDT.ttf", 20, 0, 1) Call dwg_add_style("DepthFLOAT", "AIGT.ttf", 16, 0, 1) End Sub Sub dwg_add_style(ByVal nameOfStyle As String, setfontFile As String, setheight As Double, setObliqueAngle As Double, setwidth As Double) Dim styOb As AcadTextStyle For Each styOb In ActiveDocument.TextStyles If styOb.Name = nameOfStyle Then Exit Sub Next styOb ThisDrawing.TextStyles.Add (nameOfStyle) ThisDrawing.TextStyles.Item(nameOfStyle) .fontFile = setfontFile ThisDrawing.TextStyles.Item(nameOfStyle) .ObliqueAngle = setObliqueAngle * 3.141592654 / 180 ThisDrawing.TextStyles.Item(nameOfStyle) .Height = setheight ThisDrawing.TextStyles.Item(nameOfStyle) .Width = setwidth End Sub Миниатюры 0

@Егор84 0 / 0 / 0 Регистрация: 15.08.2018 Сообщений: 117
	12.02.2023, 07:51 [ТС]
	Если не трудно можно привести примеры макрокоманды ( -СТИЛЬ имя txt 0 1 0 н н н) при решаемой задачи Шрифт Arial - высота 20 - наклон и центрирование отсутствует. 0

Скрипт для создания "нового стиля текста" Civil3D

Решение