2018年12月02日

How to offset a drawing curve

Offset a drawing curve is different with copy/move a drawing curve. To copy /move a curve, all vertex points are displace same distance, while offset a drawing curve, the vertex points may displace different distance. The figure shown below is a drawing copy, every point on the curve translates same displacement, ie. point(x,y) after copy operation translate to point(x+dx,y+dy),where dx, dy are translate along x,y direction,respectively.

While a curve offset some distance, it is like the following figure shown. A polyline

ABCD(blue) offset some distance(AA’),the curve will offset to the new positions as A’B’CD’,line AB moves to A’P’, and line BC moves to O’S’ ,so line A’P’ and line O’S’ will intersect at point B’. Follow same procedure we can get the new offset positions of line BC and line CD as O’C and T’D’. Please note here, the offset points A’B’C’D shoud all locate on the same side of polyline ABCD.

Type CadPoint

         X As Single

         Y As Single  

 End Type 

 Type cadLine

         pts(0 To 1)  As CadPoint

  End Type

Type CadPolyLine

        pts()  As CadPoint     

 End Type

Type CadArc

         pts(0)  As CadPoint

         radius As Single

         angle1 As Single

         angle2 As Single

 End Type

 Type CadEllipse

         pts(0 To 2)  As CadPoint

         angle1 As Single

         angle2 As Single

         Numpts As Integer       

    End Type

Private Function OffsetLine(myLine As cadLine, myptRefer As CadPoint, myOffset As Single) As cadLine

OffsetLine = myLine

Dim X1 As Single, Y1 As Single, X2 As Single, Y2 As Single, ptVertical As CadPoint

Dim uVector As cadLine, LT As Single

X1 = myLine.Vertex(0).X

Y1 = myLine.Vertex(0).Y

X2 = myLine.Vertex(1).X

Y2 = myLine.Vertex(1).Y

'Find the vertical lineperpendical to a given line

ptVertical = ClosestPtOnLineToReferPt(myptRefer, myLine, True)

LT = Sqr((myptRefer.X - ptVertical.X) ^ 2 + (myptRefer.Y - ptVertical.Y) ^ 2) 'distance between ptRefer and ptVertical

uVector.Vertex(0).X = ptVertical.X

uVector.Vertex(0).Y = ptVertical.Y

uVector.Vertex(1).X = ptVertical.X + (myptRefer.X - ptVertical.X) / LT  uVector.Vertex(1).Y = ptVertical.Y + (myptRefer.Y - ptVertical.Y) / LT

OffsetLine.Vertex(0).X = myLine.Vertex(0).X + myOffset * (uVector.Vertex(1).X -  uVector.Vertex(0).X) '(uVector.vertex(1).x –

uVector.vertex(0).x)offset

OffsetLine.Vertex(0).Y = myLine.Vertex(0).Y + myOffset * (uVector.Vertex(1).Y -           uVector.Vertex(0).Y)

OffsetLine.Vertex(1).X = myLine.Vertex(1).X + myOffset * (uVector.Vertex(1).X - uVector.Vertex(0).X)

OffsetLine.Vertex(1).Y = myLine.Vertex(1).Y + myOffset * (uVector.Vertex(1).Y - uVector.Vertex(0).Y)

End Function

