Object near line

[KoenE]

Hi all,

 

My first post on this forum after a long search...

 

I am trying to write a VBA routine wich will return information of objects near an other object.

 

Is there a command or code wich can help me identifying objects near a line?

The objects are not always crossing the line, they might as well be parallel.

 

Thanks

[abraxus]

i am not aware of any such function besides IntersectWith- so if they do not intersect, you will have to combine IntersectWith with code extra code

 

define a point on the line, and then programatically draw another line from that point at 0 degrees and at the distance you want to detect

 

then use that new line and create a polar array from the original point every 5 degrees around that point using that line

 

now you have an array of lines which you can use to iterate thru using the IntersectWith function to detect any intersections

 

hope that helps

 

edit: i have attached a file that visually demonstrates my idea

IntersectWith.dwg

[KoenE]

So Abraxus or anyone interrested,

 

My following question:

 

How do I add one of those lines newly created lines plus the line I'm trying to find to my selectionset.

Because I neew both lik this: LineJustCreated.IntersectWith(lineToFind, acExtendnone)

 

Am I in the right direction?

[SEANT]

Is it safe to say the object is always linear? Circle, Ellipse, Spline entities would certainly complicate matters. Not to mention Polylines and Block Inserts.

Also, Is the entity coplanar with the WCS (i.e.,dealing with just 2D geometry)?

[KoenE]

SEANT

Is it safe to say the object is always linear? Circle, Ellipse, Spline entities would certainly complicate matters. Not to mention Polylines and Block Inserts.

 

Also, Is the entity coplanar with the WCS (i.e.,dealing with just 2D geometry)?

 

Well, the drawing is 2D and I am only looking for lines, so hooray!

 

Only the lines are often polylines, I just don't understand why this makes things complicated...

[SEANT]

Well, the drawing is 2D and I am only looking for lines, so hooray!

 

Only the lines are often polylines, I just don't understand why this makes things complicated...

[/indent]

 

A line/line comparison only has to test the two endpoints of the "Test line" to the "Primary line". Polylines have more end points (Vertices) to test - as well as the potential for Arcs.

[KoenE]

@SEANT

 

Ah, I see.

 

It is certain that the polylines do not consist of arcs, also the function to get all vertex and their coördinates of the polyline is already running.

 

 

But the problem right now remains, I dont know how to select a line within a certain range of a other line, even if I were to use InterectWith, I still need to add the line to my selectionset..

[SEANT]

An alternate method of testing a point (PT) against a “PrimaryLine”:

Get the SlopeVector of the line via PrimaryLine.Delta. Create a PerpendicularVector

Dim PerpendicularVector (0 To 2) As Double
PerpendicularVector(0) = - SlopeVector(1)  ‘note the negative sign
PerpendicularVector(1) =  SlopeVector(0) 
PerpendicularVector(2) =  0.0

Then create a second point based on that vector and the testing point (PT)

Dim SecondPoint (0 To 2) As Double
SecondPoint(0) = PT(0) + PerpendicularVector(0)  
SecondPoint(1) = PT(1) + PerpendicularVector(1)  
SecondPoint(2) = PT(2) + PerpendicularVector(2) 

Then create a Xline using the PT and SecondPoint. Finally, call intersectWith using the PrimaryLine and Xline. Further testing may be needed if there is no intersection.

[abraxus]

i made some adjustments to my CollisionDetect code today that made it much faster, and it relates to this topic as well

 

First off, keep in mind that trying to find other objects "near" a line gets very complex, because even a line with endpoints has a variable length, so it all depends on how you define "near" in that case

 

instead, you will need to define a point on the line that you want to find something "near" to

 

once you define that point (as kinda shown in my example from a few days ago) you can create a selection set of objects based on a thresh-hold value - kinda like a radius, but since you will have to use "window" or "crossing" to select any fixtures near it, it would be more like a square radius instead of circular

 

