Пример проекта

gtfox · Jul 26, 2023 · 3ee3c10 · 3ee3c10
1 parent 96ecf5f
commit 3ee3c10
Show file tree

Hide file tree

Showing 8 changed files with 35 additions and 22 deletions.
diff --git a/ChangeLog.txt b/ChangeLog.txt
@@ -222,6 +222,7 @@
 2023.07.21_01:19	Оформление 27 Приводы ФСА
 2023.07.23_05:24	Оформление 28 Приводы ФСА 2
 2023.07.25_01:57	Оформление 29 Приводы Схем
+2023.07.26_03:29	Пример проекта
 
 
 

diff --git a/SAPR_ASU.vsd b/SAPR_ASU.vsd
diff --git a/SAPR_ASU_CODE/CrossReferenceRelay.bas b/SAPR_ASU_CODE/CrossReferenceRelay.bas
@@ -201,9 +201,11 @@ Sub DeleteRelayParent(shpParent As Visio.Shape)
             If GUIDChild <> "" Then
                 Set shpChild = ShapeByGUID(GUIDChild)
                 'Проверяем что контакт привязан именно к нашей катушке
-                If GUIDParent = shpChild.CellsSRC(visSectionHyperlink, 0, visHLinkExtraInfo).ResultStr(0) Then
-                    'Чистим дочерний шейп
-                    ClearRelayChild shpChild
+                If Not (shpChild Is Nothing) Then
+                    If GUIDParent = shpChild.CellsSRC(visSectionHyperlink, 0, visHLinkExtraInfo).ResultStr(0) Then
+                        'Чистим дочерний шейп
+                        ClearRelayChild shpChild
+                    End If
                 End If
             End If
         Next

diff --git a/SAPR_ASU_CODE/KabeliCxema.bas b/SAPR_ASU_CODE/KabeliCxema.bas
@@ -342,10 +342,10 @@ Public Sub AddCableFromWires(shpProvod As Visio.Shape)
         End If
     ElseIf ShapeSATypeIs(shpKabel.Shapes(1).Connects(1).ToSheet, typeCxemaTerm) Then 'Соединен шкаф и датчик/привод 'клемма шкафа
         shpKabel.Cells("User.LinkToBox").Formula = shpKabel.Shapes(1).Connects(1).ToSheet.NameID & "!User.FullName.Prompt"
-        shpKabel.Cells("User.LinkToSensor").Formula = shpKabel.Shapes(1).Connects(2).ToSheet.NameID & "!User.FullName.Prompt"
+        shpKabel.Cells("User.LinkToSensor").Formula = shpKabel.Shapes(1).Connects(2).ToSheet.NameID & "!User.Name"
     ElseIf ShapeSATypeIs(shpKabel.Shapes(1).Connects(1).ToSheet, typeCxemaSensorTerm) Then 'клемма датчика
         shpKabel.Cells("User.LinkToBox").Formula = shpKabel.Shapes(1).Connects(2).ToSheet.NameID & "!User.FullName.Prompt"
-        shpKabel.Cells("User.LinkToSensor").Formula = shpKabel.Shapes(1).Connects(1).ToSheet.NameID & "!User.FullName.Prompt"
+        shpKabel.Cells("User.LinkToSensor").Formula = shpKabel.Shapes(1).Connects(1).ToSheet.NameID & "!User.Name"
     End If
 
     Application.EventsEnabled = -1

diff --git a/SAPR_ASU_CODE/KabeliPLAN.bas b/SAPR_ASU_CODE/KabeliPLAN.bas
@@ -337,12 +337,12 @@ Sub RouteCableSensor(shpSensorFSA As Visio.Shape)
     shpLineRight.Delete
     vsoLayer1.Delete True
 
-    'Создаем свойства для линии (тип как у лотка typePlanDuct = 170)
+    'Создаем свойства для линии (тип как у лотка typePlanDuct = 132)
     With shpShortLine
         .AddSection visSectionUser
         .AddRow visSectionUser, visRowLast, visTagDefault
         .CellsSRC(visSectionUser, visRowLast, visUserValue).RowNameU = "SAType"
-        .CellsSRC(visSectionUser, visRowLast, visUserValue).FormulaForceU = "170"
+        .CellsSRC(visSectionUser, visRowLast, visUserValue).FormulaForceU = typePlanDuct
         .AddSection visSectionProp
         .AddRow visSectionProp, visRowLast, visTagDefault
         .CellsSRC(visSectionProp, visRowLast, visCustPropsValue).RowNameU = "SymName"
