find the nearest line

[Anonymous]

When I have an insertion point for an entity, how can I find the nearest line to it?

Ben

[Anonymous]

Use the "SelectByCrossing" option, with a Line filter, to create a range in
which
to check. The center of the range is your point. Check your selection set to
see what you got - if nothing increase your range, if one line your done, if
more
than one iterate the SS and check which line is closer by comparing the
line's start
and end points to your test point.

wrote in message news:5371222@discussion.autodesk.com...
When I have an insertion point for an entity, how can I find the nearest
line to it?

Ben

[Anonymous]

Thanks for that Paul, I'll give it a try and let you know what happens.

Ben

[Anonymous]

I should have said "SelectByPolygon"

Here is the idea.
[code]
Dim ss as AcadSelectionSet
'create new ss - Add line filter if you like

Dim pts
pts = PointToPoints(insertionPoint)

'check other acSelection... options also
ss.SelectByPolygon acSelectionSetCrossingPolygon, pts

Select Case ss.Count
Case 0
'increase range and loop
Case 1
'this is your line
Case else
'loop and check each line in set
End Select

Function PointToPoints(inPoint)
'create rectangular points.
'PointToPoints = yourRectangularArray
End Function
[/code]
"Paul Richardson" wrote in message
news:5371593@discussion.autodesk.com...
Use the "SelectByCrossing" option, with a Line filter, to create a range in
which
to check. The center of the range is your point. Check your selection set to
see what you got - if nothing increase your range, if one line your done, if
more
than one iterate the SS and check which line is closer by comparing the
line's start
and end points to your test point.

wrote in message news:5371222@discussion.autodesk.com...
When I have an insertion point for an entity, how can I find the nearest
line to it?

Ben

[Anonymous]

I can't seem to find any documentaion on "SelectByCrossing" in any of my reference books or in the internet. Do you have have any sources. Trying to use it to add members to my SS doesn't work.

I'm using ACAD 2oo5 and VBA.

Ben

[Anonymous]

That's because I was being a bonehead. See my updated post
ss.SelectByPolygon

wrote in message news:5371738@discussion.autodesk.com...
I can't seem to find any documentaion on "SelectByCrossing" in any of my
reference books or in the internet. Do you have have any sources. Trying to
use it to add members to my SS doesn't work.

I'm using ACAD 2oo5 and VBA.

Ben

[Anonymous]

I guess my last posting crossed yours in the post almost.

How are you defining the range for the selection. I can see the method and the start point (pts) but not the range, which could be altered in a loop

Using your code I get a run-time error '91' (Object variable or With block variable not set)

I'm just starting to write the code and have not got very far with it, but this is what I have at the moment (the aim is to join the insertion point of the selected text with a new line perpendicular to the nearest line):

Sub FindLine()

Dim objLineEnt As AcadEntity
Dim objTextEnt As AcadEntity
Dim linEnt As AcadLine
Dim varTextInsertPoint As Variant
Dim ssLines As AcadSelectionSet
Dim intMode As Integer

ThisDrawing.Utility.GetEntity objTextEnt, varTextInsertPoint, "Select the text"

'Set ssLines = ThisDrawing.SelectionSets.Add("ssLines")
ssLines.SelectByPolygon acSelectionSetCrossingPolygon, varTextInsertPoint, "Line"

End Sub

Ben

[Anonymous]

You need to create a new selection set which I would do
in its own function - search group for method.

Dim fType(0) As Integer
Dim fData(0) As Variant
fType(0) = 0
fData(0) = "LINE"

Dim ss As AcadSelectionSet
Set ss = ThisDrawing.SelectionSets.Add("foo")

'you need a function that takes an insertion point and a search range
'and retruns 'pts(x) which is an array of x,y,z points of your bounding
'area to check
ss.SelectByPolygon acSelectionSetCrossingPolygon, pts, fType, fData

wrote in message news:5371781@discussion.autodesk.com...
I guess my last posting crossed yours in the post almost.

How are you defining the range for the selection. I can see the method and
the start point (pts) but not the range, which could be altered in a loop

Using your code I get a run-time error '91' (Object variable or With block
variable not set)

I'm just starting to write the code and have not got very far with it, but
this is what I have at the moment (the aim is to join the insertion point of
the selected text with a new line perpendicular to the nearest line):

Sub FindLine()

Dim objLineEnt As AcadEntity
Dim objTextEnt As AcadEntity
Dim linEnt As AcadLine
Dim varTextInsertPoint As Variant
Dim ssLines As AcadSelectionSet
Dim intMode As Integer

ThisDrawing.Utility.GetEntity objTextEnt, varTextInsertPoint, "Select
the text"

'Set ssLines = ThisDrawing.SelectionSets.Add("ssLines")
ssLines.SelectByPolygon acSelectionSetCrossingPolygon,
varTextInsertPoint, "Line"

