Автор Тема: Получить ведомость элементов плана ж/д линии (Форма 2 ГОСТ Р 21.1702-96) (Прочитано 4161 раз)

soloviewserg · « : 11-01-2019, 14:48:52 »

Прошу не судить строго за "модульно-функциональный" стиль кода, т.к. он написан 11 лет назад. Между тем задачи прямая и предметной области решены.

Код - vb.net [Выбрать]

Friend Sub ComputeAndDrawRotAngleTanCurSpirParamTableRail()
 
            If pDrawRotationAngleTangentCurveSpiralTableFlag = True Then
                Dim aErrDrawToStr As String = String.Empty, errDrawToFlag As Boolean = False
                Try
                    dlgMain.pb1.Value = 0 : dlgMain.pb1.Refresh()
 
                    Dim angularPointArrayCount As Long, angularPointArrayIndex As Long
                    Dim aArc As AeccAlignmentArc, aTangent As AeccAlignmentTangent, alEntityBefore As AeccAlignmentEntity, aEntities As AeccAlignmentEntities
                    Dim aSpiralIn As AeccAlignmentSpiral, aSpiralOut As AeccAlignmentSpiral, alEntityAfter As AeccAlignmentEntity
                    Dim aSpiralOutDelta As Double, aSpiralOutL As Double, aSpiralOutT As Double, aSpiralOutA As Double, aSpiralInDelta As Double, aSpiralInL As Double, aSpiralInT As Double, aSpiralInA As Double
                    Dim aEndFullCurveStation As Double, aSpiralOutTangentOfLastAngularPoint As Double, aTangentLength As Double
                    Dim aFullCurveRotationAngle As Double, aTangentLastDirectionAngle As Double, aFullCurveLastDirectionAngle As Double
                    Dim aLonlyEndingTangent As AeccAlignmentTangent = Nothing
                    Dim aEndFullCurveEasting As Double, aEndFullCurveNorthing As Double
                    Dim aKnownStructureErrorString As String = String.Empty, aSortByStationErrorString As String = String.Empty, aTangentIn As AeccAlignmentTangent, aTangentOut As AeccAlignmentTangent
                    Dim aLastAngularPointIsArc As Boolean
                    Dim aAngularPointIsArc As Boolean
 
                    aEntities = curAlignment.Entities
 
                    If Create_AngularPointArray(aKnownStructureErrorString, aSortByStationErrorString) = False Then
                        If MsgBox(ResourceManagerMainShadow.GetString("Error creating Alignment structure.", curUICulture) & vbCrLf & _
                                  aKnownStructureErrorString & vbCrLf & vbCrLf & _
                                  aSortByStationErrorString & vbCrLf & vbCrLf & _
                                  ResourceManagerMainShadow.GetString("Output data may be inaccurate.", curUICulture) & vbCrLf & _
                                  ResourceManagerMainShadow.GetString("Continue anyway?", curUICulture), vbOKCancel + vbExclamation, ResourceManagerMainShadow.GetString("Application Name", curUICulture)) = vbCancel Then
                            Exit Sub '"Ошибка создания структуры Трассы."
                        End If '"Выходные данные могут быть неточными."
                    End If '"
 
                    angularPointArrayCount = AngularPointArray.Length
 
                    If angularPointArrayCount < 1 Or (AngularPointArray IsNot Nothing And AngularPointArray(0) Is Nothing) Then
                        MsgBox(ResourceManagerMainShadow.GetString("PIPoints in Alignment", curUICulture) & " <" & curAlignment.Name & "> " & ResourceManagerMainShadow.GetString("NOT found.", curUICulture) & vbCrLf & _
                               ResourceManagerMainShadow.GetString("Railway Plane elements Parameter Table( Form 2 GOST Р 21.1702-96)", curUICulture) & vbCrLf & _
                               ResourceManagerMainShadow.GetString("will NOT be inserted.", curUICulture), vbExclamation, ResourceManagerMainShadow.GetString("Application Name", curUICulture))
                        Exit Sub
                    End If
 
                    insertionPointAdvancedParamTable(0) = minCurProfileViewExtPoint(0)
                    insertionPointAdvancedParamTable(1) = minCurProfileViewExtPoint(1) - 5900 + pDeltaAdvancedParamTableY
 
                    Dim aTable As AcadTable
                    aTable = ThisDrawing.ModelSpace.AddTable(insertionPointAdvancedParamTable, 8 + (angularPointArrayCount * 6), 13, textHeightWorkingValue * 3.2, textHeightWorkingValue * 50)
                    aTable.RegenerateTableSuppressed = True
                    With aTable
 
                        .Layer = pLayerAdvancedParamTableName
                        .HeaderSuppressed = True
                        .TitleSuppressed = True
 
                        .SetColumnWidth(0, textHeightWorkingValue * 6)
                        .SetColumnWidth(1, textHeightWorkingValue * 8)
                        .SetColumnWidth(2, textHeightWorkingValue * 10)
                        .SetColumnWidth(3, textHeightWorkingValue * 10)
                        .SetColumnWidth(4, textHeightWorkingValue * 8)
                        .SetColumnWidth(5, textHeightWorkingValue * 8)
                        .SetColumnWidth(6, textHeightWorkingValue * 8)
                        .SetColumnWidth(7, textHeightWorkingValue * 8)
                        .SetColumnWidth(8, textHeightWorkingValue * 8)
                        .SetColumnWidth(9, textHeightWorkingValue * 8)
                        .SetColumnWidth(10, textHeightWorkingValue * 10)
                        .SetColumnWidth(11, textHeightWorkingValue * 10)
                        .SetColumnWidth(12, textHeightWorkingValue * 8)
 
                        .SetRowHeight(0, textHeightWorkingValue * 5)
                        .SetRowHeight(1, textHeightWorkingValue * 2)
                        .SetRowHeight(2, textHeightWorkingValue * 4)
                        .SetRowHeight(3, textHeightWorkingValue * 4)
 
                        .SetTextHeight(AcRowType.acDataRow, textHeightWorkingValue)
                        '.SetAlignment 0, acMiddleCenter
                        .SetAlignment(AcRowType.acDataRow, AcCellAlignment.acMiddleCenter)
                        '.StyleName = ThisDrawing.TextStyles(styleWorkingValueNameIndex).Name
                        .SetTextStyle(AcRowType.acDataRow, ThisDrawing.TextStyles.Item(styleWorkingValueNameIndex).Name)
 
                        .SetText(0, 0, ResourceManagerMainShadow.GetString("Railway Plane elements Parameter Table( Form 2 GOST Р 21.1702-96)", curUICulture)) '"Ведомость элементов плана железнодорожных путей ( Форма 2 ГОСТ Р 21.1702-96)"
 
                        .MergeCells(1, 3, 0, 0) : .SetText(1, 0, ResourceManagerMainShadow.GetString("Way number", curUICulture)) '"Номер пути"
                        .MergeCells(1, 3, 1, 1) : .SetText(1, 1, ResourceManagerMainShadow.GetString("Point description", curUICulture)) '"Обозначение точки"
                        .MergeCells(1, 1, 2, 3) : .SetText(1, 2, ResourceManagerMainShadow.GetString("Point coordinate", curUICulture)) '"Координата точки"
                        .MergeCells(2, 3, 2, 2) : .SetText(2, 2, ResourceManagerMainShadow.GetString("A", curUICulture)) '"А"
                        .MergeCells(2, 3, 3, 3) : .SetText(2, 3, ResourceManagerMainShadow.GetString("B", curUICulture)) '"Б"
                        .MergeCells(1, 3, 4, 4) : .SetText(1, 4, ResourceManagerMainShadow.GetString("Distance between points", curUICulture) & ResourceManagerMainShadow.GetString(", m", curUICulture)) '"Расстояние между точками"
                        .MergeCells(1, 1, 5, 9) : .SetText(1, 5, ResourceManagerMainShadow.GetString("Curvature elements", curUICulture)) '"Элементы кривой"
                        .MergeCells(2, 3, 5, 5) : .SetText(2, 5, ResourceManagerMainShadow.GetString("Angle", curUICulture) & ", " & ChrW(176)) '"угол"
                        .MergeCells(2, 3, 6, 6) : .SetText(2, 6, ResourceManagerMainShadow.GetString("Radius", curUICulture) & ResourceManagerMainShadow.GetString(", m", curUICulture)) '"радиус"
                        .MergeCells(2, 3, 7, 7) : .SetText(2, 7, ResourceManagerMainShadow.GetString("Total Tangent length", curUICulture) & ResourceManagerMainShadow.GetString(", m", curUICulture)) '"тангенс"
                        .MergeCells(2, 3, 8, 8) : .SetText(2, 8, ResourceManagerMainShadow.GetString("Curve length", curUICulture) & ResourceManagerMainShadow.GetString(", m", curUICulture)) '"кривая"
                        .MergeCells(2, 3, 9, 9) : .SetText(2, 9, ResourceManagerMainShadow.GetString("Spiral length", curUICulture) & ResourceManagerMainShadow.GetString(", m", curUICulture)) '"длина переходной кривой"
                        .MergeCells(1, 1, 10, 11) : .SetText(1, 10, ResourceManagerMainShadow.GetString("Station 2", curUICulture)) '"Пикет"
                        .MergeCells(2, 3, 10, 10) : .SetText(2, 10, ResourceManagerMainShadow.GetString("Curvature Begin", curUICulture)) '"НК"
                        .MergeCells(2, 3, 11, 11) : .SetText(2, 11, ResourceManagerMainShadow.GetString("Curvature End", curUICulture)) '"КК"
                        .MergeCells(1, 3, 12, 12) : .SetText(1, 12, ResourceManagerMainShadow.GetString("Tangent length", curUICulture) & ResourceManagerMainShadow.GetString(", m", curUICulture)) '""
 
 
                        aSpiralOutTangentOfLastAngularPoint = 0
                        aLastAngularPointIsArc = True
                        For angularPointArrayIndex = 1 To angularPointArrayCount
 
                            aLonlyEndingTangent = Nothing
 
                            If angularPointArrayIndex = 1 Then
                                .SetText(1 + ((angularPointArrayIndex * 6) - 3), 1, ResourceManagerMainShadow.GetString("Alignment Begin", curUICulture))
                                .MergeCells(1 + ((angularPointArrayIndex * 6) - 3), 2 + ((angularPointArrayIndex * 6) - 3), 1, 1)
                            End If
 
                            If AngularPointArray(angularPointArrayIndex - 1).Arc Is Nothing Then
 
                                aAngularPointIsArc = False
 
                                aTangentIn = AngularPointArray(angularPointArrayIndex - 1).BeforeEntity
                                aTangentOut = AngularPointArray(angularPointArrayIndex - 1).AfterEntity
 
                                Call DrawTangentRowInRotAngleTanCurSpirParamTableRail(aTable, aTangentIn, angularPointArrayIndex, 0, aAngularPointIsArc, aErrDrawToStr)
                                aTangentLength = 0
                                aTangentLastDirectionAngle = aTangentIn.Direction
                                aSpiralInDelta = 0
                                aSpiralInL = 0
                                aSpiralInA = 0
                                aSpiralOutDelta = 0
                                aSpiralOutL = 0
                                aSpiralOutA = 0
                                aEndFullCurveStation = aTangentOut.EndingStation
                                aLonlyEndingTangent = aTangentOut
                                aSpiralOutT = aTangentOut.Length
                                aSpiralInT = aTangentIn.Length
                                aFullCurveRotationAngle = (aTangentOut.Direction - aTangentIn.Direction)
 
                                If angularPointArrayIndex = 1 Then
                                    aFullCurveLastDirectionAngle = aTangentLastDirectionAngle + aFullCurveRotationAngle
                                Else
                                    aFullCurveLastDirectionAngle = aFullCurveLastDirectionAngle + aFullCurveRotationAngle
                                End If
 
                                Call DrawSpirCurSpirRowInRotAngleTanCurSpirParamTableRail(aTable, aTangentIn.EndingStation, aTangentIn.StartEasting, aTangentIn.StartNorthing, aTangentIn.EndEasting, _
                                                                                          aTangentIn.EndNorthing, aTangentOut.EndEasting, aTangentOut.EndNorthing, _
                                                                                          aFullCurveRotationAngle, angularPointArrayIndex, aSpiralInL, aSpiralInT, aSpiralOutL, aSpiralOutT, _
                                                                                          aTangentIn.StartingStation, aEndFullCurveStation, _
                                                                                          0, 0, 0, 0, 0, aAngularPointIsArc, aErrDrawToStr)
 
                                aSpiralOutTangentOfLastAngularPoint = aSpiralOutT
 
                                aLastAngularPointIsArc = False
 
                            Else
 
                                aAngularPointIsArc = True
 
                                aArc = AngularPointArray(angularPointArrayIndex - 1).Arc
                                If AngularPointArray(angularPointArrayIndex - 1).AlignmentAngularPointType <> -1 Then
                                    alEntityBefore = AngularPointArray(angularPointArrayIndex - 1).BeforeEntity
                                    alEntityAfter = AngularPointArray(angularPointArrayIndex - 1).AfterEntity
                                Else                               
                                    alEntityBefore = GetEntity(aEntities, aArc.EntityBefore)
                                    alEntityAfter = GetEntity(aEntities, aArc.EntityAfter)
                                End If
 
                                If alEntityBefore IsNot Nothing AndAlso alEntityBefore.Type = AeccAlignmentEntityType.aeccSpiral Then
                                    If aEntities.EntityAtId(alEntityBefore.EntityBefore) IsNot Nothing AndAlso aEntities.EntityAtId(alEntityBefore.EntityBefore).Type = AeccAlignmentEntityType.aeccTangent Then
                                        aTangent = aEntities.EntityAtId(alEntityBefore.EntityBefore)
                                        If aLastAngularPointIsArc = False Then
                                            Call DrawTangentRowInRotAngleTanCurSpirParamTableRail(aTable, aTangent, angularPointArrayIndex, 0, aLastAngularPointIsArc, aErrDrawToStr)
                                        Else
                                            Call DrawTangentRowInRotAngleTanCurSpirParamTableRail(aTable, aTangent, angularPointArrayIndex, aTangent.Length, aAngularPointIsArc, aErrDrawToStr)
                                        End If
                                        aTangentLength = aTangent.Length
                                        aTangentLastDirectionAngle = aTangent.Direction
                                    Else
                                        aTangentLength = 0
                                        aTangentLastDirectionAngle = 0
                                    End If
 
                                    aSpiralIn = alEntityBefore
 
                                    If alEntityAfter IsNot Nothing AndAlso alEntityAfter.Type = AeccAlignmentEntityType.aeccSpiral Then
                                        aSpiralOut = alEntityAfter
                                        aSpiralOutDelta = aSpiralOut.Delta
                                        aSpiralOutL = aSpiralOut.Length
                                        aSpiralOutA = aSpiralOut.A
                                        aEndFullCurveStation = aSpiralOut.EndingStation
                                        aEndFullCurveEasting = aSpiralOut.EndEasting
                                        aEndFullCurveNorthing = aSpiralOut.EndNorthing
                                        If aEntities.EntityAtId(alEntityAfter.EntityAfter) IsNot Nothing AndAlso aEntities.EntityAtId(alEntityAfter.EntityAfter).Type = AeccAlignmentEntityType.aeccTangent Then
                                            aLonlyEndingTangent = aEntities.EntityAtId(alEntityAfter.EntityAfter)
                                        End If
                                    Else
                                        aSpiralOutDelta = 0
                                        aSpiralOutL = 0
                                        aSpiralOutA = 0
                                        aEndFullCurveStation = aArc.EndingStation
                                        aEndFullCurveEasting = aArc.EndEasting
                                        aEndFullCurveNorthing = aArc.EndNorthing
                                        If alEntityAfter IsNot Nothing AndAlso alEntityAfter.Type = AeccAlignmentEntityType.aeccTangent Then
                                            aLonlyEndingTangent = alEntityAfter
                                        End If
                                    End If
                                    aSpiralOutT = CalculateTangentLength(aArc.PIEasting, aArc.PINorthing, aEndFullCurveEasting, aEndFullCurveNorthing)
                                    aSpiralInT = CalculateTangentLength(aSpiralIn.StartEasting, aSpiralIn.StartNorthing, aArc.PIEasting, aArc.PINorthing)
                                    aFullCurveRotationAngle = (aArc.Delta + aSpiralIn.Delta + aSpiralOutDelta) * IIf(aArc.Clockwise, 1, -1)
 
                                    If angularPointArrayIndex = 1 Then
                                        aFullCurveLastDirectionAngle = aTangentLastDirectionAngle + aFullCurveRotationAngle
                                    Else
                                        aFullCurveLastDirectionAngle = aFullCurveLastDirectionAngle + aFullCurveRotationAngle
                                    End If
 
                                    Call DrawSpirCurSpirRowInRotAngleTanCurSpirParamTableRail(aTable, aArc.PIStation, aSpiralIn.StartEasting, aSpiralIn.StartNorthing, aArc.PIEasting, aArc.PINorthing, aEndFullCurveEasting, _
                                                                                              aEndFullCurveNorthing, aFullCurveRotationAngle, angularPointArrayIndex, aSpiralIn.Length, aSpiralInT, aSpiralOutL, aSpiralOutT, _
                                                                                              aSpiralIn.StartingStation, aEndFullCurveStation, aArc.StartingStation, aArc.Delta, aArc.Radius, aArc.Length, aArc.EndingStation, _
                                                                                              aAngularPointIsArc, aErrDrawToStr)
 
                                    aSpiralOutTangentOfLastAngularPoint = aSpiralOutT
 
                                ElseIf alEntityBefore Is Nothing OrElse (alEntityBefore.Type = AeccAlignmentEntityType.aeccArc Or alEntityBefore.Type = AeccAlignmentEntityType.aeccSpiralCurveGroup) Then   
                                    aTangentLength = 0
                                    aTangentLastDirectionAngle = 0
 
                                    aSpiralInDelta = 0
                                    aSpiralInL = 0
                                    aSpiralInA = 0
 
                                    If alEntityAfter IsNot Nothing AndAlso alEntityAfter.Type = AeccAlignmentEntityType.aeccSpiral Then 'alEntityAfter.Type = aeccSpiral   "IAeccAlignmentSpiral"
                                        aSpiralOut = alEntityAfter
                                        aSpiralOutDelta = aSpiralOut.Delta
                                        aSpiralOutL = aSpiralOut.Length
                                        aSpiralOutA = aSpiralOut.A
                                        aEndFullCurveStation = aSpiralOut.EndingStation
                                        aEndFullCurveEasting = aSpiralOut.EndEasting
                                        aEndFullCurveNorthing = aSpiralOut.EndNorthing
                                        If aEntities.EntityAtId(alEntityAfter.EntityAfter) IsNot Nothing AndAlso aEntities.EntityAtId(alEntityAfter.EntityAfter).Type = AeccAlignmentEntityType.aeccTangent Then
                                            aLonlyEndingTangent = aEntities.EntityAtId(alEntityAfter.EntityAfter)
                                        End If
                                    Else
                                        aSpiralOutDelta = 0
                                        aSpiralOutL = 0
                                        aSpiralOutA = 0
                                        aEndFullCurveStation = aArc.EndingStation
                                        aEndFullCurveEasting = aArc.EndEasting
                                        aEndFullCurveNorthing = aArc.EndNorthing
                                        If alEntityAfter IsNot Nothing AndAlso alEntityAfter.Type = AeccAlignmentEntityType.aeccTangent Then
                                            aLonlyEndingTangent = alEntityAfter
                                        End If
                                    End If
 
                                    aSpiralOutT = CalculateTangentLength(aArc.PIEasting, aArc.PINorthing, aEndFullCurveEasting, aEndFullCurveNorthing)
                                    aSpiralInT = CalculateTangentLength(aArc.StartEasting, aArc.StartNorthing, aArc.PIEasting, aArc.PINorthing)
                                    aFullCurveRotationAngle = (aArc.Delta + aSpiralInDelta + aSpiralOutDelta) * IIf(aArc.Clockwise, 1, -1)
 
                                    If angularPointArrayIndex = 1 Then
                                        aFullCurveLastDirectionAngle = aTangentLastDirectionAngle + aFullCurveRotationAngle
                                    Else
                                        aFullCurveLastDirectionAngle = aFullCurveLastDirectionAngle + aFullCurveRotationAngle
                                    End If
 
 
                                    Call DrawSpirCurSpirRowInRotAngleTanCurSpirParamTableRail(aTable, aArc.PIStation, aArc.StartEasting, aArc.StartNorthing, aArc.PIEasting, aArc.PINorthing, aEndFullCurveEasting, _
                                                                                              aEndFullCurveNorthing, aFullCurveRotationAngle, angularPointArrayIndex, aSpiralInL, aSpiralInT, aSpiralOutL, aSpiralOutT, _
                                                                                              aArc.StartingStation, aEndFullCurveStation, aArc.StartingStation, aArc.Delta, aArc.Radius, aArc.Length, aArc.EndingStation, _
                                                                                              aAngularPointIsArc, aErrDrawToStr)
 
                                    aSpiralOutTangentOfLastAngularPoint = aSpiralOutT
 
                                ElseIf alEntityBefore IsNot Nothing AndAlso alEntityBefore.Type = AeccAlignmentEntityType.aeccTangent Then
 
                                    aTangent = alEntityBefore
                                    If aLastAngularPointIsArc = False Then
                                        Call DrawTangentRowInRotAngleTanCurSpirParamTableRail(aTable, aTangent, angularPointArrayIndex, 0, aLastAngularPointIsArc, aErrDrawToStr)
                                    Else
                                        Call DrawTangentRowInRotAngleTanCurSpirParamTableRail(aTable, aTangent, angularPointArrayIndex, aTangent.Length, aAngularPointIsArc, aErrDrawToStr)
                                    End If
                                    aTangentLength = aTangent.Length
                                    aTangentLastDirectionAngle = aTangent.Direction
 
                                    aSpiralInDelta = 0
                                    aSpiralInL = 0
                                    aSpiralInA = 0
 
                                    If alEntityAfter IsNot Nothing AndAlso alEntityAfter.Type = AeccAlignmentEntityType.aeccSpiral Then
                                        aSpiralOut = alEntityAfter
                                        aSpiralOutDelta = aSpiralOut.Delta
                                        aSpiralOutL = aSpiralOut.Length
                                        aSpiralOutA = aSpiralOut.A
                                        aEndFullCurveStation = aSpiralOut.EndingStation
                                        aEndFullCurveEasting = aSpiralOut.EndEasting
                                        aEndFullCurveNorthing = aSpiralOut.EndNorthing
                                        If aEntities.EntityAtId(alEntityAfter.EntityAfter) IsNot Nothing AndAlso aEntities.EntityAtId(alEntityAfter.EntityAfter).Type = AeccAlignmentEntityType.aeccTangent Then
                                            aLonlyEndingTangent = aEntities.EntityAtId(alEntityAfter.EntityAfter)
                                        End If
                                    Else
                                        aSpiralOutDelta = 0
                                        aSpiralOutL = 0
                                        aSpiralOutA = 0
                                        aEndFullCurveStation = aArc.EndingStation
                                        aEndFullCurveEasting = aArc.EndEasting
                                        aEndFullCurveNorthing = aArc.EndNorthing
                                        If alEntityAfter IsNot Nothing AndAlso alEntityAfter.Type = AeccAlignmentEntityType.aeccTangent Then
                                            aLonlyEndingTangent = alEntityAfter
                                        End If
                                    End If
 
                                    aSpiralOutT = CalculateTangentLength(aArc.PIEasting, aArc.PINorthing, aEndFullCurveEasting, aEndFullCurveNorthing)
                                    aSpiralInT = CalculateTangentLength(aArc.StartEasting, aArc.StartNorthing, aArc.PIEasting, aArc.PINorthing)
                                    aFullCurveRotationAngle = (aArc.Delta + aSpiralInDelta + aSpiralOutDelta) * IIf(aArc.Clockwise, 1, -1)
 
                                    If angularPointArrayIndex = 1 Then
                                        aFullCurveLastDirectionAngle = aTangentLastDirectionAngle + aFullCurveRotationAngle
                                    Else
                                        aFullCurveLastDirectionAngle = aFullCurveLastDirectionAngle + aFullCurveRotationAngle
                                    End If
 
                                    Call DrawSpirCurSpirRowInRotAngleTanCurSpirParamTableRail(aTable, aArc.PIStation, aArc.StartEasting, aArc.StartNorthing, aArc.PIEasting, aArc.PINorthing, aEndFullCurveEasting, _
                                                                                              aEndFullCurveNorthing, aFullCurveRotationAngle, angularPointArrayIndex, aSpiralInL, aSpiralInT, aSpiralOutL, aSpiralOutT, _
                                                                                              aArc.StartingStation, aEndFullCurveStation, aArc.StartingStation, aArc.Delta, aArc.Radius, aArc.Length, aArc.EndingStation, _
                                                                                              aAngularPointIsArc, aErrDrawToStr)
 
                                    aSpiralOutTangentOfLastAngularPoint = aSpiralOutT
 
                                Else
                                    aErrDrawToStr += ResourceManagerMainShadow.GetString("Alignment contains unsupported elements:", curUICulture) & TypeName(alEntityBefore)
                                    aTable.SetRowHeight(1 + ((angularPointArrayIndex * 6) - 3), textHeightWorkingValue * 1.6)
                                    aTable.SetRowHeight(2 + ((angularPointArrayIndex * 6) - 3), textHeightWorkingValue * 1.6)
                                    .MergeCells(1 + ((angularPointArrayIndex * 6) - 3), 2 + ((angularPointArrayIndex * 6) - 3), 0, 12)
                                    aTable.SetRowHeight(3 + ((angularPointArrayIndex * 6) - 3), textHeightWorkingValue * 1.6)
                                    aTable.SetRowHeight(4 + ((angularPointArrayIndex * 6) - 3), textHeightWorkingValue * 1.6)
                                    .MergeCells(3 + ((angularPointArrayIndex * 6) - 3), 4 + ((angularPointArrayIndex * 6) - 3), 0, 12)
                                    aTable.SetRowHeight(5 + ((angularPointArrayIndex * 6) - 3), textHeightWorkingValue * 1.6)
                                    aTable.SetRowHeight(6 + ((angularPointArrayIndex * 6) - 3), textHeightWorkingValue * 1.6)
                                    .MergeCells(5 + ((angularPointArrayIndex * 6) - 3), 6 + ((angularPointArrayIndex * 6) - 3), 0, 12)
                                    aTable.SetRowHeight(7 + ((angularPointArrayIndex * 6) - 3), textHeightWorkingValue * 1.6)
                                    aTable.SetRowHeight(8 + ((angularPointArrayIndex * 6) - 3), textHeightWorkingValue * 1.6)
                                    .MergeCells(7 + ((angularPointArrayIndex * 6) - 3), 8 + ((angularPointArrayIndex * 6) - 3), 0, 12)
                                End If
 
                                aLastAngularPointIsArc = True
 
                            End If
 
                            dlgMain.pb1.Value = CInt((angularPointArrayIndex / angularPointArrayCount) * 100) : dlgMain.pb1.Refresh()
 
                        Next angularPointArrayIndex
 
                        If aLonlyEndingTangent IsNot Nothing AndAlso aLonlyEndingTangent.Type = AeccAlignmentEntityType.aeccTangent Then
                            .SetText(9 + (((angularPointArrayIndex - 1) * 6) - 3), 1, ResourceManagerMainShadow.GetString("Alignment End", curUICulture)) '"конец трассы"
                            .MergeCells(9 + (((angularPointArrayIndex - 1) * 6) - 3), 10 + (((angularPointArrayIndex - 1) * 6) - 3), 1, 1)
                            If aAngularPointIsArc = True Then
                                Call DrawEndTangentRowInRotAngleTanCurSpirParamTableRail(aTable, aLonlyEndingTangent, angularPointArrayIndex - 1, aLonlyEndingTangent.Length, aLastAngularPointIsArc, aErrDrawToStr)
                            Else
                                Call DrawEndTangentRowInRotAngleTanCurSpirParamTableRail(aTable, aLonlyEndingTangent, angularPointArrayIndex - 1, 0, aLastAngularPointIsArc, aErrDrawToStr)
                            End If
 
                            .MergeCells(4, 7 + ((angularPointArrayIndex - 1) * 6), 0, 0)
                        Else
                            .DeleteRows(6 + ((angularPointArrayIndex - 1) * 6), 2)
                            .MergeCells(4, 5 + ((angularPointArrayIndex - 1) * 6), 0, 0)
                        End If
 
                        .RegenerateTableSuppressed = False
                        .RecomputeTableBlock(True)
 
                    End With
 
                    If aErrDrawToStr <> String.Empty Then
                        errDrawToFlag = True
                        Throw New System.Exception(ResourceManagerMainShadow.GetString("Creating Plane elements Parameter Table( Form 2 GOST Р 21.1702-96).", curUICulture) & vbCrLf & aErrDrawToStr)
                    End If
 
                Catch ex As System.Exception
                    If errDrawToFlag = False Then
                        BuildErrorMessage(New System.Exception(ResourceManagerMainShadow.GetString("Creating Plane elements Parameter Table( Form 2 GOST Р 21.1702-96).", curUICulture) & vbCrLf & aErrDrawToStr, ex), False)
                    Else
                        BuildErrorMessage(ex, False)
                    End If
                Finally
                    dlgMain.pb1.Value = 0 : dlgMain.pb1.Refresh()
                End Try
            End If
 
        End Sub
 
 Friend Shared Function GetEntityAtIdFrom(ByRef pAlignment As IAeccAlignment, ByVal EntityId As Int32) As AeccAlignmentEntity
            Try
                Return pAlignment.Entities.EntityAtId(EntityId)
            Catch ex As System.Exception
                Return Nothing
            End Try
        End Function
 
        Friend Shared Function GetEntityAtIdFrom(ByVal EntityId As Int32) As AeccAlignmentEntity
            Try
                Return curAlignment.Entities.EntityAtId(EntityId)
            Catch ex As System.Exception
                Return Nothing
            End Try
        End Function
 
        Friend Shared Function GetEntityTypeAtIdFrom(ByRef pAlignment As IAeccAlignment, ByVal EntityId As Int32) As AeccAlignmentEntityType
            Try
                Return pAlignment.Entities.EntityAtId(EntityId).Type
            Catch ex As System.Exception
                Return -1
            End Try
        End Function
 
        Friend Shared Function GetEntityTypeAtIdFrom(ByVal EntityId As Int32) As AeccAlignmentEntityType
            Try
                Return curAlignment.Entities.EntityAtId(EntityId).Type
            Catch ex As System.Exception
                Return -1
            End Try
        End Function

