Перейти к содержанию

Замена шрифта во всех стилях документа (скрипт VBS)


Рекомендуемые сообщения

Добрый день!

Делаю первые шаги в программировании.

 

Нашел скрипт для AutoCAD для замены шрифтов во всех стилях:

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

Set TSs = ThisDrawing.TextStyles

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

End Sub
 

Попытался доработать его для запуска в nanoCAD:

Sub FontChange()
Dim TS As IAcadTextStyle
Dim TSs As IAcadTextStyles

Set TSs = ThisDrawing.TextStyles

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

End Sub

FontChange.vbs

Не работает(((

При нажатии кнопки "Запустить скрипт" в редакторе, ничего не происходит.

При вызове команды VBS и выборе файла данного скрипта пишет:

vbs - Загрузка VBSerr: "Ошибка компиляции Microsoft VBScript" raised an exception "Предполагается наличие окончания инструкции" at line 2 pos 7

Dim TS As IAcadTextStyle

       ^

Подскажите, что не так делаю?

Ссылка на сообщение
Поделиться на другие сайты
2 часа назад, AlExTs сказал:

Подскажите, что не так делаю?

не надо в скрипте использовать раннее связывание,

смотри как в примере объявлены переменные

star.vbs

это лишнее в скрипте

добавлено через 5 минут
Sub FontChange()
.....
End Sub

 

Так нада

Dim TSs, TS 
Set TSs = ThisDrawing.TextStyles
For Each TS In TSs
TS.fontFile = "CS_Gost2304A.shx"
Next

не забыть обновить чертежик

Изменено пользователем doctorraz
Ссылка на сообщение
Поделиться на другие сайты
7 минут назад, Boroda888 сказал:

А как на ttf поменять? Не видит скрипт их... ((

видит, просто надо не по имени шрифта, а по названию файла шрифта

для Times New Roman

TS.fontFile = "times.ttf"

 

Изменено пользователем doctorraz
Ссылка на сообщение
Поделиться на другие сайты
Только что, Boroda888 сказал:

Не получилось... тупо сбрасывает в SHX (((

хех пишет, что shx

Спойлер

image.thumb.png.b8a6cba1adaa3eb5065218b5c6778f18.png

но такого шрифта нет в нана..

по виду однозначно таймс

и если сделать педееф, то текст выделяется.. и копируется

---------------

мож разработчики чего подскажут?????

Ссылка на сообщение
Поделиться на другие сайты
13 минут назад, Boroda888 сказал:

Вот то то и оно.... как в кино: Красный а пахнет как зеленый )))

шрифт однозначно подставляется..

он однозначно ttf и по виду и по поведению в PDF (выделяется и копируется)

а вот, что там нана в стилях понапридумывала и написала, это вопрос к разработчикам. нет такого shx)))

Надо тему в "Дефектах" открывать по багу.

Ссылка на сообщение
Поделиться на другие сайты
4 часа назад, AlExTs сказал:

Подскажите, что не так делаю?


1. На скриншоте "End Sub" прописан правильно, а в выложенном скрипте неправильно, слитно: "EndSub".

 

2. Процедура объявлена и описана, но в основном тексте скрипта она должна быть ещё и вызвана. Хотя в данном простом случае действительно можно обойтись без выделения отдельной процедуры.

Пример работающего скрипта с отладочными сообщениями в командной строке
Send_MSG.vbs
 

Ссылка на сообщение
Поделиться на другие сайты

У меня вот так в Эксель ВБА:

 

 

For i2 = 0 To doc.TextStyles.Count - 1
                    
                    Dim ts As AcadTextStyle
                    Set ts = doc.TextStyles.Item(i2)
                    
                    If ts.Name = "ГОСТ" Then
                    
                        If InStr(1, FontName, ".shx", 1) > 0 Then
                        
                            ts.fontFile = FontName
                            
                            If Italic Then
                            
                                ts.ObliqueAngle = 0.261799
                                oa = 0.261799
                                
                            Else
                            
                                ts.ObliqueAngle = 0#
                                oa = 0#
                                
                            End If
                        
                        Else
                        
                            ts.ObliqueAngle = 0#
                            oa = 0#
                            ts.SetFont FontName, False, Italic, 0, 0
                        
                        End If
                                        
                    End If
                    
                    Set ts = Nothing
                
                Next i2

Ссылка на сообщение
Поделиться на другие сайты
17 минут назад, Robink сказал:

У меня вот так в Эксель ВБА:

VBA и VBScript, возможно, работают не вполне одинаково.

Имея ...

Спойлер

image.png.3cb47dc3c8cba7e3667e9acef2220594.png

 

Применив скрипт ...

' Проверяем текстовые стили
Dim Ut4
Set Ut4 = ThisDrawing.Utility

Dim TS
Dim TSs

Set TSs = ThisDrawing.TextStyles

For Each TS In TSs
   'TS.fontFile = "Calibri.ttf"
   
   Ut4.Prompt("Name: " & TS.Name)
   Ut4.Prompt("BigFontFile: " & TS.BigFontFile)
   Ut4.Prompt("FontFile: " & TS.FontFile & vbCrLf)
Next

 

Получаем результат

Спойлер

image.png.6b51010aad95baeec64a35d5216ba712.png

 

 

Изменено пользователем A.Kudrjashov
Дополнения
Ссылка на сообщение
Поделиться на другие сайты
Спойлер

image.png.aba68e78ec4c41a7c10a417555d304b9.png

Спойлер

image.png.cebb90416175c1dd58a1dfb096781b86.png

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

Изменено пользователем doctorraz
Ссылка на сообщение
Поделиться на другие сайты

"... фигню пишет".

 

Когда по LISPу вопросы задавать начали, кто-то из разработчиков ответил: "А что LISPом ещё кто-то пользуется ?"
Видимо, здесь похожий случай.

P.S.
Кажется у Шекли есть рассказ о том как на некую планету сел космический корабль, из него вышли сверхразумные инопланетяне, погостили, пообщались и улетели. А, когда через некоторое время вернулись обратно, то увидели, что местные жители ходят с чем то на поясе по форме и цвету отдалённо напоминающим бластеры, но сделанные из цельного куска какого то местного материала.

А в глубине армянского пещерного комплекса есть вот такой барельеф. Ибо положено ! :)

Спойлер

image.thumb.png.1967ca04945467c9cd4b6cf7ea0e8658.png

 

Ссылка на сообщение
Поделиться на другие сайты
13 минут назад, A.Kudrjashov сказал:

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

 офф тонко:D

частенько муляжи попадаются)))

