Is there a way to extend a line to intersect with another? As you can see in this picture, the red lines ends before it intersects (connects) to the black line.
I'm looking for something, which "searches" in a specific distance, f.e. 1 mm, for other lines. A work-around would be to extrapolate the line for the distance and cut the part, which is beyond an intersected line...
What do you think?
Edit: These are imported lines. I'm looking for a scripted solution (VBA).
Yes, turn on snapping.............
Click View Snap to Snap to objects
Hello Tobias; You can move the node of the red line to the center of the black line but you can't join them. You could draw a rectangle and place it over or under the black line.
Mike in Canada said:Yes, turn on snapping.............
Sorry, I didn't give enough details: those are imported lines. I'm looking for a scripted (VBA) solution.
TheSign Guy said:You can move the node of the red line to the center of the black line but you can't join them. You could draw a rectangle and place it over or under the black line.
I need the red line to end directly on the black line. Then I can run a VBA script on it to insert a node at intersection.
Here is a VBA Solution. :-)
Dim x As Double, y As Double
Dim dx As Double, dy As Double
Dim a As Double
Dim sr As ShapeRange
Dim s As Shape
Dim cps As CrossPoints, cp As CrossPoint
ActiveDocument.Unit = cdrInch
Set sr = ActiveSelectionRange
If sr.Count <> 2 Then
MsgBox "Please select two curves", vbCritical
If sr(1).Type <> cdrCurveShape Or sr(2).Type <> cdrCurveShape Then
MsgBox "One of the selected shapes is not a curve", vbCritical
ActiveDocument.BeginCommandGroup "Extend Curve"
On Error GoTo ErrHandler
Optimization = True
Set seg = sr(2).Curve.Segments.Last
seg.GetPointPositionAt x, y, 1, cdrRelativeSegmentOffset
a = seg.GetTangentAt(t, cdrRelativeSegmentOffset) * 3.1415926 / 180
dx = (5 * Cos(a)) * -1
dy = (5 * Sin(a)) * -1
Set s = ActiveLayer.CreateLineSegment(x, y, x + -dx, y + -dy)
If s.Curve.IntersectsWith(sr(1).Curve) Then
Set cps = s.Curve.SubPaths(1).GetIntersections(sr(1).Curve.SubPaths(1))
sr(2).Curve.Nodes.Last.SetPosition cps(1).PositionX, cps(1).PositionY
'Comment out or delete the line above and uncomment these two lines to append a line segment and then delete the node
'If you wish to keep the node delete the second line
'sr(2).Curve.SubPaths.Last.AppendLineSegment cps(1).PositionX, cps(1).PositionY
'sr(2).Curve.Nodes(sr(2).Curve.Nodes.Count - 1).Delete
Optimization = False
MsgBox "Unexpected error occured: " & Err.Description & " [" & Err.Number & "]", vbCritical, "Error"
Hope that helps,