Article	41024027
Type	HowTo
Product	Engine
Version	5.1.1.1037
Date Added	6/24/2005
Submitted by	Gerald Myroup
Keywords

Subject

How to extend a line to another line even if they do not intersect until they extend both

Summary

How to extend a line to another line even if they do not intersect until they extend both

Solution

Dim pt1 As Variant
Dim pt2 As Variant
Dim ent1 As vdFigure
Dim ent2 As vdFigure
Dim line As vdLine
Dim IntersectionPoint As Variant

    vdraw.Prompt "Select Entity to Extend"
    pt1 = vdraw.Utility.GetPoint
    Set ent1 = vdraw.ActiveDocument.GetEntityFromPOINT(pt1)
    If ent1 Is Nothing Then Exit Sub
    vdraw.Prompt "Select Entity to Extend to"
    pt2 = vdraw.Utility.GetPoint
    Set ent2 = vdraw.ActiveDocument.GetEntityFromPOINT(pt2)
    If ent2 Is Nothing Then Exit Sub
   
    IntersectionPoint = ent1.IntersectWith(ent2, VdIntExtendBoth)
    If Not IsEmpty(IntersectionPoint) Then
        If ent1.Type = "VDLINE" Then
            Set line = ent1
            'Check if the line startpoint is closer to intersection point than endpoint or not
            If vdraw.Utility.geomDistance(line.StartPoint, IntersectionPoint) < vdraw.Utility.geomDistance(line.EndPoint, IntersectionPoint) Then
                line.StartPoint = IntersectionPoint
            Else
                line.EndPoint = IntersectionPoint
            End If
        End If
    End If
    vdraw.Redraw