Изменено пользователем doctorraz
Ссылка на сообщение
Поделиться на другие сайты
1 час назад, A.Kudrjashov сказал:

VBA и VBScript, возможно, работают не вполне одинаково

Спойлер

image.thumb.png.0823f84c1f0f2e91bc7611b4678251c4.png

отсюда умыкнул

Изменено пользователем doctorraz
Ссылка на сообщение
Поделиться на другие сайты
2 минуты назад, doctorraz сказал:

VBA и VBScript, возможно, работают не вполне одинаково

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

Ссылка на сообщение
Поделиться на другие сайты
В 24.03.2021 в 11:48, doctorraz сказал:

не надо в скрипте использовать раннее связывание,

смотри как в примере объявлены переменные

star.vbs 659 \u0411 · 4 загрузки

это лишнее в скрипте

добавлено через 5 минут

Sub FontChange() ..... End Sub


Sub FontChange()
.....
End Sub

 

Так нада

Dim TSs, TS Set TSs = ThisDrawing.TextStyles For Each TS In TSs TS.fontFile = "CS_Gost2304A.shx" Next


Dim TSs, TS 
Set TSs = ThisDrawing.TextStyles
For Each TS In TSs
TS.fontFile = "CS_Gost2304A.shx"
Next

не забыть обновить чертежик

Спасибо огромное!

Ссылка на сообщение
Поделиться на другие сайты


... в завершение темы доступа к объекту описания текстовых стилей внешними средствами автоматизации.

Описание TrueType шрифтов безусловно куда-то пишется, вот только куда именно - сакральная тайна Разработчиков nanoCAD.

Итак, имеем набор текстовых стилей

Спойлер

image.png.1d757cef112b3ac242004c25d0767155.png

 

Попытка получить информацию при помощи Powershell