End Sub

Ben

[Anonymous]

try this idea.

[code]
Sub stub()

Dim fType(0) As Integer
Dim fData(0) As Variant
fType(0) = 0
fData(0) = "LINE"

Dim ss As AcadSelectionSet
Set ss = ThisDrawing.SelectionSets.Add("foo")

Dim txt As AcadText
Dim pp
ThisDrawing.Utility.GetEntity txt, pp

Dim pts
Dim range As Double
range = 5
pts = PointToCoordinateArray(txt.InsertionPoint, range)

ss.SelectByPolygon acSelectionSetCrossingPolygon, pts, fType, fData

Select Case ss.Count
Case 1
'this is your line
Case Else
'check each line in SS
'to see which is closest
End Select

ThisDrawing.SelectionSets("foo").Delete
End Sub

Function PointToCoordinateArray(inPt, inRange)
Dim p(14) As Double
p(0) = inPt(0) - inRange
p(1) = inPt(1) - inRange
p(2) = 0
p(3) = inPt(0) + inRange
p(4) = inPt(1) - inRange
p(5) = 0
p(6) = inPt(0) + inRange
p(7) = inPt(1) + inRange
p(8) = 0
p(9) = inPt(0) - inRange
p(10) = inPt(1) + inRange
p(11) = 0
p(12) = p(0)
p(13) = p(1)
p(14) = 0

PointToCoordinateArray = p
End Function
[/code]
wrote in message news:5371781@discussion.autodesk.com...
I guess my last posting crossed yours in the post almost.

How are you defining the range for the selection. I can see the method and
the start point (pts) but not the range, which could be altered in a loop

Using your code I get a run-time error '91' (Object variable or With block
variable not set)

I'm just starting to write the code and have not got very far with it, but
this is what I have at the moment (the aim is to join the insertion point of
the selected text with a new line perpendicular to the nearest line):

Sub FindLine()

Dim objLineEnt As AcadEntity
Dim objTextEnt As AcadEntity
Dim linEnt As AcadLine
Dim varTextInsertPoint As Variant
Dim ssLines As AcadSelectionSet
Dim intMode As Integer

ThisDrawing.Utility.GetEntity objTextEnt, varTextInsertPoint, "Select
the text"

'Set ssLines = ThisDrawing.SelectionSets.Add("ssLines")
ssLines.SelectByPolygon acSelectionSetCrossingPolygon,
varTextInsertPoint, "Line"

End Sub

Ben

[Anonymous]

Thanks for the tips Paul.

I tried them out and with a bit of customisation they work a treat and do exactly what I want.

Once again many thanks

Ben

[Anonymous]

You're welcome.
wrote in message news:5378090@discussion.autodesk.com...
Thanks for the tips Paul.

I tried them out and with a bit of customisation they work a treat and do
exactly what I want.

Once again many thanks

Ben

[Anonymous]

Hi Paul,

I've used the code a few times and then stumbled across a situation where it doesn't work.

If I have two lines, one parallel to the X-axis and 6m away from my point, and a second line at 45° to the X-axis and 7m away from my point, it selects the line furthest away. This is when I start with a 1x1 selection box and then increment its size by 0.1 until it finds a line.

This happens because the line that is 7m from my point crosses the selection box before the one 6m from my selection point.

Instead of using a selection box is it possible to draw a circle and the find all lines which cross the circle? I've played around with it myself but without any success.

Ben

[Paul Richardson]

Just draw a circular pline with as many sides as you need. I don't have time to look for it right now, but I've posted the code to do this. Use the polar function.

[Anonymous]

This returns circular pline points. You can make the function
more intelligent by accepting a precision paramater instead
of just using 362.

[code]
Option Explicit

Function dtr(a As Double) As Double
Dim pi: pi = 4 * Atn(1)
dtr = (a / 180) * pi
End Function

Function CircularPlinePoints(startPoint, inRadius As Double)
Const numPts As Integer = 362
Dim pts(numPts) As Double
Dim i As Double
For i = 0 To (UBound(pts)) Step 3
Dim tPt
tPt = ThisDrawing.Utility.PolarPoint(startPoint, dtr(i), inRadius)
pts(i) = tPt(0)
pts(i + 1) = tPt(1)
pts(i + 2) = startPoint(2)
Next i
CircularPlinePoints = pts
End Function

'Test
Sub CircularPlinePoints_Driver()
Dim pline As Acad3DPolyline
Set pline = ThisDrawing.ModelSpace.Add3DPoly _
(CircularPlinePoints(ThisDrawing.Utility.GetPoint(), 10))
End Sub
[\code]
wrote in message news:5400970@discussion.autodesk.com...
Hi Paul,

I've used the code a few times and then stumbled across a situation where it
doesn't work.