@@ -1762,7 +1762,7 @@ SectionNumber = visSectionUser 'User 242
 sSectionName = "User."
             arrRowName = Array("Dropped", "SAType", "Name", "AdrSource", "FullName", "KodProizvoditelyaDB", "KodPoziciiDB")
             arrRowValue = Array("0|""""", _
-                            "90|", _
+                            "134|", _
                             "IF(Prop.HideNumber,"""",Prop.Number)&IF(Prop.HideName,"""","": ""&Prop.SymName)|", _
                             "0|""""", _
                             "Prop.FullName&"" ""&Prop.Ac3|""""", _

diff --git a/SAPR_ASU_CODE/Menu.bas b/SAPR_ASU_CODE/Menu.bas
@@ -301,27 +301,27 @@ Private Sub AddButtonsCXEMA()
         .FaceId = 572
 '        .BeginGroup = True
     End With
-
-        '---Кнопка "Скрыть дочерние номера проводов"
-    Set Button = Bar.Controls.Add(Type:=msoControlButton, id:=1, Before:=4)
-    With Button
-        .Caption = "Скрытьдочерниеномерапроводов"
-        .Tag = "HideWireNumChildInDoc"
-        .OnAction = "HideWireNumChildInDoc"
-        .TooltipText = "Скрыть дочерние номера проводов"
-        .FaceId = 290 '2810 2805
-        .BeginGroup = True
-    End With
-
+
         '---Кнопка "Показать дочерние номера проводов"
-    Set Button = Bar.Controls.Add(Type:=msoControlButton, id:=1, Before:=5)
+    Set Button = Bar.Controls.Add(Type:=msoControlButton, id:=1, Before:=4)
     With Button
         .Caption = "Показатьдочерниеномерапроводов"
         .Tag = "ShowWireNumChildInDoc"
         .OnAction = "ShowWireNumChildInDoc"
         .TooltipText = "Показать дочерние номера проводов"
         .FaceId = 291 '2810 2805
 '        .BeginGroup = True
+    End With
+
+        '---Кнопка "Скрыть дочерние номера проводов"
+    Set Button = Bar.Controls.Add(Type:=msoControlButton, id:=1, Before:=5)
+    With Button
+        .Caption = "Скрытьдочерниеномерапроводов"
+        .Tag = "HideWireNumChildInDoc"
+        .OnAction = "HideWireNumChildInDoc"
+        .TooltipText = "Скрыть дочерние номера проводов"
+        .FaceId = 290 '2810 2805
+        .BeginGroup = True
     End With
 
         '---Кнопка "Вставить миниатюры контактов"

diff --git a/SAPR_ASU_CODE/Oformlenie.bas b/SAPR_ASU_CODE/Oformlenie.bas
@@ -166,14 +166,24 @@ Public Sub LockSelected()
         If MsgBox("Заблокировать выделененые объекты: " & Application.ActiveWindow.Selection.Count & "шт.?", vbExclamation + vbOKCancel, "САПР-АСУ: Блокировки выделенного объекта") = vbOK Then
             'Создаем и блокруем слой
             Set vsoLayer1 = Application.ActiveWindow.Page.Layers.Add("SA_LockedLayer")
+            Set vsoLayer2 = Application.ActiveWindow.Page.Layers.Add("SA_LockedWire")
 '            SetLayer Application.ActiveWindow.Selection(1), vsoLayer1
             For Each vsoShape In Application.ActiveWindow.Selection
-                vsoLayer1.Add vsoShape, 0
+                If ShapeSATypeIs(vsoShape, typeCxemaWire) Then
+                    vsoLayer2.Add vsoShape, 0
+                Else
+                    vsoLayer1.Add vsoShape, 0
+                End If
             Next
             vsoLayer1.CellsC(visLayerLock).FormulaU = "1"
             vsoLayer1.CellsC(visLayerColor).FormulaU = "19"
             vsoLayer1.CellsC(visLayerSnap).FormulaU = "0"
             vsoLayer1.CellsC(visLayerGlue).FormulaU = "0"
+
+            vsoLayer2.CellsC(visLayerLock).FormulaU = "1"
+            vsoLayer2.CellsC(visLayerColor).FormulaU = "19"
+            vsoLayer2.CellsC(visLayerSnap).FormulaU = "0"
+            vsoLayer2.CellsC(visLayerGlue).FormulaU = "1"
             ActiveWindow.DeselectAll
         Else
             Exit Sub

diff --git a/SAPR_ASU_CXEMA.vss b/SAPR_ASU_CXEMA.vss