Jump to content

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


Recommended Posts

Добрый день!

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

 

Нашел скрипт для 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

       ^

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

Link to comment
Share on other sites

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

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

Edited by doctorraz
  • Like 3
Link to comment
Share on other sites

7 минут назад, Boroda888 сказал:

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

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

для Times New Roman

TS.fontFile = "times.ttf"

 

Edited by doctorraz
  • Like 1
Link to comment
Share on other sites

Только что, Boroda888 сказал:

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

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

Спойлер

image.thumb.png.b8a6cba1adaa3eb5065218b5c6778f18.png

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

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

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

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

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

Link to comment
Share on other sites

13 минут назад, Boroda888 сказал:

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

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

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

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

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

Link to comment
Share on other sites

4 часа назад, AlExTs сказал:

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


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

 

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

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

Link to comment
Share on other sites

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

 

 

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

Link to comment
Share on other sites

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

 

 

Edited by A.Kudrjashov
Дополнения
Link to comment
Share on other sites

Спойлер

image.png.aba68e78ec4c41a7c10a417555d304b9.png

Спойлер

image.png.cebb90416175c1dd58a1dfb096781b86.png

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

Edited by doctorraz
Link to comment
Share on other sites

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

 

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

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

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

Спойлер

image.thumb.png.1967ca04945467c9cd4b6cf7ea0e8658.png

 

Link to comment
Share on other sites

13 минут назад, A.Kudrjashov сказал:

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

 офф тонко:D

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

Edited by doctorraz
Link to comment
Share on other sites

1 час назад, A.Kudrjashov сказал:

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

Спойлер

image.thumb.png.0823f84c1f0f2e91bc7611b4678251c4.png

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

Edited by doctorraz
Link to comment
Share on other sites

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

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

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

  • Like 1
Link to comment
Share on other sites

В 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

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

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

Link to comment
Share on other sites


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

Описание 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 . "")) 

 

Link to comment
Share on other sites

... аналогично через 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 . ""))

 

Link to comment
Share on other sites

под наной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 . ""))

 

Edited by doctorraz
Link to comment
Share on other sites

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 . ""))

 

Link to comment
Share on other sites

18 минут назад, A.Kudrjashov сказал:

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

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

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

(3 . "arial.ttf")

 

Link to comment
Share on other sites

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

 

Edited by A.Kudrjashov
Дополнения
  • Like 1
Link to comment
Share on other sites

6 минут назад, A.Kudrjashov сказал:

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

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

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

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

Loading...
 Share

  • Tell a friend

    Love Официальный форум компании Нанософт? Tell a friend!
×
×
  • Create New...