Александр Ривилис · « **Ответ #1 :** 11-01-2019, 15:20:54 »

soloviewserg,
Спасибо, что поделился своими наработками!

soloviewserg · « **Ответ #2 :** 11-01-2019, 19:30:26 »

Any time!

Выше ограничение на кол-во символов не позволило выложить все ссылки из кода. Добавляем.

Код - vb.net [Выбрать]

  Friend Shared Function Create_AngularPointArray(ByRef aKnownStructureErrorString As String, ByRef aSortByStationErrorString As String) As Boolean
 
            Dim alEntity As AeccAlignmentEntity, aArc As AeccAlignmentArc, aEntities As AeccAlignmentEntities
            Dim aKnownStructureFlag As Boolean, resultSortByStation_AngularPointArray As Boolean
            Dim aSCSGroup As AeccAlignmentSCSGroup
            Dim aCSGroup As AeccAlignmentCSGroup, aSCGroup As AeccAlignmentSCGroup, aSCSCSGroup As AeccAlignmentSCSCSGroup
            Dim aSCSSCSGroup As AeccAlignmentSCSSCSGroup, aSSCGroup As AeccAlignmentSSCGroup, aCSSGroup As AeccAlignmentCSSGroup
            Dim aTangent As AeccAlignmentTangent, aTSGroup As AeccAlignmentTSGroup
            Dim aSpiral As AeccAlignmentSpiral, aSSGroup As AeccAlignmentSSGroup, aSTGroup As AeccAlignmentSTGroup, aSTSGroup As AeccAlignmentSTSGroup
 
            Try
 
                ReDim AngularPointArray(0) : AngularPointArray(0) = Nothing
                aKnownStructureFlag = True
                Create_AngularPointArray = True
 
                Dim index As Int32 = 0
                aEntities = curAlignment.Entities
                dlgMain.pb1.Value = 0 : dlgMain.pb1.Refresh()
                For index = 0 To aEntities.Count - 1
 
                    alEntity = aEntities.Item(index)
                    Select Case alEntity.Type
                        Case AeccAlignmentEntityType.aeccArc
                            aArc = alEntity
                            Call AddAngularPointToAngularPointArray(AngularPointArray, aArc, GetEntityAtIdFrom(aArc.EntityBefore), GetEntityAtIdFrom(aArc.EntityAfter), -1, aArc.StartingStation, aArc.Id)
                        Case AeccAlignmentEntityType.aeccSpiral
                            aSpiral = alEntity
                            If (GetEntityTypeAtIdFrom(aSpiral.EntityAfter) = AeccAlignmentEntityType.aeccArc) Or _
                               (GetEntityTypeAtIdFrom(aSpiral.EntityBefore) = AeccAlignmentEntityType.aeccArc) Then
                                'Nothing
                            Else
                                aKnownStructureFlag = False
                                aKnownStructureErrorString = aKnownStructureErrorString + "free Spiral" + vbCrLf
                            End If
                        Case AeccAlignmentEntityType.aeccSpiralSpiralGroup
                            aSSGroup = alEntity
                            aKnownStructureFlag = False
                            aKnownStructureErrorString = aKnownStructureErrorString + "SpiralSpiralGroup" + vbCrLf
                        Case AeccAlignmentEntityType.aeccSpiralTangentGroup
                            aSTGroup = alEntity
                            If GetEntityTypeAtIdFrom(aSTGroup.EntityBefore) = AeccAlignmentEntityType.aeccArc Then
                                'Nothing
                            Else
                                aKnownStructureFlag = False
                                aKnownStructureErrorString = aKnownStructureErrorString + "free SpiralTangentGroup" + vbCrLf
                            End If
                        Case AeccAlignmentEntityType.aeccSpiralTangentSpiralGroup
                            aSTSGroup = alEntity
                            If (GetEntityTypeAtIdFrom(aSTSGroup.EntityAfter) = AeccAlignmentEntityType.aeccArc) Or _
                                (GetEntityTypeAtIdFrom(aSTSGroup.EntityBefore) = AeccAlignmentEntityType.aeccArc) Then
                                'Nothing
                            Else
                                aKnownStructureFlag = False
                                aKnownStructureErrorString = aKnownStructureErrorString + "free SpiralTangentSpiralGroup" + vbCrLf
                            End If
                        Case AeccAlignmentEntityType.aeccSpiralSpiralCurveGroup
                            aSSCGroup = alEntity
                            Call AddAngularPointToAngularPointArray(AngularPointArray, aSSCGroup.Arc, aSSCGroup.Spiral2, Nothing, AeccAlignmentEntityType.aeccSpiralSpiralCurveGroup, aSSCGroup.Arc.StartingStation, aSSCGroup.Arc.Id)
                            aKnownStructureFlag = False
                            aKnownStructureErrorString = aKnownStructureErrorString + "SpiralSpiralCurveGroup" + vbCrLf
                        Case AeccAlignmentEntityType.aeccTangent
                            aTangent = alEntity
                            If curAlignment.StartingStation = aTangent.StartingStation Then
                                If GetEntityTypeAtIdFrom(aTangent.EntityAfter) = AeccAlignmentEntityType.aeccTangent Then
                                    Call AddAngularPointToAngularPointArray(AngularPointArray, Nothing, aTangent, GetEntityAtIdFrom(aTangent.EntityAfter), -1, aTangent.StartingStation, aTangent.Id)
                                ElseIf GetEntityAtIdFrom(aTangent.EntityAfter) IsNot Nothing AndAlso _
                                   ((GetEntityTypeAtIdFrom(GetEntityAtIdFrom(aTangent.EntityAfter).EntityAfter) = AeccAlignmentEntityType.aeccArc) Or _
                                   (GetEntityAtIdFrom(aTangent.EntityAfter).Type = AeccAlignmentEntityType.aeccSpiralCurveSpiralGroup Or _
                                   GetEntityAtIdFrom(aTangent.EntityAfter).Type = AeccAlignmentEntityType.aeccSpiralCurveGroup Or _
                                   GetEntityAtIdFrom(aTangent.EntityAfter).Type = AeccAlignmentEntityType.aeccArc)) Then
                                    'Nothing
                                Else
                                    aKnownStructureFlag = False
                                    aKnownStructureErrorString = aKnownStructureErrorString + "free Tangent" + vbCrLf
                                End If
                            ElseIf curAlignment.EndingStation = aTangent.EndingStation Then
                                If GetEntityAtIdFrom(aTangent.EntityBefore) IsNot Nothing AndAlso _
                                 ((GetEntityTypeAtIdFrom(GetEntityAtIdFrom(aTangent.EntityBefore).EntityBefore) = AeccAlignmentEntityType.aeccArc) Or _
                                    (GetEntityAtIdFrom(aTangent.EntityBefore).Type = AeccAlignmentEntityType.aeccSpiralCurveSpiralGroup Or _
                                    GetEntityAtIdFrom(aTangent.EntityBefore).Type = AeccAlignmentEntityType.aeccCurveSpiralGroup Or _
                                    GetEntityAtIdFrom(aTangent.EntityBefore).Type = AeccAlignmentEntityType.aeccTangent Or _
                                    GetEntityAtIdFrom(aTangent.EntityBefore).Type = AeccAlignmentEntityType.aeccArc)) Then
                                    'Nothing
                                Else
                                    aKnownStructureFlag = False
                                    aKnownStructureErrorString = aKnownStructureErrorString + "free Tangent" + vbCrLf
                                End If
                            Else
                                If GetEntityAtIdFrom(aTangent.EntityAfter).Type = AeccAlignmentEntityType.aeccTangent Then
                                    Call AddAngularPointToAngularPointArray(AngularPointArray, Nothing, aTangent, GetEntityAtIdFrom(aTangent.EntityAfter), -1, aTangent.StartingStation, aTangent.Id)
                                ElseIf (GetEntityAtIdFrom(aTangent.EntityAfter) IsNot Nothing AndAlso _
                                   ((GetEntityTypeAtIdFrom(GetEntityAtIdFrom(aTangent.EntityAfter).EntityAfter) = AeccAlignmentEntityType.aeccArc) Or _
                                    GetEntityAtIdFrom(aTangent.EntityAfter).Type = AeccAlignmentEntityType.aeccSpiralCurveSpiralGroup Or _
                                    GetEntityAtIdFrom(aTangent.EntityAfter).Type = AeccAlignmentEntityType.aeccSpiralCurveGroup Or _
                                    GetEntityAtIdFrom(aTangent.EntityAfter).Type = AeccAlignmentEntityType.aeccArc)) Or _
                                       (GetEntityAtIdFrom(aTangent.EntityBefore) IsNot Nothing AndAlso _
                                   ((GetEntityTypeAtIdFrom(GetEntityAtIdFrom(aTangent.EntityBefore).EntityBefore) = AeccAlignmentEntityType.aeccArc) Or _
                                   GetEntityAtIdFrom(aTangent.EntityBefore).Type = AeccAlignmentEntityType.aeccSpiralCurveSpiralGroup Or _
                                   GetEntityAtIdFrom(aTangent.EntityBefore).Type = AeccAlignmentEntityType.aeccCurveSpiralGroup Or _
                                   GetEntityAtIdFrom(aTangent.EntityBefore).Type = AeccAlignmentEntityType.aeccArc Or _
                                   GetEntityAtIdFrom(aTangent.EntityBefore).Type = AeccAlignmentEntityType.aeccTangent)) Then
                                    'Nothing
                                Else
                                    aKnownStructureFlag = False
                                    aKnownStructureErrorString = aKnownStructureErrorString + "free Tangent" + vbCrLf
                                End If
                            End If
 
                        Case AeccAlignmentEntityType.aeccTangentSpiralGroup
                            aTSGroup = alEntity
                            If GetEntityTypeAtIdFrom(aTSGroup.EntityAfter) = AeccAlignmentEntityType.aeccArc Then
                                'Nothing
                            Else
                                aKnownStructureFlag = False
                                aKnownStructureErrorString = aKnownStructureErrorString + "free TangentSpiralGroup" + vbCrLf
                            End If
                        Case AeccAlignmentEntityType.aeccSpiralCurveSpiralGroup
                            aSCSGroup = alEntity
                            Call AddAngularPointToAngularPointArray(AngularPointArray, aSCSGroup.Arc, aSCSGroup.SpiralIn, aSCSGroup.SpiralOut, AeccAlignmentEntityType.aeccSpiralCurveSpiralGroup, aSCSGroup.Arc.StartingStation, _
                                                                    aSCSGroup.Arc.Id)
                        Case AeccAlignmentEntityType.aeccCurveSpiralGroup
                            aCSGroup = alEntity
                            Call AddAngularPointToAngularPointArray(AngularPointArray, aCSGroup.ArcIn, Nothing, aCSGroup.SpiralOut, AeccAlignmentEntityType.aeccCurveSpiralGroup, aCSGroup.ArcIn.StartingStation, aCSGroup.ArcIn.Id)
                        Case AeccAlignmentEntityType.aeccCurveSpiralSpiralGroup
                            aCSSGroup = alEntity
                            Call AddAngularPointToAngularPointArray(AngularPointArray, aCSSGroup.Arc, Nothing, aCSSGroup.Spiral1, AeccAlignmentEntityType.aeccCurveSpiralSpiralGroup, aCSSGroup.Arc.StartingStation, aCSSGroup.Arc.Id)
                            aKnownStructureFlag = False
                            aKnownStructureErrorString = aKnownStructureErrorString + "CurveSpiralSpiralGroup" + vbCrLf
                        Case AeccAlignmentEntityType.aeccSpiralCurveGroup
                            aSCGroup = alEntity
                            Call AddAngularPointToAngularPointArray(AngularPointArray, aSCGroup.ArcOut, aSCGroup.SpiralIn, Nothing, AeccAlignmentEntityType.aeccSpiralCurveGroup, aSCGroup.ArcOut.StartingStation, aSCGroup.ArcOut.Id)
                        Case AeccAlignmentEntityType.aeccSpiralCurveSpiralCurveSpiralGroup
                            aSCSCSGroup = alEntity
                            Call AddAngularPointToAngularPointArray(AngularPointArray, aSCSCSGroup.Arc1, aSCSCSGroup.Spiral1, aSCSCSGroup.Spiral2, AeccAlignmentEntityType.aeccSpiralCurveSpiralCurveSpiralGroup, _
                                                                    aSCSCSGroup.Arc1.StartingStation, aSCSCSGroup.Arc1.Id)
                            Call AddAngularPointToAngularPointArray(AngularPointArray, aSCSCSGroup.Arc2, Nothing, aSCSCSGroup.Spiral3, AeccAlignmentEntityType.aeccSpiralCurveSpiralCurveSpiralGroup, _
                                                                    aSCSCSGroup.Arc2.StartingStation, aSCSCSGroup.Arc2.Id)
                            aKnownStructureFlag = False
                            aKnownStructureErrorString = aKnownStructureErrorString + "SpiralCurveSpiralCurveSpiralGroup" + vbCrLf
                        Case AeccAlignmentEntityType.aeccSpiralCurveSpiralSpiralCurveSpiralGroup
                            aSCSSCSGroup = alEntity
                            Call AddAngularPointToAngularPointArray(AngularPointArray, aSCSSCSGroup.Arc1, aSCSSCSGroup.Spiral1, aSCSSCSGroup.Spiral2, AeccAlignmentEntityType.aeccSpiralCurveSpiralSpiralCurveSpiralGroup, _
                                                                    aSCSSCSGroup.Arc1.StartingStation, aSCSSCSGroup.Arc1.Id)
                            Call AddAngularPointToAngularPointArray(AngularPointArray, aSCSSCSGroup.Arc2, aSCSSCSGroup.Spiral3, aSCSSCSGroup.Spiral4, AeccAlignmentEntityType.aeccSpiralCurveSpiralSpiralCurveSpiralGroup, _
                                                                    aSCSSCSGroup.Arc2.StartingStation, aSCSSCSGroup.Arc2.Id)
                            aKnownStructureFlag = False
                            aKnownStructureErrorString = aKnownStructureErrorString + "SpiralCurveSpiralSpiralCurveSpiralGroup" + vbCrLf
                    End Select
 
                    dlgMain.pb1.Value = CInt(((index + 1) / (aEntities.Count)) * 100) : dlgMain.pb1.Refresh()
 
                Next index
 
                If aKnownStructureFlag = False Then '"Трасса содержит неподдерживаемые элементы:"
                    aKnownStructureErrorString = ResourceManagerMainShadow.GetString("Alignment contains unsupported elements:", curUICulture) & vbCrLf & vbCrLf & aKnownStructureErrorString '
                End If
 
                resultSortByStation_AngularPointArray = SortByStation_AngularPointArray(aSortByStationErrorString)
 
                If aKnownStructureFlag = False Or resultSortByStation_AngularPointArray = False Then
                    Create_AngularPointArray = False
                End If
 
            Catch ex As System.Exception
                BuildErrorMessage(ex, False)
                Create_AngularPointArray = False
            End Try
        End Function
 
 Friend Shared Function AddAngularPointToAngularPointArray(ByRef aAngularPointArray() As ssAlignmentAngularPoint, ByVal aArc As AeccAlignmentArc, ByVal aBeforeEntity As AeccAlignmentEntity, ByVal aAfterEntity As AeccAlignmentEntity, _
                                                            ByVal aAlignmentAngularPointType As AeccAlignmentEntityType, ByVal aStartingStation As Double, ByVal aId As Long) As Boolean
            Dim arraySize As Long
            Try
                If aAngularPointArray Is Nothing OrElse (aAngularPointArray.Length = 1 And aAngularPointArray(0) Is Nothing) Then
                    arraySize = 0
                Else
                    arraySize = aAngularPointArray.Length ' + 1
                End If
                ReDim Preserve aAngularPointArray(arraySize)
                aAngularPointArray(arraySize) = New ssAlignmentAngularPoint(aArc, aBeforeEntity, aAfterEntity, aAlignmentAngularPointType, aStartingStation, aId)
                AddAngularPointToAngularPointArray = True
            Catch
                AddAngularPointToAngularPointArray = False
            End Try
 
        End Function
 
        Friend Shared Function SortByStation_AngularPointArray(ByRef aSortByStationErrorString As String) As Boolean
 
            Dim localSortByStationAngularPointArray() As ssAlignmentAngularPoint = Nothing
            Dim currentMinStation As Double, currentMinStationAngularPointIndex As Long, lastCurrentMinStationAngularPointIndex As Long
            Dim workMinStation As Double, lastCurrentMinStation As Double
            Dim angularPointArrayCount1 As Long, indexIn As Long, indexOut As Long
 
            SortByStation_AngularPointArray = False
 
            Try
 
                lastCurrentMinStation = -1
                lastCurrentMinStationAngularPointIndex = -1
                If AngularPointArray IsNot Nothing Then
                    angularPointArrayCount1 = AngularPointArray.Length
                End If
                If angularPointArrayCount1 <= 1 Then
                    SortByStation_AngularPointArray = True
                    Exit Function
                End If
                dlgMain.pb1.Value = 0 : dlgMain.pb1.Refresh()
                For index As Int32 = 0 To angularPointArrayCount1 - 1
 
                    For indexOut = 0 To angularPointArrayCount1 - 1
                        If AngularPointArray(indexOut) IsNot Nothing Then
                            currentMinStation = AngularPointArray(indexOut).StartingStation
                            currentMinStationAngularPointIndex = indexOut
                            If lastCurrentMinStationAngularPointIndex = -1 Then
                                If currentMinStation >= lastCurrentMinStation Then
                                    Exit For
                                End If
                            Else
                                If currentMinStation >= lastCurrentMinStation And _
                                   AngularPointArray(indexOut).SortedByStation = False Then
                                    Exit For
                                End If
                            End If
                        End If
                    Next indexOut
 
                    For indexIn = 0 To angularPointArrayCount1 - 1
                        If AngularPointArray(indexIn) IsNot Nothing Then
                            workMinStation = AngularPointArray(indexIn).StartingStation
                            If workMinStation < currentMinStation And workMinStation > lastCurrentMinStation And _
                               AngularPointArray(indexIn).SortedByStation = False Then
                                currentMinStation = workMinStation
                                currentMinStationAngularPointIndex = indexIn
                            End If
                        End If
                    Next indexIn
 
                    lastCurrentMinStation = currentMinStation
                    lastCurrentMinStationAngularPointIndex = currentMinStationAngularPointIndex
 
                    Call AddAngularPointToAngularPointArray(localSortByStationAngularPointArray, AngularPointArray(currentMinStationAngularPointIndex).Arc, _
                                                                                                 AngularPointArray(currentMinStationAngularPointIndex).BeforeEntity, _
                                                                                                 AngularPointArray(currentMinStationAngularPointIndex).AfterEntity, _
                                                                                                 AngularPointArray(currentMinStationAngularPointIndex).AlignmentAngularPointType, _
                                                                                                 AngularPointArray(currentMinStationAngularPointIndex).StartingStation, _
                                                                                                 AngularPointArray(currentMinStationAngularPointIndex).Id)
 
                    AngularPointArray(currentMinStationAngularPointIndex).SortedByStation = True
 
                    dlgMain.pb1.Value = CInt((index / (angularPointArrayCount1 - 1)) * 100) : dlgMain.pb1.Refresh()
 
                Next index
 
                ReDim AngularPointArray(0) : AngularPointArray(0) = Nothing
 
                For index As Int32 = 0 To localSortByStationAngularPointArray.Length - 1
                    ReDim Preserve AngularPointArray(index)
                    AngularPointArray(index) = localSortByStationAngularPointArray(index)
                    AngularPointArray(index).SortedByStation = False
                Next index
                ReDim localSortByStationAngularPointArray(0) : localSortByStationAngularPointArray(0) = Nothing
 
                dlgMain.pb1.Value = 0 : dlgMain.pb1.Refresh()
 
                SortByStation_AngularPointArray = True
 
            Catch ex As System.Exception
                aSortByStationErrorString = ResourceManagerMainShadow.GetString("Error angle points sorting:", curUICulture) & vbCrLf & ex.Message '"Ошибка сортировки вершин углов:"
                SortByStation_AngularPointArray = False
            End Try
 
        End Function
 
        Friend Shared Function GetIndexById_AngularPointArray(ByRef aAngularPointArray() As ssAlignmentAngularPoint, ByVal id As Int32) As Int32
            Try
                Dim indexById As Int32
                For indexById = 0 To aAngularPointArray.Length - 1
                    If aAngularPointArray(indexById).Id = id Then
                        GetIndexById_AngularPointArray = indexById
                        Exit Function
                    End If
                Next indexById
                GetIndexById_AngularPointArray = -1
            Catch ex As System.Exception
                GetIndexById_AngularPointArray = -1
            End Try
        End Function
 
 Private Sub DrawTangentRowInRotAngleTanCurSpirParamTableRail(ByRef aTable As AcadTable, ByVal aTangent As AeccAlignmentTangent, ByVal angularPointArrayIndex As Long, ByVal aBetweenPointsLength As Double, _
                                                                     ByVal aAngularPointIsArc As Double, ByRef aErrStr As String)
            Try
                If angularPointArrayIndex = 1 Then
                    aTable.SetText(1 + ((angularPointArrayIndex * 6) - 3), 2, Format(aTangent.StartEasting, "### ### ##0.00")) 'TangentStartEasting
                    aTable.MergeCells(1 + ((angularPointArrayIndex * 6) - 3), 2 + ((angularPointArrayIndex * 6) - 3), 2, 2)
                    aTable.SetText(1 + ((angularPointArrayIndex * 6) - 3), 3, Format(aTangent.StartNorthing, "### ### ##0.00")) 'TangentStartNorthing
                    aTable.MergeCells(1 + ((angularPointArrayIndex * 6) - 3), 2 + ((angularPointArrayIndex * 6) - 3), 3, 3)
                End If
 
                aTable.SetText(2 + ((angularPointArrayIndex * 6) - 3), 4, SmartFormat(aBetweenPointsLength)) 'BetweenPointsLength
                aTable.MergeCells(2 + ((angularPointArrayIndex * 6) - 3), 3 + ((angularPointArrayIndex * 6) - 3), 4, 4)
 
                For jCol As Long = 5 To 11
                    aTable.MergeCells(1 + ((angularPointArrayIndex * 6) - 3), 2 + ((angularPointArrayIndex * 6) - 3), jCol, jCol)
                Next jCol
 
                If aAngularPointIsArc = True Then
                    aTable.SetText(2 + ((angularPointArrayIndex * 6) - 3), 12, Format(aTangent.Length, "### ### ##0.00")) 'TangentLength
                End If
                aTable.MergeCells(2 + ((angularPointArrayIndex * 6) - 3), 3 + ((angularPointArrayIndex * 6) - 3), 12, 12)
 
                aTable.SetRowHeight(1 + ((angularPointArrayIndex * 6) - 3), textHeightWorkingValue * 1.6)
                aTable.SetRowHeight(2 + ((angularPointArrayIndex * 6) - 3), textHeightWorkingValue * 1.6)
            Catch ex As System.Exception
                aErrStr += ex.Message & vbCrLf
            End Try
        End Sub
 
        Private Sub DrawEndTangentRowInRotAngleTanCurSpirParamTableRail(ByRef aTable As AcadTable, ByVal aTangent As AeccAlignmentTangent, ByVal angularPointArrayIndex As Long, ByVal aBetweenPointsLength As Double, _
                                                                        ByVal aAngularPointIsArc As Double, ByRef aErrStr As String)
            Try
                aTable.SetText(9 + ((angularPointArrayIndex * 6) - 3), 2, Format(aTangent.EndEasting, "### ### ##0.00")) 'TangentStartEasting
                aTable.MergeCells(9 + ((angularPointArrayIndex * 6) - 3), 10 + ((angularPointArrayIndex * 6) - 3), 2, 2)
                aTable.SetText(9 + ((angularPointArrayIndex * 6) - 3), 3, Format(aTangent.EndNorthing, "### ### ##0.00")) 'TangentStartNorthing
                aTable.MergeCells(9 + ((angularPointArrayIndex * 6) - 3), 10 + ((angularPointArrayIndex * 6) - 3), 3, 3)
                aTable.SetText(8 + ((angularPointArrayIndex * 6) - 3), 4, SmartFormat(aBetweenPointsLength)) 'BetweenPointsLength
                aTable.MergeCells(8 + ((angularPointArrayIndex * 6) - 3), 9 + ((angularPointArrayIndex * 6) - 3), 4, 4)
 
                For jCol As Long = 5 To 11
                    aTable.MergeCells(9 + ((angularPointArrayIndex * 6) - 3), 10 + ((angularPointArrayIndex * 6) - 3), jCol, jCol)
                Next jCol
 
                If aAngularPointIsArc = True Then
                    aTable.SetText(8 + ((angularPointArrayIndex * 6) - 3), 12, Format(aTangent.Length, "### ### ##0.00")) 'TangentLength
                End If
                aTable.MergeCells(8 + ((angularPointArrayIndex * 6) - 3), 9 + ((angularPointArrayIndex * 6) - 3), 12, 12)
 
                aTable.SetRowHeight(9 + ((angularPointArrayIndex * 6) - 3), textHeightWorkingValue * 1.6)
                aTable.SetRowHeight(10 + ((angularPointArrayIndex * 6) - 3), textHeightWorkingValue * 1.6)
            Catch ex As System.Exception
                aErrStr += ex.Message & vbCrLf
            End Try
        End Sub
 
        Private Sub DrawSpirCurSpirRowInRotAngleTanCurSpirParamTableRail(ByRef aTable As AcadTable, ByVal aArcPIStation As Double, ByVal aStartFullCurveEasting As Double, ByVal aStartFullCurveNorthing As Double, _
                                                                     ByVal aAngularPointEasting As Double, ByVal aAngularPointNorthing As Double, _
                                                                     ByVal aEndFullCurveEasting As Double, ByVal aEndFullCurveNorthing As Double, _
                                                                     ByVal aFullCurveRotationAngle As Double, ByVal angularPointArrayIndex As Long, _
                                                                     ByVal aSpiralInLength As Double, ByVal aSpiralInTangent As Double, ByVal aSpiralOutLength As Double, ByVal aSpiralOutTangent As Double, _
                                                                     ByVal aStartFullCurveStation As Double, ByVal aEndFullCurveStation As Double, _
                                                                     ByVal aArcStartingStation As Double, ByVal aArcDelta As Double, ByVal aArcRadius As Double, ByVal aArcLength As Double, _
                                                                     ByVal aArcEndingStation As Double, _
                                                                     ByVal aAngularPointIsArc As Double, ByRef aErrStr As String)
            Try
                aTable.SetText(3 + ((angularPointArrayIndex * 6) - 3), 1, ResourceManagerMainShadow.GetString("Curvature Begin", curUICulture) & " " & angularPointArrayIndex)
                aTable.MergeCells(3 + ((angularPointArrayIndex * 6) - 3), 4 + ((angularPointArrayIndex * 6) - 3), 1, 1)
                aTable.SetText(3 + ((angularPointArrayIndex * 6) - 3), 2, Format(aStartFullCurveEasting, "### ### ##0.00")) 'StartFullCurveEasting
                aTable.MergeCells(3 + ((angularPointArrayIndex * 6) - 3), 4 + ((angularPointArrayIndex * 6) - 3), 2, 2)
                aTable.SetText(3 + ((angularPointArrayIndex * 6) - 3), 3, Format(aStartFullCurveNorthing, "### ### ##0.00")) 'StartFullCurveNorthing
                aTable.MergeCells(3 + ((angularPointArrayIndex * 6) - 3), 4 + ((angularPointArrayIndex * 6) - 3), 3, 3)
                aTable.SetText(4 + ((angularPointArrayIndex * 6) - 3), 4, Format(aSpiralInTangent, "### ### ##0.00")) 'LengthFromStartFullCurveToAngularPoint
                aTable.MergeCells(4 + ((angularPointArrayIndex * 6) - 3), 5 + ((angularPointArrayIndex * 6) - 3), 4, 4)
 
                For jCol As Long = 5 To 11
                    aTable.MergeCells(3 + ((angularPointArrayIndex * 6) - 3), 4 + ((angularPointArrayIndex * 6) - 3), jCol, jCol)
                Next jCol
 
                aTable.SetText(3 + ((angularPointArrayIndex * 6) - 3), 10, StationToStationFormat(aStartFullCurveStation, False)) 'StartFullCurveStation
                aTable.MergeCells(3 + ((angularPointArrayIndex * 6) - 3), 4 + ((angularPointArrayIndex * 6) - 3), 10, 10)
                aTable.MergeCells(3 + ((angularPointArrayIndex * 6) - 3), 4 + ((angularPointArrayIndex * 6) - 3), 11, 11)
                If aAngularPointIsArc = False Then
                    aTable.SetText(4 + ((angularPointArrayIndex * 6) - 3), 12, Format(aSpiralInTangent, "### ### ##0.00")) 'LengthFromStartFullCurveToAngularPoint
                End If
                aTable.MergeCells(4 + ((angularPointArrayIndex * 6) - 3), 5 + ((angularPointArrayIndex * 6) - 3), 12, 12)
 
                aTable.SetText(5 + ((angularPointArrayIndex * 6) - 3), 1, ResourceManagerMainShadow.GetString("PI", curUICulture) & " " & angularPointArrayIndex)
                aTable.MergeCells(5 + ((angularPointArrayIndex * 6) - 3), 6 + ((angularPointArrayIndex * 6) - 3), 1, 1)
                aTable.SetText(5 + ((angularPointArrayIndex * 6) - 3), 2, Format(aAngularPointEasting, "### ### ##0.00")) 'AngularPointEasting
                aTable.MergeCells(5 + ((angularPointArrayIndex * 6) - 3), 6 + ((angularPointArrayIndex * 6) - 3), 2, 2)
                aTable.SetText(5 + ((angularPointArrayIndex * 6) - 3), 3, Format(aAngularPointNorthing, "### ### ##0.00")) 'AngularPointNorthing
                aTable.MergeCells(5 + ((angularPointArrayIndex * 6) - 3), 6 + ((angularPointArrayIndex * 6) - 3), 3, 3)
                aTable.SetText(6 + ((angularPointArrayIndex * 6) - 3), 4, Format(aSpiralOutTangent, "### ### ##0.00")) 'LengthFromAngularPointToEndFullCurve
                aTable.MergeCells(6 + ((angularPointArrayIndex * 6) - 3), 7 + ((angularPointArrayIndex * 6) - 3), 4, 4)
                aTable.SetText(5 + ((angularPointArrayIndex * 6) - 3), 5, AngleInRadiansToDegreesAndMinutesAndSecundes(aFullCurveRotationAngle)) 'FullCurveRotationAngle
                aTable.MergeCells(5 + ((angularPointArrayIndex * 6) - 3), 6 + ((angularPointArrayIndex * 6) - 3), 5, 5)
                aTable.SetText(5 + ((angularPointArrayIndex * 6) - 3), 6, Format(aArcRadius, "### ### ##0.00")) 'Arc.radius
                aTable.MergeCells(5 + ((angularPointArrayIndex * 6) - 3), 6 + ((angularPointArrayIndex * 6) - 3), 6, 6)
 
                If Abs(aSpiralInTangent - aSpiralOutTangent) < 0.01 Then
                    aTable.SetText(5 + ((angularPointArrayIndex * 6) - 3), 7, Format(aSpiralInTangent, "### ### ##0.00"))
                    aTable.MergeCells(5 + ((angularPointArrayIndex * 6) - 3), 6 + ((angularPointArrayIndex * 6) - 3), 7, 7)
                    aTable.SetText(5 + ((angularPointArrayIndex * 6) - 3), 9, Format(aSpiralInLength, "### ### ##0.00"))
                    aTable.MergeCells(5 + ((angularPointArrayIndex * 6) - 3), 6 + ((angularPointArrayIndex * 6) - 3), 9, 9)
                Else
                    aTable.SetText(3 + ((angularPointArrayIndex * 6) - 3), 7, Format(aSpiralInTangent, "### ### ##0.00"))
                    aTable.MergeCells(3 + ((angularPointArrayIndex * 6) - 3), 4 + ((angularPointArrayIndex * 6) - 3), 7, 7)
                    aTable.SetText(7 + ((angularPointArrayIndex * 6) - 3), 7, Format(aSpiralOutTangent, "### ### ##0.00"))
                    aTable.MergeCells(7 + ((angularPointArrayIndex * 6) - 3), 8 + ((angularPointArrayIndex * 6) - 3), 7, 7)
                    aTable.SetText(3 + ((angularPointArrayIndex * 6) - 3), 9, Format(aSpiralInLength, "### ### ##0.00"))
                    aTable.MergeCells(3 + ((angularPointArrayIndex * 6) - 3), 4 + ((angularPointArrayIndex * 6) - 3), 9, 9)
                    aTable.SetText(7 + ((angularPointArrayIndex * 6) - 3), 9, Format(aSpiralOutLength, "### ### ##0.00"))
                    aTable.MergeCells(7 + ((angularPointArrayIndex * 6) - 3), 8 + ((angularPointArrayIndex * 6) - 3), 9, 9)
                    aTable.MergeCells(5 + ((angularPointArrayIndex * 6) - 3), 6 + ((angularPointArrayIndex * 6) - 3), 7, 7)
                    aTable.MergeCells(5 + ((angularPointArrayIndex * 6) - 3), 6 + ((angularPointArrayIndex * 6) - 3), 9, 9)
                End If
                aTable.SetText(5 + ((angularPointArrayIndex * 6) - 3), 8, Format(aSpiralInLength + aSpiralOutLength + aArcLength, "### ### ##0.00")) 'FullCurveLength ?
                aTable.MergeCells(5 + ((angularPointArrayIndex * 6) - 3), 6 + ((angularPointArrayIndex * 6) - 3), 8, 8)
                aTable.MergeCells(5 + ((angularPointArrayIndex * 6) - 3), 6 + ((angularPointArrayIndex * 6) - 3), 10, 10)
                aTable.MergeCells(5 + ((angularPointArrayIndex * 6) - 3), 6 + ((angularPointArrayIndex * 6) - 3), 11, 11)
                If aAngularPointIsArc = False Then
                    aTable.SetText(6 + ((angularPointArrayIndex * 6) - 3), 12, Format(aSpiralOutTangent, "### ### ##0.00")) 'LengthFromAngularPointToEndFullCurve
                End If
                aTable.MergeCells(6 + ((angularPointArrayIndex * 6) - 3), 7 + ((angularPointArrayIndex * 6) - 3), 12, 12)
 
                aTable.SetText(7 + ((angularPointArrayIndex * 6) - 3), 1, ResourceManagerMainShadow.GetString("Curvature End", curUICulture) & " " & angularPointArrayIndex)
                aTable.MergeCells(7 + ((angularPointArrayIndex * 6) - 3), 8 + ((angularPointArrayIndex * 6) - 3), 1, 1)
                aTable.SetText(7 + ((angularPointArrayIndex * 6) - 3), 2, Format(aEndFullCurveEasting, "### ### ##0.00")) 'EndFullCurveEasting
                aTable.MergeCells(7 + ((angularPointArrayIndex * 6) - 3), 8 + ((angularPointArrayIndex * 6) - 3), 2, 2)
                aTable.SetText(7 + ((angularPointArrayIndex * 6) - 3), 3, Format(aEndFullCurveNorthing, "### ### ##0.00")) 'EndFullCurveNorthing
                aTable.MergeCells(7 + ((angularPointArrayIndex * 6) - 3), 8 + ((angularPointArrayIndex * 6) - 3), 3, 3)
                aTable.MergeCells(8 + ((angularPointArrayIndex * 6) - 3), 9 + ((angularPointArrayIndex * 6) - 3), 4, 4)
 
                For jCol As Long = 5 To 11
                    aTable.MergeCells(7 + ((angularPointArrayIndex * 6) - 3), 8 + ((angularPointArrayIndex * 6) - 3), jCol, jCol)
                Next jCol
 
                aTable.SetText(7 + ((angularPointArrayIndex * 6) - 3), 11, StationToStationFormat(aEndFullCurveStation, False)) 'EndFullCurveStation
                aTable.MergeCells(7 + ((angularPointArrayIndex * 6) - 3), 8 + ((angularPointArrayIndex * 6) - 3), 11, 11)
                aTable.MergeCells(8 + ((angularPointArrayIndex * 6) - 3), 9 + ((angularPointArrayIndex * 6) - 3), 12, 12)
 
                aTable.SetRowHeight(3 + ((angularPointArrayIndex * 6) - 3), textHeightWorkingValue * 1.6)
                aTable.SetRowHeight(4 + ((angularPointArrayIndex * 6) - 3), textHeightWorkingValue * 1.6)
                aTable.SetRowHeight(5 + ((angularPointArrayIndex * 6) - 3), textHeightWorkingValue * 1.6)
                aTable.SetRowHeight(6 + ((angularPointArrayIndex * 6) - 3), textHeightWorkingValue * 1.6)
                aTable.SetRowHeight(7 + ((angularPointArrayIndex * 6) - 3), textHeightWorkingValue * 1.6)
                aTable.SetRowHeight(8 + ((angularPointArrayIndex * 6) - 3), textHeightWorkingValue * 1.6)
            Catch ex As System.Exception
                aErrStr += ex.Message & vbCrLf
            End Try
        End Sub

