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.
