PON Calculator

[George_jan 0]

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

[Artem_w87 0]

Не запускается макрос в Windows 10 64 бит. Visio 2010

[Учумелые ручки 705]

В 15.08.2020 в 21:43, Wsdw сказал:

Доброго времени судок 

Скажите а есть шаблоны кабеля с одним модулем но на 16,24,32 волокна

1. Переключитесь в режим "разработчика". (Стандартные настройки Visio)

2. Правой кн. мыши на заголовке набора елементов, "изменить набор...."

3. Пр. кн. мыши на Cable, "изменить образец", "изменить фигуру образца",  Пр. кн. мыши на фигуре кабеля, "показать таблицу свойст фигуры" ...

4. Ищем группу "Shape Data", строчка "Prop.Modules", колонка "Format"

5. Строчка "FTTH;1;2;4;6;8;12" - через точку с запятой добавляем нужное к-во волокон ... (не забываем про открывающие и закрывающие скобки)

 

PS: То же самое можно делать с модульностью, к-вом портов ОЛТ и многим др ...

ЗЗЫ: Также можно менять отдельные элементы не в наборе шаблонов просто кликнув на объекте и вызвав "показать таблицу свойств фигуры"

В 26.08.2020 в 16:19, George_jan сказал:

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

 

В 08.10.2020 в 14:53, Artem_w87 сказал:

Не запускается макрос в Windows 10 64 бит. Visio 2010

 

 

Для непонятливых: Вам шашечки или ехать ?

Разарбатывалось под Visio 2010 Pro 32 Бита - под ним работает без сбоев ...

Хотите работать - ставьте рекомендуемое. Нет - Ваши сексуальные проблемы ...

[Учумелые ручки 705]

В 08.10.2020 в 14:53, Artem_w87 сказал:

Не запускается макрос в Windows 10 64 бит. Visio 2010

 

В Вашем конкретном случае отсутствует функция GetTickCount в модуле kernel32 (Вообще-то стандартная функция в ЛЮБОЙ ВИНДЕ) - т.е. у Вас какой-то репак или "обрезка" ... Но в данном конкретном случае я её использовал для "профилинга" (улутшения быстродействия) ... 

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

Відредаговано 2020-10-12 09:03:31 Учумелые ручки

[CAHI33 3]

Доробляв мало....

Не самий правильний метод, але працює!
При намалюванні внутренність ПОНбокса, розкольоруваня сплитера зміщена і тільки вихід сплитера йде по о стандартній палітри а вхід має нейтральний (білий) колір (так більш правильно)

 

 

Мені так ще краще нравиться

Візуально більш інформативне.

Відредаговано 2020-10-15 07:19:28 CAHI33

[FreZZe52 0]

В 15.10.2020 в 01:50, CAHI33 сказал:

Доробляв мало....

Не самий правильний метод, але працює!
При намалюванні внутренність ПОНбокса, розкольоруваня сплитера зміщена і тільки вихід сплитера йде по о стандартній палітри а вхід має нейтральний (білий) колір (так більш правильно)

 

 

Мені так ще краще нравиться

Візуально більш інформативне.

  

Добрый день, я правильно понимаю что на последнем скриншоте это ваш файл с цветной разметкой?
Если это так можно попросить вас поделится ним с общественностью. Спасибо!.

[CAHI33 3]

Так, все вірно! Звічайно що поділюся! 
Необхідно пару рядкив дописати до орігинала, та при відкриття вже зєднаної ліні буде малювати з кольорами

Зміни зробив у IntToVal функції . Тут модіфіцірована функція:
 

Public Sub IntToVal(Row, Col As Long, val As Variant)
    Dim s As String
    Dim loss As Double
    Dim c As Long
    Dim p As Long
    Dim fakul As Long
    Dim PLC2s As String

        
    'Dim log As New cLog:     log.init "IntToVal"
    
    Select Case Col
        Case 1
            s = IIf(val = 0, "Int", "Cas" & val)
        Case 2, 6
            Select Case val
                Case -6: s = "PLC"
                Case -5: s = "FBT"
                Case -8: s = "PLC2"
                Case -7: s = "FBT2"
                Case Is > 0: s = "Ab" & val
                Case 0: s = ""
                Case Else: s = "Cab" & Abs(val)
            End Select
        Case 3, 7
            s = lst.TextMatrix(Row, Col - 1)
            If InStr(s, "Ab") > 0 Then
                s = "FTTH"
