Thread: Iintersecting polyline with a circle

1. Iintersecting polyline with a circle

Registered forum members do not see this ad.

I need to calculate a point along a polyline based on intersecting a point of a circle with a polyline the centre is always along the poly line but can intersect different segments.

The idea is to walk along the poly line calculating the other points.

I have written a VBA`routine which calcs points along the poly line but I am looking for an easy way to calculate the intersecting points.

Any one done something like this ?

2. See IntersectWith Method.

3. Re: Iintersecting polyline with a circle

Originally Posted by BIGAL
I need to calculate a point along a polyline based on intersecting a point of a circle with a polyline the centre is always along the poly line but can intersect different segments.

The idea is to walk along the poly line calculating the other points.

I have written a VBA`routine which calcs points along the poly line but I am looking for an easy way to calculate the intersecting points.

Any one done something like this ?
Just an example, not sure that will work what you need
(all of this grabbed from adesk's and another forum)
Code:
```Option Explicit

Dim vType&#40;0&#41; As Integer
Dim vData&#40;0&#41; As Variant
Dim vPts&#40;&#41; As Double
Dim mode As Integer
mode = acSelectionSetFence
vType&#40;0&#41; = 0
vData&#40;0&#41; = "CIRCLE"
Set selCol = ThisDrawing.SelectionSets

For Each oSelset In selCol
If oSelset.Name = "Fence_Sset" Then
oSelset.Delete
Exit For
End If
Next oSelset
If oPoly.Closed = False Then
vPts = PointArray2dTo3d&#40;oPoly.Coordinates&#41;
Else
vPts = PointArray2dTo3d&#40;Split_Coordinates&#40;oPoly.Coordinates&#41;&#41;
End If
oSelset.SelectByPolygon mode, vPts, vType, vData
Set Sel_Poly_Fence = oSelset
End Function
Private Function PointArray2dTo3d&#40;vPts&#41;
Dim vNewPts&#40;&#41; As Double
Dim i As Integer
Dim j As Integer

ReDim vNewPts&#40;CInt&#40;1.5 * &#40;UBound&#40;vPts&#41; + 1&#41;&#41; - 1&#41; As Double

j = 0
For i = 0 To UBound&#40;vPts&#41; Step 2
vNewPts&#40;i + j&#41; = vPts&#40;i&#41;
vNewPts&#40;i + j + 1&#41; = vPts&#40;i + 1&#41;
j = j + 1
Next
PointArray2dTo3d = vNewPts
End Function
Public Function Split_Coordinates&#40;oCoords As Variant&#41; As Variant

Dim retArr&#40;&#41; As Double
Dim i As Integer
retArr = oCoords
i = UBound&#40;oCoords&#41; + 1
ReDim Preserve retArr&#40;0 To i + 1&#41;
retArr&#40;i&#41; = oCoords&#40;0&#41;&#58; retArr&#40;i + 1&#41; = oCoords&#40;1&#41;

Split_Coordinates = retArr
End Function
Sub Test_Fence_Selection&#40;&#41;
Dim intArr As Variant
Dim pntList&#40;&#41; As Variant
Dim varPnt&#40;0 To 2&#41; As Double
Dim snapPt As Variant
Dim i As Integer
Dim j As Integer

On Error GoTo ErrHand
ThisDrawing.Utility.GetEntity oPoly, snapPt, vbCr & "Select polyline &#58;"

If oPoly.ObjectName = "AcDbPolyline" Then
Set oSelset = Sel_Poly_Fence&#40;oPoly&#41;

Else&#58; MsgBox "This object isn't a polyline!"
Exit Sub
End If

j = -1
For Each oCirc In oSelset
If IsEmpty&#40;oCirc.IntersectWith&#40;oPoly, acExtendNone&#41;&#41; = True Then
Exit For

Else
intArr = oCirc.IntersectWith&#40;oPoly, acExtendNone&#41;
For i = 0 To UBound&#40;intArr&#41; - 1 Step 3
varPnt&#40;0&#41; = intArr&#40;i&#41;&#58; varPnt&#40;1&#41; = intArr&#40;i + 1&#41;&#58; varPnt&#40;2&#41; = intArr&#40;i + 2&#41;
Set nCirc = ThisDrawing.ModelSpace.AddCircle&#40;varPnt, 1.5&#41; 'change diameter by suit
j = j + 1
ReDim Preserve pntList&#40;j&#41;
pntList&#40;j&#41; = varPnt
Next
End If
Next
ErrHand&#58;
MsgBox Err.Description
End Sub```
~'J'~

4. calculting intersections of objects

Registered forum members do not see this ad.

Thanks for the help got it to work using intersect need to use an arc rather than a circle stops second answer being generated. others may be interested so here is some code to play with I have left the different options remarked ie line / line, line / arc, line /circle, poly lines etc

there are option on the AcExtend command so a little experimenting is needed.

Sub find_ints()

Dim retVal As Variant
Dim Pt1(0 To 2) As Double
On Error GoTo Something_Wrong
'ThisDrawing.Utility.GetEntity oline1, snapPt, vbCr & "Select line :"
'ThisDrawing.Utility.GetEntity oline2, snapPt, vbCr & "Select line :"
'ThisDrawing.Utility.GetEntity ocirc, snapPt, vbCr & "Select circle :"
'ThisDrawing.Utility.GetEntity oarc, snapPt, vbCr & "Select arc :"
'select last arc drawn automaticaly
ThisDrawing.Utility.GetEntity.last oarc
ThisDrawing.Utility.GetEntity opoly, snapPt, vbCr & "Select polyline :"

'If opoly.ObjectName = "AcDbPolyline" Then
'Coords = opoly.Coordinates
'Else: MsgBox "This object is not a polyline!"
'xit Sub
'End If

'retVal = oline1.IntersectWith(oline2, acExtendBoth)
'retVal = oline1.IntersectWith(opoly, acExtendBoth)
'retVal = ocirc.IntersectWith(opoly, acExtendNone)
retVal = oarc.IntersectWith(opoly, acExtendOtherEntity)
MsgBox retVal(0)
MsgBox retVal(1)

GoTo endprog

Something_Wrong:
MsgBox Err.Description
endprog:

End Sub

Posting Permissions

• You may not post new threads
• You may not post replies
• You may not post attachments
• You may not edit your posts