$nanoCAD = [Runtime.Interopservices.Marshal]::GetActiveObject('nanoCAD.Application')
$doc = $nanoCAD.ActiveDocument
$TSs = $doc.TextStyles
$TSs

 

Спойлер

image.thumb.png.b2578758c339d80a242f732953c1345b.png


Попытка получить информацию через LISP, прямо таки изнутри приложения nanoCAD !:

(setq eNameTxtSty (tblobjname "style" "Standard")) 
(setq theElist (entget eNameTxtSty)) 

(setq eNameTxtSty2 (tblobjname "style" "ГОСТ 2.304")) 
(setq theElist2 (entget eNameTxtSty2)) 

 

Спойлер

image.thumb.png.79ca689236e5289e9456cfdb05d2b098.png

 

Команда: (setq eNameTxtSty (tblobjname "style" "Standard")) 
#<Имя примитива: 0000000036391C40> SCRIPTED - Редактор скриптов... 
Команда: (setq theElist (entget eNameTxtSty)) 
((-1 . #<Имя примитива: 0000000036391C40>) (0 . "STYLE") (5 . "11") (102 . "{ACAD_XDICTIONARY") (360 . #<Имя примитива: 00000000411BC230>) (102 . "}") (330 . #<Имя примитива: 0000000036385640>) (100 . "AcDbSymbolTableRecord") (100 . "AcDbTextStyleTableRecord") (2 . "Standard") (70 . 0) (40 . 0.0) (41 . 1.0) (50 . 0.0) (71 . 0) (42 . 2.5) (3 . "") (4 . "")) 

Команда: (setq eNameTxtSty2 (tblobjname "style" "ГОСТ 2.304")) 
#<Имя примитива: 0000000040805990> 
Команда: (setq theElist2 (entget eNameTxtSty2)) 
((-1 . #<Имя примитива: 0000000040805990>) (0 . "STYLE") (5 . "4B9") (330 . #<Имя примитива: 0000000036385640>) (100 . "AcDbSymbolTableRecord") (100 . "AcDbTextStyleTableRecord") (2 . "ГОСТ 2.304") (70 . 0) (40 . 0.0) (41 . 1.0) (50 . 0.0) (71 . 0) (42 . 250.0) (3 . "CS_Gost2304.shx") (4 . "")) 

 

Ссылка на сообщение
Поделиться на другие сайты

... аналогично через LISP в AutoCAD 2015.
image.png.8456ca58ef680bf08d6807d9d6b491d2.png
 

Команда: (setq eNameTxtSty (tblobjname "style" "Test_Arial"))
<Имя объекта: 7ffffb04ba0>
Команда: (setq theEList (entget eNameTxtSty))
((-1 . <Имя объекта: 7ffffb04ba0>) (0 . "STYLE") (330 . <Имя объекта: 7ffffb03830>) (5 . "2AA") (100 . "AcDbSymbolTableRecord") (100 . "AcDbTextStyleTableRecord") (2 . "Test_Arial") (70 . 0) (40 . 0.0) (41 . 1.0) (50 . 0.0) (71 . 0) (42 . 2.5) (3 . "arial.ttf") (4 . ""))

 

Ссылка на сообщение
Поделиться на другие сайты

под наной21

Команда: (setq eNameTxtSty (tblobjname "style" "Standard"))
#<Имя примитива: 0000016F7F0523E0>
Команда: (setq theElist (entget eNameTxtSty))
((-1 . #<Имя примитива: 0000016F7F0523E0>) (0 . "STYLE") (5 . "11") (330 . #<Имя примитива: 0000016F7F052AE0>) (100 . "AcDbSymbolTableRecord") (100 . "AcDbTextStyleTableRecord") (2 . "Standard") (70 . 0) (40 . 0.0) (41 . 1.0) (50 . 0.0) (71 . 0) (42 . 2.5) (3 . "arial.ttf") (4 . ""))

 

Изменено пользователем doctorraz
Ссылка на сообщение
Поделиться на другие сайты
17 минут назад, doctorraz сказал:

под наной21


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

Платформа nanoCAD x64 21.0 21.0.5699.3427, © 2019 ООО «Нанософт разработка» 
NEW,НОВЫЙ - Создать TdmsAddIn загружен. 
Команда: NCGS_TOGGLE_VECTORIZER 
NCGS_TOGGLE_VECTORIZER - NCGS_TOGGLE_VECTORIZER 

ribbon - Лента 
ST,STYLE,ДИАЛСТИЛЬ,СТ,СТИЛЬ - Текстовые стили... 
Команда: (setq eNameTxtSty (tblobjname "style" "Standard")) 
#<Имя примитива: 000000003D78C470> 
Команда: (setq theElist (entget eNameTxtSty)) 
((-1 . #<Имя примитива: 000000003D78C470>) (0 . "STYLE") (5 . "11") (330 . #<Имя примитива: 000000003D7933F0>) (100 . "AcDbSymbolTableRecord") (100 . "AcDbTextStyleTableRecord") (2 . "Standard") (70 . 0) (40 . 0.0) (41 . 1.0) (50 . 0.0) (71 . 0) (42 . 2.5) (3 . "") (4 . ""))

 

Ссылка на сообщение
Поделиться на другие сайты
18 минут назад, A.Kudrjashov сказал:

Попробовал под административным пользователем на удачу

странно, у меня под юзером, ттф показал

38 минут назад, doctorraz сказал:

(3 . "arial.ttf")

 

Ссылка на сообщение
Поделиться на другие сайты
15 часов назад, doctorraz сказал:

странно, у меня под юзером, ттф показал


... ну вот, что есть. Я знаю, что должно быть "(3 . "arial.ttf")"
Если разработчики расскажут где эта информация хранится и как она оттуда добывается, можно попытаться понять что мешает. Навскидку я пока ничего не нашёл.

P.S.
nanoCAD 20.1 точно такая же фигня, если это Разработчикам о чём то скажет.

nanoCAD x64 Plus 20.1 20.1.5304.3354, © 2015 АО «Нанософт» 
Приложение запущено в корпоративном режиме работы. 
...
Команда: (setq eNameTxtSty (tblobjname "style" "Standard")) 
#<Имя примитива: 0000000033CCA6E0> 
Команда: (setq theElist (entget eNameTxtSty)) 
((-1 . #<Имя примитива: 0000000033CCA6E0>) (0 . "STYLE") (5 . "11") (330 . #<Имя примитива: 0000000033CBC4A0>) (100 . "AcDbSymbolTableRecord") (100 . "AcDbTextStyleTableRecord") (2 . "Standard") (70 . 0) (40 . 0.0) (41 . 1.0) (50 . 0.0) (71 . 0) (42 . 2.5) (3 . "") (4 . ""))

 

У меня на рабочем месте Windows 7, sp1. Вечером дома проверю под Windows 10. Главное не забыть.

P.S.2
Собственно, на параллельной машине с Windows 10 всё точно тоже самое. NC21 проверить уже не могу, поэтому NC20.1

Спойлер

image.thumb.png.c68274197ab31790377c4cdae4ca093f.png

 

image.png.6bba42e0f227146609d857382e764da7.png


... версию ОС LISP определяет неверно, а это может быть более чем чревато !
Windows 8 [6.2], Windows 8.1 [6.3] и Windows 10 [10] - это, местами, две очень большие разницы.

Спойлер

image.thumb.png.d7b2a7d2e90231eedfe282bedd9b7d5b.png

 

Изменено пользователем A.Kudrjashov
Дополнения
Ссылка на сообщение
Поделиться на другие сайты
6 минут назад, A.Kudrjashov сказал:

NC21 проверить уже не могу, поэтому NC20.1

Хех я нано21 в win10  вчера тестил..

А в 8.1 чот не подумал, что ось может влиять

Ссылка на сообщение
Поделиться на другие сайты

Присоединяйтесь к обсуждению

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

Гость
Ответить в этой теме...

×   Вставлено с форматированием.   Восстановить форматирование

  Разрешено использовать не более 75 эмодзи.

×   Ваша ссылка была автоматически встроена.   Отображать как обычную ссылку

×   Ваш предыдущий контент был восстановлен.   Очистить редактор

×   Вы не можете вставлять изображения напрямую. Загружайте или вставляйте изображения по ссылке.

Загрузка...
  • Расскажите друзьям

    Нравится Официальный форум компании Нанософт? Расскажите друзьям!
×
×
  • Создать...