Jump to content

Intersecting lines


Tyke

Recommended Posts

Hi,

 

I have a vba project in which I need to get all the sets of coordinates of where a single line crosses a series of parallel curved 2D polylines and save them in an array.

 

The polylines are existing but the line is constructed in vba and will be later deleted in vba.

 

I had thought of creating a selection set of all the polylines crossed and then dealing with them individually to get the intersection point coordinates using the intersectwith method. But I can't see how to create the selection set.

 

Can anyone help?

 

Thanks

Ben

Link to comment
Share on other sites

Hi,

 

I have a vba project in which I need to get all the sets of coordinates of where a single line crosses a series of parallel curved 2D polylines and save them in an array.

 

The polylines are existing but the line is constructed in vba and will be later deleted in vba.

 

I had thought of creating a selection set of all the polylines crossed and then dealing with them individually to get the intersection point coordinates using the intersectwith method. But I can't see how to create the selection set.

 

Can anyone help?

 

Thanks

Ben

 

This one is not mine

I don't remeber where I have found them

(not tested)

Option Explicit
'' 02/08/2006
'' SelectionSetCrossing example
'' by Gipo
Sub SelSetByCrossingLine()
   Dim oSset As AcadSelectionSet
   Dim ftype(0) As Integer
   Dim fData(0) As Variant
   Dim dxfcode, dxfValue
   Dim oEnt As AcadEntity
   Dim oLine As AcadLine
   Dim oLWPline As AcadLWPolyline
   Dim oPline As AcadPolyline
   Dim inters As Variant
   Dim pickPt As Variant
   Dim ept As Variant
   Dim spt As Variant
   Dim i As Long
   ThisDrawing.Utility.GetEntity oEnt, pickPt, vbLf & "Select crossing line only"
   If TypeOf oEnt Is AcadLine Then
       Set oLine = oEnt
   Else
       MsgBox "selected is not a line. Try again"
       Exit Sub
   End If
   spt = oLine.StartPoint: ept = oLine.EndPoint
   With ThisDrawing.SelectionSets
       While .Count > 0
           .Item(0).Delete
       Wend
       Set oSset = .Add("$Plines$")
   End With
   ftype(0) = 0: fData(0) = "*POLYLINE"
   dxfcode = ftype: dxfValue = fData
   oSset.Select acSelectionSetCrossing, spt, ept, dxfcode, dxfValue
   MsgBox "Selected:" & vbCr & _
          oSset.Count & " polylines"
   For Each oEnt In oSset
       If TypeOf oEnt Is AcadLWPolyline Then
           Set oLWPline = oEnt
           inters = oLine.IntersectWith(oLWPline, acExtendNone)
       ElseIf TypeOf oEnt Is AcadPolyline Then
           Set oPline = oEnt
           inters = oLine.IntersectWith(oPline, acExtendNone)
       End If
       Dim k As Long, n As Long, m As Long
       Dim intPt(2) As Double
       If VarType(inters) <> vbEmpty Then
           For n = LBound(inters) To UBound(inters)
               intPt(0) = inters(n): intPt(1) = inters(n + 1): intPt(2) = inters(n + 2)
               ThisDrawing.ActiveLayout.Block.AddCircle intPt, 1#    '<-- added for debug only
               m = m + 2
               n = n + 3
           Next
       End If
   Next oEnt
End Sub

 

~'J'~

Link to comment
Share on other sites

Thanks Fixo,

 

The crossing line defines the opposite corners of a crossing window selection from which I will get more objects than I want, but with the .IntersectWith method and the parameter acExtendNone I get just the points that I need.

 

I used parts of your code in my project and it works fine.

 

Many thanks.

 

Ben

Link to comment
Share on other sites

Thanks Fixo,

 

The crossing line defines the opposite corners of a crossing window selection from which I will get more objects than I want, but with the .IntersectWith method and the parameter acExtendNone I get just the points that I need.

 

I used parts of your code in my project and it works fine.

 

Many thanks.

 

Ben

 

Glad you got it to work

 

Cheers :)

 

~'J'~

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...