'                lst.Cell(flexcpBackColor, Row, Col) = GetRGB_Hex("RGB(200,200,200)")
            End If
            If InStr(s, "FBT") > 0 Then 'Atszinezem az FTB hateret
                 s = "Split"
                 lst.Cell(flexcpBackColor, Row, Col) = GetRGB_Hex("RGB(100,10,160)")
                 lst.Cell(flexcpBackColor, Row, Col - 1) = GetRGB_Hex("RGB(100,10,160)")
                 lst.Cell(flexcpForeColor, Row, Col) = GetRGB_Hex("RGB(255,255,0)")
                 lst.Cell(flexcpForeColor, Row, Col - 1) = GetRGB_Hex("RGB(255,255,0)")
            End If

            If InStr(s, "PLC") > 0 Then s = "Split"
            If InStr(s, "FBT") > 0 Then s = "Split"
            If box.isFTTH(ToVal(Row, Col - 1)) Then s = "FTTH"
            
            If s = lst.TextMatrix(Row, Col - 1) Then
                If Trim(lst.TextMatrix(Row, Col)) = "" Then s = val Else s = lst.TextMatrix(Row, Col)
            End If
            If VBA.val(s) > 0 Then
'-=-=-=-=-=-=-
                p = VBA.val("-" & Replace(lst.Cell(flexcpText, Row, Col - 2), "Cab", ""))
                c = GetFiber_Color(VBA.val(s), box.GetFibesOnPort(p), box.GetColorsOnPort(p))
                
                lst.Cell(flexcpBackColor, Row, Col) = c
               
                lst.Cell(flexcpForeColor, Row, Col) = IIf((GetRGB_Hex(cBlack) = c) Or _
                                                          (GetRGB_Hex(cBlue) = c) Or _
                                                          (GetRGB_Hex(cBrown) = c) Or _
                                                          (GetRGB_Hex(cGray) = c) Or _
                                                          (GetRGB_Hex(cViolet) = c), _
                                                                        RGB(255, 255, 255), 1)
            Else
'                lst.Cell(flexcpBackColor, Row, Col) = GetRGB_Hex("RGB(200,200,200)")
            End If
        
        Case 4, 8
            s = lst.TextMatrix(Row, Col - 2)
            If InStr(s, "Ab") > 0 Then
                s = "One"
