Tyke Posted January 5, 2010 Share Posted January 5, 2010 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 Quote Link to comment Share on other sites More sharing options...
fixo Posted January 5, 2010 Share Posted January 5, 2010 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'~ Quote Link to comment Share on other sites More sharing options...
Tyke Posted January 6, 2010 Author Share Posted January 6, 2010 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 Quote Link to comment Share on other sites More sharing options...
fixo Posted January 6, 2010 Share Posted January 6, 2010 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'~ Quote Link to comment Share on other sites More sharing options...
Recommended Posts
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.