Форум пользователей Visio

Форум по вопросам применения и программирования в Visio
Текущее время: 06 дек 2019, 20:57

Часовой пояс: UTC + 3 часа [ Летнее время ]




Начать новую тему Ответить на тему  [ 1 сообщение ] 
Автор Сообщение
 Заголовок сообщения: САПР-АСУ :: Шаблоны УГО
СообщениеДобавлено: 13 ноя 2019, 17:04 
Не в сети
Постоянный участник

Зарегистрирован: 26 авг 2019, 21:07
Сообщений: 50
Использую Visio c: 2019
Очков репутации: 2

Добавить очки репутацииУменьшить очки репутации
САПР-АСУ :: Шаблоны УГО
Изображение

Шаблоны электры нарисованы в дюймах и при добавлении их на лист в миллиметрах автоматически масштабируются. Но после этого их размеры получаются больше госта. Если отключить автомасштабирование элементов в меню электрры то при добавлении элементов на лист в миллиметрах они становятся меньше госта и перестают нормально привязываться к сетке (появляется смещение на ~0,1 мм).
Спойлер: показать
Изображение

Сначала я занимался переделкой шаблонов вручную, но терпения на долго не хватило. Поковырявшись в шаблонах электры выяснилось, что если отмасштабировать элементы то они начинают быть похожими на гост. Был запилен макрос Tune_Stencils() в модуле MISC который это все и проделывает (+ еще макрос настройки стилей SetStyleGost()).
Спойлер: показать
Код:
Private Sub Tune_Stencils() 'переделка шаблонов электры под гост (перед выполнением макроса надо окрыть шаблоны и сделать их редактируемыми)

    Dim appdoc As Document
    Dim appcol As Collection
    Set appcol = New Collection
    Dim mast As Master
    Dim ss As String
       
    'выбираем нужные шаблоны для измениния
    For Each appdoc In Application.Documents
        If (appdoc.Creator = "Electra" Or appdoc.Creator = "Pneumata" Or appdoc.Creator = "Hydraula") And Not (appdoc.Title = "Electra" Or appdoc.Title = "Layout" Or appdoc.Title = "Layout 3D" Or appdoc.Title = "Reports" Or appdoc.Title = "IEC Parts" Or appdoc.Title = "Title Blocks") Then
            appcol.Add appdoc
        End If
    Next
   
    For Each appdoc In appcol
        For Each mast In appdoc.Masters
            If InStr(1, mast.PageSheet.CellsSRC(visSectionObject, visRowPage, visPageScale).FormulaU, "in") Then 'не трогаем элемент если он в мм (значит он уже был изменён)
               
                'масштаб под гост
                mast.Shapes(1).Cells("Width").FormulaForceU = "guard(" & str(mast.Shapes(1).Cells("Width").Result(visInches) * 1.181102362) & ")"
                mast.Shapes(1).Cells("Height").FormulaForceU = "guard(" & str(mast.Shapes(1).Cells("Height").Result(visInches) * 1.181102362) & ")"
               
                If mast.Shapes(1).Shapes.Count > 0 Then
                    'скрываем описание
                    On Error Resume Next
                    mast.Shapes(1).Shapes("Desc").CellsU("HideText").FormulaU = "TRUE"
                    'поворот фигур
                    mast.Shapes(1).CellsSRC(visSectionObject, visRowXFormOut, visXFormAngle).FormulaU = "=IF(Actions.Row_2.Action,-90 deg,0 deg)"
                    mast.Shapes(1).CellsSRC(visSectionObject, visRowXFormOut, visXFormFlipX).FormulaU = 0
                    'только группа
                    mast.Shapes(1).CellsSRC(visSectionObject, visRowGroup, visGroupSelectMode).FormulaU = "0"
                End If
               
                'страница в милиметрах чтобы электра не запускала конвертацию in->mm
                mast.PageSheet.CellsSRC(visSectionObject, visRowPage, visPageScale).FormulaU = "1 mm"
                mast.PageSheet.CellsSRC(visSectionObject, visRowPage, visPageDrawingScale).FormulaU = "1 mm"
               
            End If
        Next mast
        appdoc.Save
    Next appdoc

End Sub