Function offsetPolyline(ByRef myPolyLine As CadPolyLine, ByRef ptRefer As CadPoint, ByVal offset As Single) As CadPolyLine

        Dim i As Integer, j As Integer

        Dim Nint As Integer, nPt As Integer

         nPt = UBound(myPolyLine.pts)

         ReDim Preserve myPolyLine.pts(nPt)

         Dim isClosed As Boolean

        isClosed = False

        If ptptLen(myPolyLine.pts(0), myPolyLine.pts(UBound(myPolyLine.pts))) < 0.1 Then isClosed = True

        offsetPolyline = myPolyLine

        ReDim Preserve offsetPolyline.pts(UBound(myPolyLine.pts))

        Dim ptMid As CadPoint, ptRefers() As CadPoint

        Dim indKey As Integer

        Dim baseSignArea As Single, areaTest As Single

        Dim tLine  As cadLine, sLine As cadLine, mLine As cadLine

        Dim ptvert As CadPoint

        ptvert = ClosestPtOnPLine(ptRefer, myPolyLine, indKey, True)

        Dim pts(2) As CadPoint

        pts(0) = myPolyLine.pts(indKey)

        pts(1) = myPolyLine.pts(indKey + 1)

        pts(2) = ptRefer  

        baseSignArea = SignedPolygonArea(pts)

       ''frmmain.pictest.Print "Basearea= "; baseSignArea

        Dim count As Integer

        count = 0

        For i = 0 To UBound(myPolyLine.pts) - 1

            ptMid.X = (myPolyLine.pts(i).X + myPolyLine.pts(i + 1).X) / 2

            ptMid.Y = (myPolyLine.pts(i).Y + myPolyLine.pts(i + 1).Y) / 2

            tLine.pts(0) = myPolyLine.pts(i)

            tLine.pts(1) = myPolyLine.pts(i + 1)

            Dim ptsMidRefer(1) As CadPoint

            Call PtVLineWithGivenDist_GivenDim(tLine, ptMid, offset, ptsMidRefer)

            pts(0) = tLine.pts(0)

            pts(1) = tLine.pts(1)

            For j = 0 To 1

                pts(2) = ptsMidRefer(j)

                areaTest = SignedPolygonArea(pts)

                If areaTest * baseSignArea > 0.05 Then

                    ReDim Preserve ptRefers(count)

                    ptRefers(count) = pts(2)

                    count = count + 1

                    Exit For

                End If

            Next j

       Next i

        'MsgBox ("UBOUND(PTREFERS)= " & UBound(ptRefers))

        Dim LineOff() As cadLine

        Dim NLine As Integer

        NLine = 0

        'MsgBox ("npt pl= " & UBound(myPolyline.pts))

        For i = 0 To UBound(myPolyLine.pts) - 1

            tLine.pts(0) = myPolyLine.pts(i)

            tLine.pts(1) = myPolyLine.pts(i + 1)

            ReDim Preserve LineOff(NLine)

            LineOff(NLine) = OffsetLine(tLine, ptRefers(i), offset)

            'call DrawCadLine(frmMain.PicDraw, LineOff(NLine))

            NLine = NLine + 1

        Next i

        'acll

        '-------------------------------------------------

        Dim ptInt() As CadPoint

        Dim NoInt As Integer

        NoInt = 0

        For i = 0 To UBound(LineOff) - 1

            Dim lineOffA As cadLine, lineOffB As cadLine

            lineOffA = LineOff(i)

            lineOffB = LineOff(i + 1)

            lineOffA = lineEndExtendBothEnd(lineOffA, 1000)

            lineOffB = lineEndExtendBothEnd(lineOffB, 1000)

            Dim iPoints() As CadPoint

            Nint = LineLineIntReal(lineOffA, lineOffB, iPoints)

            'MsgBox("NINT= " & nint)

            If Nint <> -1 Then

                ReDim Preserve iPoints(0)

                ReDim Preserve ptInt(NoInt)

                ptInt(NoInt) = iPoints(0)

                'DrawCadPoint(bmpf, canvas, PtInt(NoInt), "Cyan", , , 6)

                NoInt = NoInt + 1

            End If

        Next

        'MsgBox("noint= " & UBound(PtInt))

        'offset beg point

        Dim ptBegOff As CadPoint

        tLine.pts(0) = myPolyLine.pts(0)

        tLine.pts(1) = myPolyLine.pts(1)

        ptBegOff = offsetEndPoint(myPolyLine.pts(0), tLine, ptRefers(0), offset)

        'DrawCadPoint(bmpf, canvas, ptBegOff, "Cyan", , , 5)

        'offset end point

        tLine.pts(0) = myPolyLine.pts(UBound(myPolyLine.pts) - 1)

        tLine.pts(1) = myPolyLine.pts(UBound(myPolyLine.pts))

        Dim ptEndOff As CadPoint

        ptEndOff = offsetEndPoint(myPolyLine.pts(UBound(myPolyLine.pts)), tLine, ptRefers(UBound(ptRefers)), offset)

        'DrawCadPoint(bmpf, canvas, ptEndOff, "Cyan", , , 5)

        count = 0

        Dim ptsoff() As CadPoint

        ReDim Preserve ptsoff(count)

        ptsoff(count) = ptBegOff

        count = count + 1

        For i = 0 To UBound(ptInt)

            ReDim Preserve ptsoff(count)

            ptsoff(count) = ptInt(i)

            count = count + 1

        Next

        ReDim Preserve ptsoff(count)

        ptsoff(count) = ptEndOff

        For i = 0 To UBound(ptsoff)

            ReDim Preserve offsetPolyline.pts(i)

            offsetPolyline.pts(i) = ptsoff(i)

        Next

        'If polyline is closed then find the 1st and lase segment intersected

        'MsgBox ("ISCLOSED= " & isClosed)

        If isClosed = True Then

            Dim Line1 As cadLine, Line2 As cadLine, ptBeg_end As CadPoint

            Line1.pts(0) = offsetPolyline.pts(1)

            Line1.pts(1) = offsetPolyline.pts(0)

            Line2.pts(0) = offsetPolyline.pts(UBound(offsetPolyline.pts) - 1)

            Line2.pts(1) = offsetPolyline.pts(UBound(offsetPolyline.pts))

            Line1 = lineEndExtendBothEnd(Line1, 1000)

            Line2 = lineEndExtendBothEnd(Line2, 1000)

            Nint = LineLineIntReal(Line1, Line2, iPoints)

            If Nint <> -1 Then

                ReDim Preserve iPoints(0)

                ptBeg_end = iPoints(0)

            End If

            offsetPolyline.pts(0) = ptBeg_end

            offsetPolyline.pts(UBound(offsetPolyline.pts)) = ptBeg_end

        End If

        'DrawCadPolyline(bmpf, canvas, offsetPolyline, "red")

        'canvas.Image = bmpf

    End Function

