Допилка всего, что не работало

Допилка всего, что не работало

ChangeLog.txt

@@ -223,6 +223,7 @@
 2023.07.23_05:24 Оформление 28 Приводы ФСА 2
 2023.07.25_01:57 Оформление 29 Приводы Схем
 2023.07.26_03:29 Пример проекта
+2024.08.20_08:10 Допилка всего, что не работало
 
 
 

SAPR_ASU_CODE/BP4.bas

@@ -19,6 +19,7 @@
 Sub FillBP4(shpBP4 As Visio.Shape)
  Dim colRamki As Collection
  Dim vsoPage As Visio.Page
+ Dim NazvanieRazdela As String
  Set colRamki = New Collection
 
  If shpBP4.Cells("User.v").Result(0) > 0 Then
@@ -52,14 +53,24 @@ err:
  End If
 
  shpBP4.Shapes.Item("row" & i).Shapes.Item(i & ".1").text = NachaloRazdela & IIf(KonecRazdela = 0 Or KonecRazdela = NachaloRazdela, "", "-" & KonecRazdela)
- shpBP4.Shapes.Item("row" & i).Shapes.Item(i & ".2").text = NazvanieRazdela
+ shpBP4.Shapes.Item("row" & i).Shapes.Item(i & ".2").text = DelSpace(NazvanieRazdela)
  Next
  Application.EventsEnabled = -1
  ThisDocument.InitEvent
 
  MsgBox "ВРЧ обновлена", vbInformation, "САПР-АСУ"
 End Sub
 
+Public Function DelSpace(sStroka As String) As String
+'Рекурсивное удаление лишних пробелов
+ If InStr(sStroka, " ") > 0 Then
+ DelSpace = DelSpace(Replace(sStroka, " ", " "))
+ Else
+ DelSpace = sStroka
+ End If
+End Function
+
+
 Sub fff()
 'Преобразует строки шейпа спецификации в шейп ВРЧ
  Dim shRow As Shape

SAPR_ASU_CODE/BuildSAShape.bas

@@ -727,8 +727,8 @@ End Sub
 Function AddIntoTXTfile(ByVal FileName As String, ByVal txt As String) As Boolean
  On Error Resume Next: err.Clear
  Set fso = CreateObject("scripting.filesystemobject")
- Set ts = fso.OpenTextFile(FileName, 8, True): ts.Write txt: ts.Close
- Set ts = Nothing: Set fso = Nothing
+ Set TS = fso.OpenTextFile(FileName, 8, True): TS.Write txt: TS.Close
+ Set TS = Nothing: Set fso = Nothing
  AddIntoTXTfile = err = 0
 End Function
 

SAPR_ASU_CODE/FSA.bas

@@ -59,7 +59,15 @@ Public Sub AddSensorsOnFSA(NazvanieShkafa As String)
  shpSensorOnFSA.Delete
  ActiveDocument.Masters.ItemU("SensorFSA").Shapes(1).Cells("EventDrop").Formula = "CALLTHIS(""AutoNumber.AutoNumFSA"")"
  ActiveDocument.Masters.ItemU("SensorFSA").Shapes(1).Cells("EventMultiDrop").Formula = """"""
-
+ Set shpSensorOnFSA = vsoPageFSA.Drop(FSAvss.Masters.Item("MotorFSA"), 0, 0)
+ shpSensorOnFSA.Delete
+ ActiveDocument.Masters.ItemU("MotorFSA").Shapes(1).Cells("EventDrop").Formula = "CALLTHIS(""AutoNumber.AutoNumFSA"")"
+ ActiveDocument.Masters.ItemU("MotorFSA").Shapes(1).Cells("EventMultiDrop").Formula = """"""
+ Set shpSensorOnFSA = vsoPageFSA.Drop(FSAvss.Masters.Item("ValveFSA"), 0, 0)
+ shpSensorOnFSA.Delete
+ ActiveDocument.Masters.ItemU("ValveFSA").Shapes(1).Cells("EventDrop").Formula = "CALLTHIS(""AutoNumber.AutoNumFSA"")"
+ ActiveDocument.Masters.ItemU("ValveFSA").Shapes(1).Cells("EventMultiDrop").Formula = """"""
+
  'Находим что уже есть на ФСА (связанные датчики)
  For Each shpSensorOnFSA In vsoPageFSA.Shapes
  If ShapeSATypeIs(shpSensorOnFSA, typeFSASensor) Or ShapeSATypeIs(shpSensorOnFSA, typeFSAActuator) Then