soloviewserg · « **Ответ #3 :** 11-01-2019, 19:44:38 »

Остатки кода на заданную тему.

Код - vb.net [Выбрать]

Friend Class ssAlignmentAngularPoint
        Implements IDisposable
 
        Private _license As SSLicense
        Private _disposed As Boolean
 
        Protected Sub New()
            MyBase.New()
        End Sub
 
        Friend Sub New(ByVal aArc As AeccAlignmentArc, ByVal aBeforeEntity As AeccAlignmentEntity, ByVal aAfterEntity As AeccAlignmentEntity, ByVal aAlignmentAngularPointType As AeccAlignmentEntityType, _
                   ByVal aStartingStation As Double, ByVal aId As Long)
            Me.New()
 
            pArc = aArc
            pBeforeEntity = aBeforeEntity
            pAfterEntity = aAfterEntity
            pAlignmentAngularPointType = aAlignmentAngularPointType
            pStartingStation = aStartingStation
            pId = aId
 
            pSortedByStation = False
 
        End Sub
 
        Friend Overloads Sub Dispose() Implements IDisposable.Dispose
            Dispose(True)
            GC.SuppressFinalize(Me)
        End Sub
 
        Private Overloads Sub Dispose(ByVal disposing As Boolean)
            SyncLock Me
                If Me._disposed = False Then
                    Try
                        'release Managed resources
                        If disposing Then
 
                        End If
                        'release Unmanaged resources
 
                        Me._disposed = True
                    Finally
                        'Dispose(disposing)
                    End Try
                End If
            End SyncLock
        End Sub
 
        Private pArc As IAeccAlignmentArc
        Private pBeforeEntity As IAeccAlignmentEntity
        Private pAfterEntity As IAeccAlignmentEntity
        Private pIsSCS As Boolean
        Private pAlignmentAngularPointType As AeccAlignmentEntityType
        Private pStartingStation As Double
        Private pId As Long
        Private pSortedByStation As Boolean
 
        Friend Property Arc() As IAeccAlignmentArc
            Get
                Return pArc
            End Get
            Set(ByVal value As IAeccAlignmentArc)
                pArc = value
            End Set
        End Property
 
        Friend Property BeforeEntity() As IAeccAlignmentEntity
            Get
                Return pBeforeEntity
            End Get
            Set(ByVal value As IAeccAlignmentEntity)
                pBeforeEntity = value
            End Set
        End Property
 
        Friend Property AfterEntity() As IAeccAlignmentEntity
            Get
                Return pAfterEntity
            End Get
            Set(ByVal value As IAeccAlignmentEntity)
                pAfterEntity = value
            End Set
        End Property
 
        Friend ReadOnly Property IsSCS() As Boolean
            Get
                If pBeforeEntity IsNot Nothing And pAfterEntity IsNot Nothing Then
                    If pBeforeEntity.Type = AeccAlignmentEntityType.aeccSpiral And pAfterEntity.Type = AeccAlignmentEntityType.aeccSpiral Then
                        pIsSCS = True
                        Return pIsSCS
                    Else
                        pIsSCS = False
                        Return pIsSCS
                    End If
                Else
                    pIsSCS = False
                    Return pIsSCS
                End If
            End Get
        End Property
 
        Friend ReadOnly Property AlignmentAngularPointType() As AeccAlignmentEntityType
            Get
                AlignmentAngularPointType = pAlignmentAngularPointType
            End Get
        End Property
 
        Friend ReadOnly Property StartingStation() As Double
            Get
                StartingStation = pStartingStation
            End Get
        End Property
 
        Friend ReadOnly Property Id() As Long
            Get
                Id = pId
            End Get
        End Property
 
        Friend Property SortedByStation() As Boolean
            Get
                SortedByStation = pSortedByStation
            End Get
            Set(ByVal value As Boolean)
                pSortedByStation = value
            End Set
        End Property
 
    End Class

Сообщество программистов Autodesk в СНГ

Новости:

Автор Тема: Получить ведомость элементов плана ж/д линии (Форма 2 ГОСТ Р 21.1702-96) (Прочитано 4161 раз)

soloviewserg

Получить ведомость элементов плана ж/д линии (Форма 2 ГОСТ Р 21.1702-96)

Александр Ривилис

Re: Получить ведомость элементов плана ж/д линии (Форма 2 ГОСТ Р 21.1702-96)

soloviewserg

Re: Получить ведомость элементов плана ж/д линии (Форма 2 ГОСТ Р 21.1702-96)

soloviewserg

Re: Получить ведомость элементов плана ж/д линии (Форма 2 ГОСТ Р 21.1702-96)