|
|
|
|
2018年12月02日 |
上次修改此網站的日期： 2018年12月02日
Joint line segments to a polyline (polylines)
In computer graphic, especially in contour line plotting, we may need to connect some line segments to a polyline or polylines. In this article we will discuss how to connect line segments to a polyline or polylines. For exmaple, we have a set of line segments :
[(50, 10, 0), (40, 15, 0)] , [(40, 15, 0),(30, 18, 0)] , [(30, 18, 0),(20, 20, 0)] , [(20, 20, 0),(25, 25, 0)] ,[(25, 25, 0),18, 30, 0)] , [(60, 40, 0),(50, 48, 0)] , [(50, 48, 0),(65, 65, 0)],[(4, 5, 0),(0, 8, 0)] , [(0, 8, 0),(5, 12, 0)] , [(5, 12, 0),(50, 10, 0)] , [(90, 90, 0),(80, 80, 0)],[(70, 85, 0),(93, 93, 0)]
In Figure 1, the drawings with black color are line segment of original data, the
red one are polylines after classification. The simple way to classify the line segments is quite simple and easy. In general, two line segments can be jointed together, their x ,y coordinates should be ether one of four types(Figure 2).
(1) Head of first and head of second are same:
Reverse the coordinate of second line segment and then joint the second line segment before the first one.
(2) Head of first and tail of second are same:
joint the second line segment before the first one directly.
(3) Tail of First and tail of second are same:
Reverse the coordinate of second line segment and then joint the second line segment after the first one.
(4) Tail of First and head of second are same:
joint the second line segment after the first one directly.
Figure 1
The following snippet codes are the key program of joint line segments to a polyline
or polylines.
Public Sub PolylinesFromLineSegments(LineSegments_0() As LineXyz, ansPLines_0() As PLineXyz)
Dim stBase As String, stTest(0 To 1) As String
Dim i As Integer
Dim collLines As New Collection, count As Integer, j As Integer
Set collLines = Nothing
For i = 0 To UBound(LineSegments_0)
collLines.Add Trim(Round(LineSegments_0(i).pts(0).X, 2) & "," & Round(LineSegments_0(i).pts(0).Y, 2) & "," & Round(LineSegments_0(i).pts(1).X, 2) & "," & Round(LineSegments_0(i).pts(1).Y, 2))
'List1.AddItem collLines.ITEM(i + 1)
Next i
'MsgBox ("colllines.count=" & collLines.count)
'start from linesgements(0)
Dim collPlines() As New Collection, stBeg As String, stEnd As String, stTestBeg As String, stTestEnd As String
Dim stArrayA() As String, stArrayB() As String, stAddBeg As String, stAddend As String
Dim nPline As Integer
nPline = 0
ReDim Preserve collPlines(0 To nPline)
Set collPlines(nPline) = Nothing
50:
Do While collLines.count >= 1
collPlines(nPline).Add collLines.ITEM(1)
collLines.Remove (1)
'------------------------------
stArrayA = Split(collPlines(nPline).ITEM(1), ",", -1)
stBeg = Trim(stArrayA(0) & "," & stArrayA(1))
stEnd = Trim(stArrayA(2) & "," & stArrayA(3))
'If collLines.count >= 1 Then
60: For i = 1 To collLines.count
' MsgBox (" collLines.ITEM(i)= " & collLines.ITEM(i))
stArrayB = Split(collLines.ITEM(i), ",", -1)
stTestBeg = Trim(stArrayB(0) & "," & stArrayB(1))
stTestEnd = Trim(stArrayB(2) & "," & stArrayB(3))
'case 0
‘head of LinesegmentA same as head of LinesegmentB
If stBeg = stTestBeg Then
stAddBeg = Trim(stTestEnd & "," & stTestBeg) ' reverse beg & end then add at first
collPlines(nPline).Add stAddBeg, , 1
collLines.Remove (i)
stBeg = stTestEnd
'stend=stend
GoTo 60
End If
‘case 1
‘head of LinesegmentA same as tail of LinesegmentB
If stBeg = stTestEnd Then
stAddBeg = Trim(stTestBeg & "," & stTestEnd)
collPlines(nPline).Add stAddBeg, , 1
collLines.Remove (i)
stBeg = stTestBeg
'stend=stend
GoTo 60
End If
'case 2
‘Tail of LinesegmentA same as tail of LinesegmentB
If stEnd = stTestEnd Then
stAddend = Trim(stTestEnd & "," & stTestBeg) ' ‘reverse beg & end then add at last
collPlines(nPline).Add stAddend, , , collPlines(nPline).count
collLines.Remove (i)
'stbeg=stbeg
stEnd = stTestBeg
GoTo 60
End If
'case 3
‘Tail of LinesegmentA same as head of LinesegmentB
If stEnd = stTestBeg Then
stAddend = Trim(stTestBeg & "," & stTestEnd) ' add at last
collPlines(nPline).Add stAddend, , , collPlines(nPline).count
collLines.Remove (i)
'stbeg=stbeg
stEnd = stTestEnd
GoTo 60
End If
Next i
'End If
'-----------------------------------
Dim npt As Integer
npt = 0
For j = 1 To collPlines(nPline).count
'List1.AddItem "npline= " & nPline & " ;j=" & j & " ; " & collPlines(nPline).ITEM(j)
stArrayA = Split(collPlines(nPline).ITEM(j), ",", -1, vbTextCompare)
ReDim Preserve ansPLines_0(nPline)
ReDim Preserve ansPLines_0(nPline).pts(0 To npt)
ansPLines_0(nPline).pts(npt).X = Val(stArrayA(0))
ansPLines_0(nPline).pts(npt).Y = Val(stArrayA(1))
npt = npt + 1
Next j
ReDim Preserve ansPLines_0(nPline).pts(0 To npt)
ansPLines_0(nPline).pts(npt).X = Val(stArrayA(2))
ansPLines_0(nPline).pts(npt).Y = Val(stArrayA(3))
'For j = 0 To UBound(ansPLines_0(nPline).pts)
'If j = 0 Then
'PicContour.PSet (ansPLines_0(nPline).pts(j).X, ansPLines_0(nPline).pts(j).Y)
'Else
'PicContour.DrawWidth = 3
'PicContour.Line -(ansPLines_0(nPline).pts(j).X, ansPLines_0(nPline).pts(j).Y), vbRed
'End If
'Next j
nPline = nPline + 1
ReDim Preserve collPlines(0 To nPline)
Set collPlines(nPline) = Nothing
GoTo 50
Loop
End Sub