If I have two lines, one parallel to the X-axis and 6m away from my point,
and a second line at 45° to the X-axis and 7m away from my point, it selects
the line furthest away. This is when I start with a 1x1 selection box and
then increment its size by 0.1 until it finds a line.

This happens because the line that is 7m from my point crosses the selection
box before the one 6m from my selection point.

Instead of using a selection box is it possible to draw a circle and the
find all lines which cross the circle? I've played around with it myself
but without any success.

Ben

[Anonymous]

Have you come across "Entity.IntersectWith()"
How would it be used.

I could see the possibility of:
draw a circle about thr point of a specific radius
check if an entity intersects with the circle
if not increase the radius and repeat
if it does check the entity
etc...

I've tried it out but can't get it to compile, various errors crop up

I also can't find any documentation on it

Any ideas?

[Paul Richardson]

Intersectwith works fine. Post a dwg so I can see what you're trying to accomplish.

[Anonymous]

Hi Paul,

What I have at the moment is a module where I can select a line and the some text and the text is aligned with the line, all further text selected is aligned with the first line until I right click, then I have the opportunity to select another line and then text... That works perfectly and I have no problems with it, but I wanted to develop it further and there I've fallen flat on my face.

I have a routine, all be it in lisp at the moment, that takes surveyed data (x,y,z, point number and code) from an ascii file and reads them into AutoCAD, placing them on their respective layers and automatically placing symbols and joinings the lines as specified by their codes. Thats been working ok since the 90's. But the text that is inserted is always horizontal. I have only recently started writing in VBA but my text alignment works ok, but it still could be done quicker.

My idea was to create a selection set of the text (perhaps filtered by layer) and then for each text item, get its insertion point. and from this "point" find the nearest line, extract the angle of the line and apply it to the text's rotation, so that it would be aligned to the line. The theory being that perhaps more than 95% of the text would be correctly aligned and I need only worry about the odd text entity, which I could always deal with using my other module. Upside down text is automatically dealt with by checking the lines angle first.

I can create a selection set of all text in the drawing and then iterate through the selection set. No problem so far. But finding the line nearest to the text insetion point has me beat.

I would be very grateful if you could help me over this hurdle. I'm keen to learn more about VBA and also VB with AutoCAD.

Attached is a small dwg with a couple of lines and text items. The objective is to automatically align the two text items with tthe nearest line to them.
Ben Message was edited by: Tyke

[Paul Richardson]

This if this helps...

[code]
Function dtr(a As Double) As Double
Dim pi: pi = 4 * Atn(1)
dtr = (a / 180) * pi
End Function

Function CircularPlinePoints(startPoint, inRadius As Double)
Const numPts As Integer = 362
Dim pts(numPts) As Double
Dim i As Double
For i = 0 To (UBound(pts)) Step 3
Dim tPt
tPt = ThisDrawing.Utility.PolarPoint(startPoint, dtr(i), inRadius)
pts(i) = tPt(0)
pts(i + 1) = tPt(1)
pts(i + 2) = startPoint(2)
Next i
CircularPlinePoints = pts
End Function


Sub stub()
Dim fType(1) As Integer
Dim fData(1) As Variant
'filter for text on "yourLayer"
fType(0) = 0
fData(0) = "TEXT"
fType(1) = 8
fData(1) = "yourLayer"

Dim ssText As AcadSelectionSet
Set ssText = ThisDrawing.SelectionSets.Add("TEXT")
ssText.Select acSelectionSetAll, , , fType, fData

Dim rad As Double
rad = ThisDrawing.Utility.GetReal("Enter search radius: ")

Dim i As Integer
Dim txt As AcadText
For i = 0 To ssText.Count - 1

Set txt = ssText(i)

Dim ssLines As AcadSelectionSet
Dim fType1(0) As Integer
Dim fData1(0) As Variant
fType1(0) = 0
fData1(0) = "LINE"
Set ssLines = ThisDrawing.SelectionSets.Add("LINES")
ssLines.SelectByPolygon acSelectionSetCrossingPolygon, _
(CircularPlinePoints(txt.InsertionPoint, rad)), fType1, fData1

Select Case ssLines.Count
Case 0
MsgBox "Increase radius and try again: "
Case 1
txt.Rotate txt.InsertionPoint, ssLines(0).Angle
Case Else
'iterate ssLines and find closed line by
'checking end points.
End Select

ThisDrawing.SelectionSets("LINES").Delete
Next i
ThisDrawing.SelectionSets("TEXT").Delete
End Sub
[/code]

[Anonymous]

This is a bit cleaner.

[code]
Function dtr(a As Double) As Double
Dim pi: pi = 4 * Atn(1)
dtr = (a / 180) * pi
End Function