'                lst.Cell(flexcpBackColor, Row, Col) = GetRGB_Hex("RGB(200,200,200)")
            Else
 '//szinezes
    '----=== //Kabelek szinezese
             If InStr(s, "Cab1") > 0 Then 'Atszinezem ha ez Cab1
               lst.Cell(flexcpBackColor, Row, Col - 1) = GetRGB_Hex("RGB(200,240,255)")
               lst.Cell(flexcpBackColor, Row, Col - 2) = GetRGB_Hex("RGB(200,240,255)")
             End If
             If InStr(s, "Cab2") > 0 Then 'Atszinezem ha ez Cab2
               lst.Cell(flexcpBackColor, Row, Col - 1) = GetRGB_Hex("RGB(255,150,240)")
               lst.Cell(flexcpBackColor, Row, Col - 2) = GetRGB_Hex("RGB(255,150,240)")
             End If
             If InStr(s, "Cab3") > 0 Then 'Atszinezem ha ez Cab3
               lst.Cell(flexcpBackColor, Row, Col - 1) = GetRGB_Hex("RGB(255,250,170)")
               lst.Cell(flexcpBackColor, Row, Col - 2) = GetRGB_Hex("RGB(255,250,170)")
             End If
             If InStr(s, "Cab4") > 0 Then 'Atszinezem ha ez Cab4
               lst.Cell(flexcpBackColor, Row, Col - 1) = GetRGB_Hex("RGB(100,255,80)")
               lst.Cell(flexcpBackColor, Row, Col - 2) = GetRGB_Hex("RGB(100,255,80)")
             End If
    '----=== Kabelek szinezese\\
             If InStr(s, "PLC") > 0 Then 'Atszinezem ha ez PLC-s felirat
               If InStr(s, "2") > 0 Then 'megkulonkoztetjuk a PLC es a PLC2-ot
                 PLC2s = "Sec"
                 fakul = 10
                 lst.Cell(flexcpBackColor, Row, Col - 0) = GetRGB_Hex("RGB(220,220,220)") 'Volokno oszlop
                 lst.Cell(flexcpBackColor, Row, Col - 1) = GetRGB_Hex("RGB(220,220,220)") 'Moduly
                 lst.Cell(flexcpBackColor, Row, Col - 2) = GetRGB_Hex("RGB(220,220,220)") 'Port
                 lst.Cell(flexcpForeColor, Row, Col - 0) = GetRGB_Hex("RGB(200,22,222)")
                 lst.Cell(flexcpForeColor, Row, Col - 1) = GetRGB_Hex("RGB(200,22,222)")
                 lst.Cell(flexcpForeColor, Row, Col - 2) = GetRGB_Hex("RGB(200,22,222)")
               Else
                 PLC2s = ""
                 fakul = 0
                 lst.Cell(flexcpBackColor, Row, Col - 0) = GetRGB_Hex("RGB(245,245,245)")
                 lst.Cell(flexcpBackColor, Row, Col - 1) = GetRGB_Hex("RGB(245,245,245)")
                 lst.Cell(flexcpBackColor, Row, Col - 2) = GetRGB_Hex("RGB(245,245,245)")
                 lst.Cell(flexcpForeColor, Row, Col - 0) = GetRGB_Hex("RGB(0,0,255)")
                 lst.Cell(flexcpForeColor, Row, Col - 1) = GetRGB_Hex("RGB(0,0,255)")
                 lst.Cell(flexcpForeColor, Row, Col - 2) = GetRGB_Hex("RGB(0,0,255)")
               End If
                 
                 s = Trim(val)
                 If val = 1 Then s = PLC2s & "PLC_In" 'Az elso sor az Input lesz
                 If val > 1 Then 'ha nem az elso, akkor ez kimenet
                    p = VBA.val("-" & Replace(lst.Cell(flexcpText, Row, Col - 2), "Cab", ""))
                    c = GetFiber_Color(VBA.val(s - 1), box.GetFibesOnPort(p), box.GetColorsOnPort(p))
                    lst.Cell(flexcpBackColor, Row, Col) = c
                                  'a sotet kockaba feherrel irjuk a szamot
                    lst.Cell(flexcpForeColor, Row, Col) = IIf((GetRGB_Hex(cBlack) = c) Or (GetRGB_Hex(cBlue) = c) Or _
                                                          (GetRGB_Hex(cBrown) = c) Or (GetRGB_Hex(cGray) = c) Or _
                                                          (GetRGB_Hex(cViolet) = c), RGB(255, 255, 255), 1)
                    s = PLC2s & "PLC-" & Trim(val - 1)
                 End If '{If val > 1}
               Else '{If InStr(s, "PLC") > 0}
'szinezes\\
                 s = Trim(val)
                 If val > 0 Then
'-=-=-=-=-=-=-
                   p = VBA.val("-" & Replace(lst.Cell(flexcpText, Row, Col - 2), "Cab", ""))
                   c = GetFiber_Color(VBA.val(s), box.GetFibesOnPort(p), box.GetColorsOnPort(p))
                   lst.Cell(flexcpBackColor, Row, Col) = c
                   lst.Cell(flexcpForeColor, Row, Col) = IIf((GetRGB_Hex(cBlack) = c) Or (GetRGB_Hex(cBlue) = c) Or _
                                                          (GetRGB_Hex(cBrown) = c) Or (GetRGB_Hex(cGray) = c) Or _
                                                          (GetRGB_Hex(cViolet) = c), RGB(255, 255, 255), 1)
                  End If '{If val > 0}
                End If '{If InStr(s, "PLC")}
            End If '{Else InStr(s, "Ab") > 0}

        Case 5
            Select Case val
                Case -1
                    s = "Сварка"
                    loss = ActivePage.PageSheet.Cells("Prop.SpliceLoss")
                Case -2
                    s = "Коннектор"
                    loss = ActivePage.PageSheet.Cells("Prop.ConLoss")
                Case -3
                    s = "Пигтейл"
                    loss = ActivePage.PageSheet.Cells("Prop.ConLoss") + ActivePage.PageSheet.Cells("Prop.SpliceLoss")
                Case Else
                    s = "Сварка"
                    loss = val
            End Select
            lst.TextMatrix(Row, 9) = loss
    End Select
    lst.TextMatrix(Row, Col) = s
