CIRCLE AND TEXT INTERSECTION

[grobnik]

Hi to everybody,

I have a little question for the group members'

Here attached an image which could help the question understanding.

I have a drawing with several points, near each point there is a text which identify the "name" of points, and of course text it's present also into the entire drawing, but I have to catch the only text near the point (by VBA).

In order to do this I thought to catch the point coordinates, drawn a temporary circle of certain diameter (enough to be  sure that text could be covered [intersecting or inside]) and having the text insertion point check if there is an intersection.

I don't know where the text has been drawn compared with point, it could be placed around the point, but I have to cover a 360° potential position and distance from point detected.

But I'm facing a little problem, seems that text and circle are not intersecting between. I know that text could be on a specific layer, but I want to be sure to catch exactly text near the point. I don't know the text alignment.

Here below also a sample code, the variable which could indicate the intersection point will return empty value.

Sub FindText()
For Each PntObject In ThisDrawing.ModelSpace
    If TypeOf PntObject Is AcadPoint Then
        If PntObject.Layer = "POINTS" Then
            PntObjectIns = PntObject.Coordinates
            For Each TxtObject In ThisDrawing.ModelSpace
                If TypeOf TxtObject Is AcadText Then
                    If TxtObject.Layer = "POINTS_LABEL" Then
                        TXT_inspoint = TxtObject.InsertionPoint
                        Set circleObj = ThisDrawing.ModelSpace.AddCircle(PntObjectIns, 28.1026)
                            intPoints = circleObj.IntersectWith(TxtObject, acExtendNone)

                            
                            PointInsertion_Form.CoordsListBox.AddItem (TxtObject.TextString)
                            circleObj.Delete
                        
                        
                        
                        'End If
                    End If
                End If
            Next
        End If
    End If
Next
PointInsertion_Form.show

End Sub

 Every kind of help or suggestions will be accepted.

Thank you.

[norman.yuan · Accepted solution]

I'd suggest an easier "pure calculation" approach, instead of drawing a temporary circle and then erasing it afterward: you can simply get the text's bounding box and find out its center point (easy calculation, right?); then simply calculate the distance between the bounding box center and the said point: if the distance is less than a given value, this text is the one you are after.

Make sense?

[grobnik]

Hi @norman.yuan 

Thank you for suggestion, I'll try.

Please could you indicate me the code for checking distance from objects coordinates? I cannot use simply X or Y value as reference.

In addition, if you can, could you me explain why there is not intersection between a circle and a text ?.

Thank you.

[norman.yuan]

As I said, it quite easy to calculate the distance form a AcadPoint (you know its point coordinate) to a center point of a Text entity. Here is the code:

Public Sub FindDistance()

    Dim point As AcadPoint
    Dim text As AcadText
    
    Dim ent As AcadEntity
    Dim pt As Variant
    
    On Error Resume Next
    
    ThisDrawing.Utility.GetEntity ent, pt, vbCr & "Select a Point entity:"
    If ent Is Nothing Then Exit Sub
    
    If TypeOf ent Is AcadPoint Then
        Set point = ent
    Else
        Exit Sub
    End If
    
    ThisDrawing.Utility.GetEntity ent, pt, vbCr & "Select a Text entity:"
    If ent Is Nothing Then Exit Sub
    
    If TypeOf ent Is AcadText Then
        Set text = ent
    Else
        Exit Sub
    End If
    
    Dim dist As Double
    dist = GetDistanceFromPointToText(point, text)
    
    MsgBox "DISTANCE: " & dist
    
End Sub


Private Function GetDistanceFromPointToText(point As AcadPoint, text As AcadText) As Double

    Dim txtCenter As Variant
    txtCenter = GetTextCenter(text)
    
    Dim x As Double
    Dim y As Double
    Dim z As Double
    
    x = point.Coordinates(0) - txtCenter(0)
    y = point.Coordinates(1) - txtCenter(1)
    z = point.Coordinates(2) - txtCenter(2)
    
    GetDistanceFromPointToText = Sqr(x * x + y * y + z * z)

End Function

Private Function GetTextCenter(text As AcadText) As Variant

    Dim center(0 To 2) As Double
    Dim minPt As Variant
    Dim maxPt As Variant
    
    text.GetBoundingBox minPt, maxPt
    
    center(0) = (minPt(0) + maxPt(0)) / 2#
    center(1) = (minPt(1) + maxPt(1)) / 2#
    center(2) = (minPt(2) + maxPt(2)) / 2#
    
    GetTextCenter = center

End Function

 As for getting intersecting point between a circle and a text, the intersecting points are at the Text's bounding box. That is, if a circle intersects with a text, you should get 2 points back. Following code works for me in the situation showed in below picture:

Public Sub CircleIntersectWithText()
    
    Dim cle As AcadCircle
    Dim text As AcadText
    
    Dim ent As AcadEntity
    Dim pt As Variant
    
    On Error Resume Next
    
    ThisDrawing.Utility.GetEntity ent, pt, vbCr & "Select a Circle entity:"
    If ent Is Nothing Then Exit Sub
    
    If TypeOf ent Is AcadCircle Then
        Set cle = ent
    Else
        Exit Sub
    End If
    
    ThisDrawing.Utility.GetEntity ent, pt, vbCr & "Select a Text entity:"
    If ent Is Nothing Then Exit Sub
    
    If TypeOf ent Is AcadText Then
        Set text = ent
    Else
        Exit Sub
    End If
    
    Dim pts As Variant
    
    pts = cle.IntersectWith(text, acExtendNone)
    
    MsgBox "Intersecting point count: " & (UBound(pts) + 1) / 3
    
End Sub

Back to your original approach, as you can see, the text's bounding box could be different significantly, depending on the text itself (roated, lengh, height). So, I'd think using text's center point (center of its bounding box) would be better approach.

[grobnik]

Thank you very much !

I'll try to applicate and I'll give you a feedback.

Bye