Private Sub SetStyleGost() 'Изменение стилей под Гост

    Dim vsoStyle As Visio.Style
    Set vsoStyle = Application.ActiveDocument.Styles("EE Normal")
    vsoStyle.CellsSRC(visSectionObject, visRowLine, visLineWeight).FormulaU = "0.2 mm"
    vsoStyle.CellsSRC(visSectionCharacter, 0, visCharacterFont).FormulaU = 93
    vsoStyle.CellsSRC(visSectionCharacter, 0, visCharacterStyle).FormulaU = 2
    vsoStyle.CellsSRC(visSectionCharacter, 0, visCharacterSize).FormulaU = "11 pt"
    vsoStyle.CellsSRC(visSectionCharacter, 0, visCharacterDblUnderline).FormulaU = False
    vsoStyle.CellsSRC(visSectionCharacter, 0, visCharacterOverline).FormulaU = False
    vsoStyle.CellsSRC(visSectionCharacter, 0, visCharacterStrikethru).FormulaU = False
    vsoStyle.CellsSRC(visSectionCharacter, 0, 11).FormulaU = False
    vsoStyle.CellsSRC(visSectionCharacter, 0, visCharacterDoubleStrikethrough).FormulaU = False
    vsoStyle.CellsSRC(visSectionCharacter, 0, visCharacterRTLText).FormulaU = False
    vsoStyle.CellsSRC(visSectionCharacter, 0, visCharacterUseVertical).FormulaU = False

    Set vsoStyle = Application.ActiveDocument.Styles("Pin Normal")
    vsoStyle.CellsSRC(visSectionCharacter, 0, visCharacterFont).FormulaU = 93
    vsoStyle.CellsSRC(visSectionCharacter, 0, visCharacterStyle).FormulaU = 2
    vsoStyle.CellsSRC(visSectionCharacter, 0, visCharacterSize).FormulaU = "8 pt"
    vsoStyle.CellsSRC(visSectionCharacter, 0, visCharacterDblUnderline).FormulaU = False
    vsoStyle.CellsSRC(visSectionCharacter, 0, visCharacterOverline).FormulaU = False
    vsoStyle.CellsSRC(visSectionCharacter, 0, visCharacterStrikethru).FormulaU = False
    vsoStyle.CellsSRC(visSectionCharacter, 0, 11).FormulaU = False
    vsoStyle.CellsSRC(visSectionCharacter, 0, visCharacterDoubleStrikethrough).FormulaU = False
    vsoStyle.CellsSRC(visSectionCharacter, 0, visCharacterRTLText).FormulaU = False
    vsoStyle.CellsSRC(visSectionCharacter, 0, visCharacterUseVertical).FormulaU = False
   
    'сетка 2,5 мм
    Dim vsoShape As Shape
    Dim vsoPage As Visio.Page
    For Each vsoPage In Application.ActiveDocument.Pages
        Set vsoShape = vsoPage.PageSheet
        vsoShape.CellsSRC(visSectionObject, visRowRulerGrid, visXGridDensity).FormulaU = "0"
        vsoShape.CellsSRC(visSectionObject, visRowRulerGrid, visXGridSpacing).FormulaU = "2.5 mm"
        vsoShape.CellsSRC(visSectionObject, visRowRulerGrid, visYGridDensity).FormulaU = "0"
        vsoShape.CellsSRC(visSectionObject, visRowRulerGrid, visYGridSpacing).FormulaU = "2.5 mm"
    Next

End Sub


Инструкция:
1. Открываем/создаем документ
2. Добавляем наборы элементов которые надо преобразовать (или создаем документ из шаблона New Electra Drawing.vst - будут все наборы)
3. Делаем каждый шаблон редактируемым (ПКМ на вкладке -> Изменить набор элементов) (Макросом сделать тоже самое на получилось)
4. Запускаем макрос MISC\Tune_Stencils

Макрос справляется с большинством элементов. С теми что он не смог переделать надо работать отдельно. Запускать в режиме отладки и смотреть где и почему затыки и добавлять/убирать дополнительные условия. У меня на это пока нет времени.

Из замеченного:
Спойлер: показать
Изображение
1. Не соответствуют госту лампочки и катушки реле - переделаны в ручную (лежат в SAPR_ASU)
2. Переделаны вручную некоторые контакты реле (на что хватило терпения)
3. У всех элементов электры огромная рамка выравнивания, и при попытке выделении одно контакта выделяются соседние контакты. Для самых ходовых обычных контактов реле я уменьшил рамку выравнивания (процесс геморойный, т.к. все размеры внутри группы привязаны к этой самой рамке выравнивания) Команда "Фигура -> Операции -> Обновить рамку выравнивания" делает еще хуже чем было. Автоматизировать этот процесс пока не пробовал, но где-то на форуме читал что можно переключить хранение размеров в нутри группы с относительных на абсолютные. Но опять же без ручного труда не обойтись - все равно потом вручную выставлять все относительно новой рамки внутри группы и снаружи передвигать соединительные точки.
4. Электра как-то по индусски поворачивает элементы в горизонтальное положение (влево). Переделал под свое понимание правильность - вправо :)
5. У контактов реле нумерация выводов не соответствует тем реле которыми пользуемся мы (Finder, ABB, Schneider) 11-COM, 14-NO, 12-NC. Для переделки надо заменить строки в столбце D раздела Connection Points.
Спойлер: показать
Для NO
Код:
="6,14,24,34,44"
="1,11,21,31,41"
Для NC
Код:
="6,13,23,33,43"
="1,11,21,31,41"
Изображение


Скачать САПР-АСУ можно тут https://yadi.sk/d/24V8ngEM_8KXyg - Это папка на яндекс-диске в которую скидывается проект (см. дату в имени файла)
SAPR_ASU_2019.11.13_16.08_Light.zip Версия для форума (меньше 2 МБ. Выкинут пример SAPR_ASU.vsd и Electra.vss)


PS
Я сейчас стал мотаться по объектам (начался отопительный сезон) поэтому времени на Visio не остается


Вложения:
SAPR_ASU_2019.11.13_16.08_Light.zip [473.82 Кб]
Скачиваний: 10
Пожаловаться на это сообщение
Вернуться к началу
 Профиль  
Ответить с цитатой  
Показать сообщения за:  Поле сортировки  
Начать новую тему Ответить на тему  [ 1 сообщение ] 

Часовой пояс: UTC + 3 часа [ Летнее время ]



Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 1


Вы можете начинать темы
Вы можете отвечать на сообщения
Вы не можете редактировать свои сообщения
Вы не можете удалять свои сообщения
Вы не можете добавлять вложения

Найти:
Перейти:  
cron
Powered by phpBB © 2000, 2002, 2005, 2007 phpBB Group
Вы можете создать форум бесплатно PHPBB3 на Getbb.Ru, Также возможно сделать готовый форум PHPBB2 на Mybb2.ru
Русская поддержка phpBB