Extract text by zone from a block

[jplujan]

Hello

Would it be possible to extract a text (not attribute) from a user-defined area (blue dashed line) of a block?

With the attached code I can extract all the text in the block.

Sub Main()
    Dim objSeleccionRF As Object
    Dim NumeroColumna As String
    
    Set objSeleccionRF = SeleccionRF
   
    NumeroColumna = DevolverZona(objSeleccionRF)
    
End Sub

Function DevolverZona(seleccion As Object) As String
    Dim item As Variant
    Dim ent As Variant
    Dim SelectBlockText As Object
    Dim txt As AcadText
        
    For Each item In seleccion
        If TypeOf item Is AcadBlockReference Then
        Set SelectBlockText = ThisDrawing.Blocks("ZONE_DATA")
            For Each ent In SelectBlockText
                If TypeOf ent Is AcadText Then
                    Set txt = ent
                    Debug.Print ent.TextString
                    DevolverZona = ent.TextString
                End If
            Next
        End If
    Next

   
End Function


'''' SELECCION

Function SeleccionRF() As Object
    Dim seleccion As Object
    
    Set seleccion = NuevaSeleccion("SeleccionBloque")
    seleccion.SelectOnScreen
    Set SeleccionRF = seleccion

End Function


Function NuevaSeleccion(strNom As String) As AcadSelectionSet
   If SelectionExiste(strNom) Then ThisDrawing.SelectionSets.item(strNom).Delete
   Set NuevaSeleccion = ThisDrawing.SelectionSets.Add(strNom)
End Function

Function SelectionExiste(Nombre As String) As Boolean
    Dim Sset As AcadSelectionSet
    
    For Each Sset In ThisDrawing.SelectionSets
        If Sset.Name = Nombre Then
            SelectionExiste = True
            Exit Function
        End If
    Next Sset
End Function

Function DevolverSeleccion(cadena As String) As AcadSelectionSet
    Dim seleccion As AcadSelectionSet
    LimpiarSeleccion (cadena)
    Set seleccion = ThisDrawing.SelectionSets.Add(cadena)
    seleccion.SelectOnScreen
    Set DevolverSeleccion = seleccion
End Function

Sub LimpiarSeleccion(ByVal cadena As String)
        Dim SSS As AcadSelectionSets
        On Error Resume Next
        Set SSS = ThisDrawing.SelectionSets
        If SSS.Count > 0 Then
            SSS.item(cadena).Delete
        End If
End Sub

Thanks in advance.

[MakCADD]

Verify the boundary is closed 

Draw a RAY starting from the TEXT.

by counting the intersection points of a ray with boundary you can Verify the text is inside the boundary 

[ed57gmc · Accepted solution]

Assuming that the blue rectangle is just a selection window, you can use my GetSS_TextFilter function.

[Trae_A_Beall]

If the blue window was not a Selection Window, but known X, Y coordinates instead, how would you extract all text from that region?

[ed57gmc]

You can change acSelectionSetAll to acSelectionSetWindow and either prompt the user for window corners or supply them however you want.

[jplujan]

Hi, 

Thanks for your reply, I'll try it.