Function CircularPlinePoints(startPoint, inRadius As Double)
Const numPts As Integer = 362
Dim pts(numPts) As Double
Dim i As Double
For i = 0 To (UBound(pts)) Step 3
Dim tPt
tPt = ThisDrawing.Utility.PolarPoint(startPoint, dtr(i), inRadius)
pts(i) = tPt(0)
pts(i + 1) = tPt(1)
pts(i + 2) = startPoint(2)
Next i
CircularPlinePoints = pts
End Function

Public Function AddSS _
(Optional ssName As String = "goo") As AcadSelectionSet
On Error Resume Next
ThisDrawing.SelectionSets(ssName).Delete
Set AddSS = ThisDrawing.SelectionSets.Add(ssName)
On Error GoTo 0
End Function

Public Function DeleteSS _
(ssName As String) As AcadSelectionSet
On Error Resume Next
ThisDrawing.SelectionSets(ssName).Delete
On Error GoTo 0
End Function

Sub main()
Dim fType(1) As Integer
Dim fData(1) As Variant
fType(0) = 0
fData(0) = "TEXT"
fType(1) = 8
fData(1) = "0"

Dim ssText As AcadSelectionSet
Set ssText = AddSS("TEXT")
ssText.Select acSelectionSetAll, , , fType, fData

Dim rad As Double
rad = 150

Dim i As Integer
Dim txt As AcadText
For i = 0 To ssText.Count - 1

Set txt = ssText(i)

Dim ssLines As AcadSelectionSet
Dim fType1(0) As Integer
Dim fData1(0) As Variant
fType1(0) = 0
fData1(0) = "LINE"
Set ssLines = AddSS("LINES")
ssLines.SelectByPolygon acSelectionSetCrossingPolygon, _
(CircularPlinePoints(txt.InsertionPoint, rad)), fType1, fData1

Select Case ssLines.Count
Case 1
txt.Rotate txt.InsertionPoint, ssLines(0).Angle
Case Else
'iterate ssLines and find closed line by
'checking end points.
End Select

DeleteSS ("LINES")
Next i
DeleteSS ("TEXT")
End Sub
[/code]
wrote in message news:5404524@discussion.autodesk.com...
This if this helps...

[code]
Function dtr(a As Double) As Double
Dim pi: pi = 4 * Atn(1)
dtr = (a / 180) * pi
End Function

Function CircularPlinePoints(startPoint, inRadius As Double)
Const numPts As Integer = 362
Dim pts(numPts) As Double
Dim i As Double
For i = 0 To (UBound(pts)) Step 3
Dim tPt
tPt = ThisDrawing.Utility.PolarPoint(startPoint, dtr(i), inRadius)
pts(i) = tPt(0)
pts(i + 1) = tPt(1)
pts(i + 2) = startPoint(2)
Next i
CircularPlinePoints = pts
End Function


Sub stub()
Dim fType(1) As Integer
Dim fData(1) As Variant
'filter for text on "yourLayer"
fType(0) = 0
fData(0) = "TEXT"
fType(1) = 8
fData(1) = "yourLayer"

Dim ssText As AcadSelectionSet
Set ssText = ThisDrawing.SelectionSets.Add("TEXT")
ssText.Select acSelectionSetAll, , , fType, fData

Dim rad As Double
rad = ThisDrawing.Utility.GetReal("Enter search radius: ")

Dim i As Integer
Dim txt As AcadText
For i = 0 To ssText.Count - 1

Set txt = ssText(i)

Dim ssLines As AcadSelectionSet
Dim fType1(0) As Integer
Dim fData1(0) As Variant
fType1(0) = 0
fData1(0) = "LINE"
Set ssLines = ThisDrawing.SelectionSets.Add("LINES")
ssLines.SelectByPolygon acSelectionSetCrossingPolygon, _
(CircularPlinePoints(txt.InsertionPoint, rad)), fType1, fData1

Select Case ssLines.Count
Case 0
MsgBox "Increase radius and try again: "
Case 1
txt.Rotate txt.InsertionPoint, ssLines(0).Angle
Case Else
'iterate ssLines and find closed line by
'checking end points.
End Select

ThisDrawing.SelectionSets("LINES").Delete
Next i
ThisDrawing.SelectionSets("TEXT").Delete
End Sub
[/code]

[Anonymous]

Hi Paul,

That works great. Many thanks for all of your help, it was invaluable.

I've altered the logic a little, I've started with a small radius that will not find a line, then I added a Case 0 with a loop that increments the radius and tries again until one line is found. I still need to expand the case where more than one line is found.

I will also add a function to get the name of the layer the text is on from the user at run time. I need to deal with upside-down text (but I've already dealt with that in my manual text alignment module) and no doubt I will think of a few other bells and whistles that I can add.

By the way are you in the UK?

Many thanks

Ben