Hi there.
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?
Best,Tobias
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.
George
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. :-)
Sub ExtendCurve() 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 Exit Sub End If If sr(1).Type <> cdrCurveShape Or sr(2).Type <> cdrCurveShape Then MsgBox "One of the selected shapes is not a curve", vbCritical Exit Sub End If 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 End If s.Delete ExitSub: ActiveDocument.EndCommandGroup Optimization = False ActiveDocument.ClearSelection ActiveWindow.Refresh Exit Sub ErrHandler: MsgBox "Unexpected error occured: " & Err.Description & " [" & Err.Number & "]", vbCritical, "Error" Resume ExitSub End Sub
Hope that helps,
-Shelby