End Sub
 

Признаю що не самий правільний код, але хотів щоб елементарно можна було візуально відризняти що волокно звідки приходить і з чим зєднуется. З кривими руками у мене получилося так  Я не програміст!!!

[Капитошка 0]

Ребята, я может че не так понял...а где скачать то эти файлики ?

 

Відредаговано 2020-10-23 13:52:01 Капитошка

[FreZZe52 0]

11 минут назад, Капитошка сказал:

Ребята, я может че не так понял...а где скачать то эти файлики ?

 

Уважаемый Капитошка, прежде чем скачать эти файлики  тебе рекомендую прочитать все 11 страниц, и только тогда ты будешь иметь хоть какое то представление о том что это за программа и как ней пользоваться.  Я сам смотрел эту ветку еще года 2 назад но не пробовал, а когда припекло я разбирался недели 2 потому что не внимательно читал всю ветку, и забросил после 5-6 страницы. а вот там и начинается как раз самое интересное, на 8 странице лежит файл и полная инструкция как это все сделать! 

А здесь уроки по работе с программой  https://www.youtube.com/user/TheLijach/videos 
 Читай внимательно и будет тебе прозрение.
Я после того как разобрался, могу сделать карту на любой район за 1-3 часа все зависит от того сколько веток запускать

[Капитошка 0]

В 23.10.2020 в 20:09, FreZZe52 сказал:

Уважаемый Капитошка, прежде чем скачать эти файлики  тебе рекомендую прочитать все 11 страниц, и только тогда ты будешь иметь хоть какое то представление о том что это за программа и как ней пользоваться.  Я сам смотрел эту ветку еще года 2 назад но не пробовал, а когда припекло я разбирался недели 2 потому что не внимательно читал всю ветку, и забросил после 5-6 страницы. а вот там и начинается как раз самое интересное, на 8 странице лежит файл и полная инструкция как это все сделать! 

А здесь уроки по работе с программой  https://www.youtube.com/user/TheLijach/videos 
 Читай внимательно и будет тебе прозрение.
Я после того как разобрался, могу сделать карту на любой район за 1-3 часа все зависит от того сколько веток запускать

ДАк я не против разбираться, просто (как по мне) удобнее это делать когда есть на чем проверять- а не там просто читать текст

 

Спасибо

[ritor85 0]

ТС тут? Ответь в личку пожалуйста.

[maslik87 6]

Microsoft Excel Вам в помощь... Как люди любят всё усложнять. 

[Артем312 0]

Простите, я новичок на local , как скачать скинуть этому гению на пиво? )

Відредаговано 2021-03-11 07:41:30 Артем312
Получилось

[Rafael_Akopov 0]

Доброго времени всем :)
Последний пост по теме был более года назад :(, но попытаюсь...

Завалялся ли у кого файл проекта для скачивания ? Буду очень признателен за ссылку :(

Заранее спасибо

[stanislavx 22]

В 14.06.2022 в 17:05, Rafael_Akopov сказал:

Доброго времени всем
Последний пост по теме был более года назад :(, но попытаюсь...

Завалялся ли у кого файл проекта для скачивания ? Буду очень признателен за ссылку

Заранее спасибо

 

PON.7z

[Rafael_Akopov 0]

ВАУ !!!!

Спасибо за оперативность !!!!

Буду разбираться !!!!!

 

[GoodLuck777 0]

Всем привет!

Есть у кого ни будь C1StudioActiveX_2013v2.zip ?

Закиньте на файлообменник пожалуйста

 

ссылка пустая:

 для 32: http://cdn.componentone.com/files/activex/C1StudioActiveX_2013v2.zip

[Gydok 0]

В 04.04.2023 в 11:59, GoodLuck777 сказал:

Всем привет!

Есть у кого ни будь C1StudioActiveX_2013v2.zip ?

Закиньте на файлообменник пожалуйста

 

ссылка пустая:

 для 32: http://cdn.componentone.com/files/activex/C1StudioActiveX_2013v2.zip

полистайте тему, там все есть.