then once you have all that information, you iterate thru the selection set and compare something about those entities with the given point you want to find it "near" to... you can probably use a bounding box to define min and max values for x and y of the selection set based on the endpoints of the line (that's simple to do) but keep in mind that that larger the selection set you have to process is, the longer it's going to take

 

and keep in mind that any code that takes longer than about 2 seconds to run should really have a progress bar form that shows up (with doevents in the loop) so the user doesnt think that their computer has locked up by executing your code

[KoenE]

Thanks abraxus,

 

I am currently trying out an other way to do what i want.

 

But also working on a project wich must be finished by the end of the week.

It's a shame because I could use this code to speed things up, now I have to work the old fashioned way for a bit longer...

[abraxus]

here's another approach:

 

using your line, create a bounding box, then add some padding to it, and build a selection set using the points you create based on a crossing selection on those bounding box points, and then process that selection set

[abraxus]

get the bounding box for the line, then add a tolerance variable to it to define a crossing for a programmatic selection set to process

[fixo]

Thanks abraxus,

 

I am currently trying out an other way to do what i want.

 

But also working on a project wich must be finished by the end of the week.

It's a shame because I could use this code to speed things up, now I have to work the old fashioned way for a bit longer...

Not sure about if this helps

try this one from my oldies, this will allow you

to search for nearest text to a line, change the selection

filter to your needs:

Option Explicit


Const pi As Double = 3.14159265358979
Public Sub 
TouchNearestText()
Dim oEnt As AcadEntity
Dim oLine As 
AcadLine
Dim pickPt
On Error GoTo Err_Report
Call 
ThisDrawing.Utility.GetEntity(oEnt, pickPt, vbLf & "Select a Line: 
")
     If Not TypeOf oEnt Is AcadLine 
Then
     MsgBox "Not a 
Line!"
     Exit 
Sub
     End If

Set oLine = oEnt
     Dim minExt As 
Variant
     Dim maxExt As 
Variant

   ' Return the bounding box 
for the line and return the minimum
   ' and maximum extents 
of the box in the minExt and maxExt variables.

oLine.GetBoundingBox minExt, maxExt
   Dim pts(0 To 11) As 
Double


   pts(0) = minExt(0): pts(1) = minExt(1): pts(2) = 
0#
   pts(3) = maxExt(0): pts(4) = minExt(1): pts(5) = 
0#
   pts(6) = maxExt(0): pts(7) = maxExt(1): pts( = 
0#
   pts(9) = minExt(0): pts(10) = maxExt(1): pts(11) = 
0#


     Dim setObj As 
AcadSelectionSet
    Dim setColl As 
AcadSelectionSets
    Dim oText As 
AcadText
    Dim pickPnt As 
Variant
    Dim setName As 
String
    Dim selMod As 
Long
    Dim vertPts As 
Variant
    Dim dblElv As 
Double
    Dim gpCode(1) As 
Integer
    Dim dataValue(1) As 
Variant
    Dim dxfcode, 
dxfdata
    '' build your filter 
here:
    gpCode(0) = 0: gpCode(1) = 
8
    dataValue(0) = "TEXT": dataValue(1) = 
"0"
    dxfcode = gpCode: dxfdata = 
dataValue
    setName = "$CrossSelect$"


    With 
ThisDrawing
         Set 
setColl = 
.SelectionSets
         For 
Each setObj In 
setColl

If setObj.Name = setName 
Then

.SelectionSets.item(setName).Delete

Exit 
For

End If

Next
         Set setObj = 
.SelectionSets.Add(setName)
    End With


    selMod = 
AcSelect.acSelectionSetCrossingPolygon     ' <-- can use 
also acSelectionSetWindowPolygon   '


    setObj.SelectByPolygon selMod, pts, dxfcode, 
dxfdata
    setObj.Highlight 
True
    Dim objEnt As 
AcadEntity
    Dim dblDist As Double
If setObj.Count 
= 0 Then Exit Sub


    Dim distArr As Variant

Dim ang As Double
    Dim angLine As 
Double
    ReDim arr(1000, 1) As Variant ''put maximum 
number of nearer items you 
need
        ' >> do your 
stuffs here
        Dim 
n
    For Each objEnt In 
setObj
         Set oText = 
objEnt
         Dim ptIns As 
Variant
         ptIns = 
oText.InsertionPoint

angLine = oLine.Angle

ang = ThisDrawing.Utility.AngleFromXAxis(oLine.StartPoint, 
ptIns)
         ang = ang - 
angLine
         dblDist = 
Distance(ptIns, 
oLine.StartPoint)

dblDist = Abs(dblDist * 
Sin(ang))
         arr(n, 0) = 
oText.Handle: arr(n, 1) = 
dblDist
         n = n + 
1

    Next


    Dim strHandle As String

Dim minDist
    minDist = arr(0, 
1)
    For n = 0 To UBound(arr, 
1)
     If arr(n, 0) <> "" And arr(n, 1) < 
minDist Then
    minDist = arr(n, 
1)
    strHandle = arr(n, 0)

End If
    Next
    '' change 
some properties of a text you've found
Set objEnt = 
ThisDrawing.HandleToObject(strHandle)
    objEnt.Layer = 
oLine.Layer

objEnt.TrueColor = 
oLine.TrueColor

objEnt.Update


    MsgBox "Minimum distance: " & minDist


Err_Report:
If Err.Number <> 0 Then
MsgBox Err.Description
End 
If



End Sub
'' by Bryco
Public Function Distance(ByVal pt1 As Variant, ByVal pt2 As 
Variant) As Double
Dim x As Double, y As Double, z As Double
Dim dist As 
Double
' Calculate the distance between pt1 and pt2
x = pt1(0) - 
pt2(0)
y = pt1(1) - pt2(1)
z = pt1(2) - pt2(2)
dist = Sqr((Sqr((x ^ 2) 
+ (y ^ 2)) ^ 2) + (z ^ 2))
Distance = dist
End Function

[fixo]

Here is more readable source code, see attached:

FindNearestObject.txt