Im using the code below:
Thsi one worked for just one box and at ceratain conditions
Option Explicit
Public Sub LandLW_inter()
Dim myline As AcadLine
Dim mysel As AcadSelectionSet
Dim selsets As AcadSelectionSets
Dim mypl As AcadLWPolyline
Dim ptst(0 To 2) As Double
Dim ptend(0 To 2) As Double
Dim FilterType(0 To 0) As Integer
Dim FilterData(0 To 0) As Variant
Dim varIntPnts As Variant
Dim cnt As Integer
Dim i As Integer
cnt = 0
Set selsets = ThisDrawing.SelectionSets
' for one block
'points that make up the edge of a house
ptst(0) = 742: ptst(1) = 1029: ptst(2) = 0
ptend(0) = 769: ptend(1) = 1058: ptend(2) = 0
'draw the line for effect
Set myline = ThisDrawing.ModelSpace.AddLine(ptst, ptend)
myline.Color = acRed
For Each mysel In selsets
If mysel.Name = "mine" Then
mysel.Delete
Exit For
End If
Next mysel
Set mysel = ThisDrawing.SelectionSets.Add("mine")
FilterType(0) = 0: FilterData(0) = "LWPolyline" ' filter on type - lwpolylines
mysel.Select acSelectionSetCrossing, ptst, ptend, FilterType, FilterData
'selects everything crossing the bounding box of our line
'filters out everything but lwpolyline
Debug.Print "Intersects with " & mysel.Count & " lwpolylines"
For Each mypl In mysel
cnt = cnt + 1
Debug.Print " Intersection : " & cnt & " with Contour " & mypl.Elevation
ptst(2) = mypl.Elevation: ptend(2) = mypl.Elevation
'draw the line for effect - don't really need this
' Set myline = ThisDrawing.ModelSpace.AddLine(ptst, ptend)
'myline.Color = acRed
varIntPnts = myline.IntersectWith(mypl, acExtendNone)
For i = 0 To UBound(varIntPnts)
Debug.Print varIntPnts(i)
Next i
Next mypl
End Sub
Just don't do all the work for her, Trev. I believe this is part of her thesis for school.
Daron ..Dont plant horrible ideas like that in Trev's head
. hehhee
This is only the begining .. there's atleast 95% more for him......or anybody who wants to work on this
