VBA
Discuss AutoCAD ActiveX and VBA (Visual Basic for Applications) questions here.
cancel
Showing results for 
Show  only  | Search instead for 
Did you mean: 

Extract text by zone from a block

2 REPLIES 2
Reply
Message 1 of 3
jplujan
211 Views, 2 Replies

Extract text by zone from a block

Hello

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

 

Zone_data.png

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

 

zone_inmediate.png

 

Thanks in advance.

 

2 REPLIES 2
Message 2 of 3
MakCADD
in reply to: jplujan

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 

Message 3 of 3
Ed.Jobe
in reply to: jplujan

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

Ed


Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
How to post your code.

EESignature

Can't find what you're looking for? Ask the community or share your knowledge.

Post to forums  

Forma Design Contest


AutoCAD Beta