Ellipse arc ,arc ,spline and polygon are all composed of line segments in graphic drawing, so the offset of these curves may draw like polyline does. Because circle and ellipse equation can be solved by three points which passing through the curve, we can offset these three key points by linking their center and three key points, and offset inward or outward along these linking lines.

Function OffsetEllipse(ByRef myEllipse As CadEllipse, ByRef myptRefer As CadPoint, ByVal myOffset As Single) As CadEllipse

        On Error Resume Next

        Dim AA As Single, Bb As Single, Angslop As Single, ptCen As CadPoint, Cc As Single

        Dim tptEllipse As CadEllipse

        tptEllipse = myEllipse

        tptEllipse.angle1 = 0

        tptEllipse.angle2 = 359.95

        Call EllipseProp(tptEllipse, ptCen, AA, Bb, Angslop)

        Dim L1, L2 As Single

        L1 = ptptLen(ptCen, myptRefer)

        Dim tLine As cadLine

        tLine.pts(0) = ptCen

        tLine.pts(1) = ptOnLine_GivenDist(ptCen, myptRefer, 1000)

        Dim ptsInt() As CadPoint

        Dim Nint As Integer

        Nint = LineEllipseIntReal(tLine, tptEllipse, ptsInt)

        If Nint = -1 Then

            MsgBox ("err in ptInt calculate")

            Exit Function

        End If

        If Nint <> -1 Then

            ReDim Preserve ptsInt(UBound(ptsInt))

            L2 = ptptLen(ptCen, ptsInt(0))

            'gp.DrawEllipse(Pens.Cyan, ptsInt(0).X - 5, ptsInt(0).Y - 5, 10, 10)

        End If

        Dim fct As Single

        fct = 1#

        Dim IsptInEllipse As Boolean

        IsptInEllipse = False

        If L1 < L2 Then IsptInEllipse = True

        If IsptInEllipse Then

            'MsgBox(" ptin ellipse")

            fct = -1#

        End If

        Cc = Sqr(Abs(AA ^ 2 - Bb ^ 2))

        tLine.pts(0) = tptEllipse.pts(0)

        tLine.pts(1) = tptEllipse.pts(1)

        Dim ptVOnEllipse(1) As CadPoint '

        Call PtVLineWithGivenDist_GivenDim(tLine, ptCen, Bb, ptVOnEllipse)

        Dim pt0focus As CadPoint, pt1focus As CadPoint, pt0Pfucus As CadPoint, pt1Pfocus As CadPoint

        pt0focus = ptOnLine_GivenDist(ptCen, tptEllipse.pts(0), Cc)

        pt1focus = ptOnLine_GivenDist(ptCen, tptEllipse.pts(1), Cc)

         Dim offsetpt0Focus As CadPoint

        offsetpt0Focus = ptOnLine_GivenDist(ptCen, pt0focus, Cc + fct * myOffset)

        Dim offsetpt1Focus As CadPoint

        offsetpt1Focus = ptOnLine_GivenDist(ptCen, pt1focus, Cc + fct * myOffset)

        Dim offsetptV As CadPoint

        offsetptV = ptOnLine_GivenDist(ptCen, ptVOnEllipse(0), Bb + fct * myOffset)

        Dim AaP As Single, BbP As Single, CcP As Single

        BbP = ptptLen(ptCen, offsetptV)

        CcP = ptptLen(ptCen, offsetpt0Focus)

        AaP = Sqr(BbP ^ 2 + CcP ^ 2)

        Dim pt0P As CadPoint, pt1P As CadPoint, Pt2p As CadPoint

        OffsetEllipse = myEllipse

        OffsetEllipse.pts(0) = ptOnLine_GivenDist(ptCen, tptEllipse.pts(0), AaP + fct * myOffset)

        OffsetEllipse.pts(1) = ptOnLine_GivenDist(ptCen, tptEllipse.pts(1), AaP + fct * myOffset)

        OffsetEllipse.pts(2) = ptOnLine_GivenDist(ptCen, ptVOnEllipse(0), BbP + fct * myOffset)

    End Function

VB_VB NET: chday169

Name(您的大名)
E_MAIL(您的電子信箱)
Comment or Suggestion(您想反應的狀況，建議，或諮詢事項)