@@ -93,14 +101,60 @@ Public Sub AddSensorsOnFSA(NazvanieShkafa As String)
  'Вставляем недостающие датчики на ФСА
  For Each shpSensorOnCxema In colSensorToFSA
  Select Case ShapeSAType(shpSensorOnCxema)
- Case typeCxemaSensor
+ Case typeCxemaSensor 'Датчик
  Set shpSensorOnFSA = vsoPageFSA.Drop(ActiveDocument.Masters.ItemU("SensorFSA"), DropX, DropY)
  DropX = DropX + shpSensorOnFSA.Cells("Width").Result(0) * 2
+
+ If shpSensorOnCxema.Cells("Prop.SymName").ResultStr(0) = "RK" Or shpSensorOnCxema.Cells("Prop.SymName").ResultStr(0) = "TC" Then 'Датчик температуры/Термопара TE
+ shpSensorOnFSA.Cells("Prop.SymName").FormulaU = """TE"""
+ ElseIf shpSensorOnCxema.Cells("Prop.SymName").ResultStr(0) = "BP" Then 'Датчик давления PT
+ shpSensorOnFSA.Cells("Prop.SymName").FormulaU = """PT"""
+ ElseIf shpSensorOnCxema.Cells("Prop.SymName").ResultStr(0) = "SP" Then 'Реле давления PS
+ shpSensorOnFSA.Cells("Prop.SymName").FormulaU = """PS"""
+ ElseIf shpSensorOnCxema.Cells("Prop.SymName").ResultStr(0) = "SL" Then 'Реле уровня LS
+ shpSensorOnFSA.Cells("Prop.SymName").FormulaU = """LS"""
+ ElseIf shpSensorOnCxema.Cells("Prop.SymName").ResultStr(0) = "BL" Then 'Датчик пламени BE
+ shpSensorOnFSA.Cells("Prop.SymName").FormulaU = """BE"""
+ ElseIf shpSensorOnCxema.Cells("Prop.SymName").ResultStr(0) = "SQ" Then 'Концевик GS
+ shpSensorOnFSA.Cells("Prop.SymName").FormulaU = """GS"""
+ ElseIf shpSensorOnCxema.Cells("Prop.SymName").ResultStr(0) = "SK" Then 'Термостат TS
+ shpSensorOnFSA.Cells("Prop.SymName").FormulaU = """TS"""
+ ElseIf shpSensorOnCxema.Cells("Prop.SymName").ResultStr(0) = "UZ" Then 'Частотник NY,UZ
+ shpSensorOnFSA.Cells("Prop.SymName").FormulaU = """NY"""
+ ElseIf shpSensorOnCxema.Cells("Prop.SymName").ResultStr(0) = "BN" Then 'Сигнализатор загазованности QN
+ shpSensorOnFSA.Cells("Prop.SymName").FormulaU = """QN"""
+ Else
+ shpSensorOnFSA.Cells("Prop.SymName").FormulaU = """XX"""
+ End If
+
  'Связываем датчик на ФСА и датчик наэл. схеме
  AddReferenceSensor shpSensorOnFSA, shpSensorOnCxema
- Case typeCxemaActuator
-' Set shpSensorOnFSA = vsoPageFSA.Drop(FSAvss.Masters.Item("ActuatorFSA"), DropX, DropY)
-' DropX = DropX + shpSensorOnFSA.Cells("Width").Result(0) * 2
+ Case typeCxemaActuator 'Привод
+ If shpSensorOnCxema.Cells("Prop.SymName").ResultStr(0) = "M" Then 'Насос, Вентилятор FG
+ Set shpSensorOnFSA = vsoPageFSA.Drop(ActiveDocument.Masters.ItemU("MotorFSA"), DropX, DropY)
+ DropX = DropX + shpSensorOnFSA.Cells("Width").Result(0) * 2
+ shpSensorOnFSA.Cells("Prop.SymName").FormulaU = """FG"""
+ ElseIf shpSensorOnCxema.Cells("Prop.SymName").ResultStr(0) = "B" Then 'Горелка FB
+ Set shpSensorOnFSA = vsoPageFSA.Drop(ActiveDocument.Masters.ItemU("MotorFSA"), DropX, DropY)
+ DropX = DropX + shpSensorOnFSA.Cells("Width").Result(0) * 2
+ shpSensorOnFSA.Cells("Prop.SymName").FormulaU = """FB"""
+ shpSensorOnFSA.Cells("Prop.Tip").FormulaU = "INDEX(2,Prop.Tip.Format)"
+ ElseIf shpSensorOnCxema.Cells("Prop.SymName").ResultStr(0) = "YA" Then 'Клапан электромагнитный FY, 3-х ходовой кран FV
+ Set shpSensorOnFSA = vsoPageFSA.Drop(ActiveDocument.Masters.ItemU("ValveFSA"), DropX, DropY)
+ DropX = DropX + shpSensorOnFSA.Cells("Width").Result(0) * 2
+ shpSensorOnFSA.Cells("Prop.SymName").FormulaU = """FV"""
+ ElseIf shpSensorOnCxema.Cells("Prop.SymName").ResultStr(0) = "TV" Then 'Трансформатор запальника EZ
+ Set shpSensorOnFSA = vsoPageFSA.Drop(ActiveDocument.Masters.ItemU("MotorFSA"), DropX, DropY)
+ DropX = DropX + shpSensorOnFSA.Cells("Width").Result(0) * 2
+ shpSensorOnFSA.Cells("Prop.SymName").FormulaU = """EZ"""
+ shpSensorOnFSA.Cells("Prop.Tip").FormulaU = "INDEX(2,Prop.Tip.Format)" 'TODO нарисовать запальник и вписать цифру индекса
+ Else
+ Set shpSensorOnFSA = vsoPageFSA.Drop(ActiveDocument.Masters.ItemU("ValveFSA"), DropX, DropY)
+ DropX = DropX + shpSensorOnFSA.Cells("Width").Result(0) * 2
+ shpSensorOnFSA.Cells("Prop.SymName").FormulaU = """XX"""
+ End If
+ 'Связываем привод на ФСА и привод наэл. схеме
+ AddReferenceSensor shpSensorOnFSA, shpSensorOnCxema
  Case Else
 
  End Select

SAPR_ASU_CODE/KabeliCxema.bas

@@ -55,18 +55,19 @@ Public Sub AddCableOnSensor(shpSensor As Visio.Shape, Optional iOptions As Integ
  AddToGroupCable shpKabel, shpKabel.ContainingPage, colWires
  'Число проводов в кабеле
  shpKabel.Cells("Prop.WireCount").FormulaU = colWires.Count
+ 'Сохраняем к какому шкафу подключен кабель
+ If ShapeSATypeIs(colWires.Item(1).Connects(1).ToSheet, typeCxemaTerm) Then 'клемма шкафа
+ shpKabel.Cells("User.LinkToBox").Formula = colWires.Item(1).Connects(1).ToSheet.NameID & "!User.FullName.Prompt"
+ ElseIf ShapeSATypeIs(colWires.Item(1).Connects(1).ToSheet, typeCxemaSensorTerm) Then 'клемма датчика
+ shpKabel.Cells("User.LinkToBox").Formula = colWires.Item(1).Connects(2).ToSheet.NameID & "!User.FullName.Prompt"
+ End If
+ shpKabel.Cells("User.LinkToSensor").Formula = shpSensor.NameID & "!User.Name"
  End If
  End If
  Next
 
- 'Сохраняем к какому шкафу подключен кабель
- If ShapeSATypeIs(colWires.Item(1).Connects(1).ToSheet, typeCxemaTerm) Then 'клемма шкафа
- shpKabel.Cells("User.LinkToBox").Formula = colWires.Item(1).Connects(1).ToSheet.NameID & "!User.FullName.Prompt"
- ElseIf ShapeSATypeIs(colWires.Item(1).Connects(1).ToSheet, typeCxemaSensorTerm) Then 'клемма датчика
- shpKabel.Cells("User.LinkToBox").Formula = colWires.Item(1).Connects(2).ToSheet.NameID & "!User.FullName.Prompt"
- End If
- shpKabel.Cells("User.LinkToSensor").Formula = shpSensor.NameID & "!User.Name"
-
+
+
  Else
 
  'Собираем провода со всех входов в датчике
@@ -194,6 +195,7 @@ Sub AddKlemmyIProvoda(shpSensorIO As Visio.Shape)
  Dim cellProvodUp As Visio.Cell
  Dim AbsPinX As Double
  Dim AbsPinY As Double
+ Dim NPin As Integer
 
  Set vsoPage = ActivePage
  Set vsoMasterKlemma = Application.Documents.Item("SAPR_ASU_CXEMA.vss").Masters.Item("Term")
@@ -214,6 +216,8 @@ Sub AddKlemmyIProvoda(shpSensorIO As Visio.Shape)
  Set cellProvodUp = shpProvod.CellsU("EndX")
  cellProvodDown.GlueTo cellKlemmaDatchika
  cellProvodUp.GlueTo cellKlemmaShkafa
+ NPin = NPin + 1
+ If NPin = shpSensorIO.Cells("Prop.NPin").Result(0) Then Exit For
  End If
  Next
  ActiveWindow.DeselectAll