Delete Text inside the block

[balaananthan_r]

Hi , 

I want to remove the text from block reference using selectionsetcrossingpolygon method inside the block . But the code doesnt work properly, instead its deleting the text from modelspace. Help me find the solution 

@norman.yuan @Ed.Jobe 

Sub removetext()

Dim acadApp As Object
Dim acadDoc As Object
Set acadApp = GetObject(, "AutoCAD.Application")
Set acadDoc = acadApp.ActiveDocument
acadDoc.SetVariable "PICKSTYLE", 1

On Error GoTo 0

' Create AcadSelectionSet Object
Dim ssetObj As Object
Err.Clear
On Error Resume Next
Set ssetObj = acadDoc.SelectionSets("SS")
If Err Then
Set ssetObj = acadDoc.SelectionSets.Add("SS")
End If
On Error GoTo 0

ssetObj.Clear

ReDim AreaLineCoords(0 To 11) As Double
AreaLineCoords(0) = 9.3196
AreaLineCoords(1) = 5.9139
AreaLineCoords(2) = 0
AreaLineCoords(3) = 18.5304
AreaLineCoords(4) = 5.9139
AreaLineCoords(5) = 0
AreaLineCoords(6) = 18.5304
AreaLineCoords(7) = 9.2155
AreaLineCoords(8) = 0
AreaLineCoords(9) = 9.3196
AreaLineCoords(10) = 9.2155
AreaLineCoords(11) = 0

' Get the block reference for the "new" block
Dim cadBlock As Object
Set cadBlock = acadDoc.Blocks.Item("new")

' Create a new selection set
Dim blockSelSet As Object
On Error Resume Next
Set blockSelSet = acadDoc.SelectionSets("blockSelSet")
On Error GoTo 0

' If the selection set exists, clear it; otherwise, create a new selection set
If Not blockSelSet Is Nothing Then
blockSelSet.Clear
Else
Set blockSelSet = acadDoc.SelectionSets.Add("blockSelSet")
End If

' Select the block reference
blockSelSet.Select acSelectionSetAll, cadBlock

' Display the selected block name
MsgBox "Selected block: " & cadBlock.Name

' Select the text objects within the specified polygonal area in the block reference
blockSelSet.SelectByPolygon acSelectionSetCrossingPolygon, AreaLineCoords

' Display the count of selected objects
MsgBox "Number of selected objects: " & blockSelSet.Count

' Find the type of selected objects
Dim selectedType As String
If blockSelSet.Count > 0 Then
selectedType = TypeName(blockSelSet.Item(0))
Else
selectedType = "None"
End If

' Display the type of selected objects
MsgBox "Selected object type: " & selectedType

' Loop through the selected objects and delete the text objects
Dim obj As Object
For Each obj In blockSelSet
If TypeOf obj Is acadText Then
Dim textObj As acadText
Set textObj = obj
Debug.Print textObj.TextString
textObj.Delete
End If
Next obj

acadDoc.SetVariable "PICKSTYLE", 0

MsgBox "Done"
End Sub

[balaananthan_r]

Sub removetext()

Dim acadApp As Object
Dim acadDoc As Object
Set acadApp = GetObject(, "AutoCAD.Application")
Set acadDoc = acadApp.ActiveDocument

On Error GoTo 0

' Create AcadSelectionSet Object
Dim ssetObj As Object
Err.Clear
On Error Resume Next
Set ssetObj = acadDoc.SelectionSets("SS")
If Err Then
Set ssetObj = acadDoc.SelectionSets.Add("SS")
End If
On Error GoTo 0

ssetObj.Clear

ReDim AreaLineCoords(0 To 11) As Double
AreaLineCoords(0) = 9.3196
AreaLineCoords(1) = 5.9139
AreaLineCoords(2) = 0
AreaLineCoords(3) = 18.5304
AreaLineCoords(4) = 5.9139
AreaLineCoords(5) = 0
AreaLineCoords(6) = 18.5304
AreaLineCoords(7) = 9.2155
AreaLineCoords(8) = 0
AreaLineCoords(9) = 9.3196
AreaLineCoords(10) = 9.2155
AreaLineCoords(11) = 0

' Get the block reference for the "new" block
Dim cadBlock As Object
Set cadBlock = acadDoc.Blocks.Item("new")

' Create a new selection set
Dim blockSelSet As Object

On Error Resume Next
Set blockSelSet = acadDoc.SelectionSets("blockselset2")
On Error GoTo 0

''' If the selection set exists, clear it; otherwise, create a new selection set
If Not blockSelSet Is Nothing Then
blockSelSet.Clear
Else
Set blockSelSet = acadDoc.SelectionSets.Add("blockSelSet6")
End If

acadDoc.SendCommand "_-bedit" & vbCr & "new" & vbCrLf
'Select the block reference
blockSelSet.Select acSelectionSetAll, cadBlock

' Select the text objects within the specified polygonal area in the block reference
blockSelSet.SelectByPolygon acSelectionSetCrossingPolygon, AreaLineCoords

' Display the count of selected objects
'MsgBox "Number of selected objects: " & blockSelSet.Count

'blockSelSet.Erase

' Loop through the selected objects and delete the text objects
Dim obj As Object
For Each obj In blockSelSet
If TypeOf obj Is acadText Then
Dim textObj As acadText
Set textObj = obj
Debug.Print textObj.TextString
textObj.Delete
End If
Next obj

acadDoc.SendCommand "bclose" & vbCr & vbCrLf

MsgBox "Done"
End Sub

This works , but i need to manually choose the "save the changes in autocad" (Image attached) . Is there any other way to automate this  @norman.yuan 

[norman.yuan · Accepted solution]

You should have gotten some hints from your previous question about adding text (or whatever entity, for that matter) to an existing block definition (AcadBlock): the same as adding text to Model/PaperSpace, you simply call AcadBlock.AddText().

Deleting something from a block definition would be similar to deleting from Model/PaperSpace: you simply find it and delete.

So the code would be rather simple, something like:

Set cadBlock=acadDoc.Blocks("theBlock") '' along as you are sure a block definition with the name exists

Dim ent As AcadBlock

Dim txt As AcadText

For Each ent in cadBlock

  If TypeOf ent Is AcadText Then

    Set txt=ent

    '' You may want to only delete the AcadText with certain text string

    If UCase(txt.TextString)="TARGET TEXT VALUE" Then

      txt.Delete

    End If

  End If

Next

After the block definition is updated because of this deleting, and there are block references to this definition in drawing, you may want to regen the drawing, if the drawing is to remain open for user to continue working on.

[balaananthan_r]

Thank you @norman.yuan . I will try in this way. Is there is any option to make selection set inside the block by using selectbypolygon method .

As per my second post, is there a way in autocad  to close the prompt dialog boxes (save or discard the changes) using VBA code itself instead of manual selection. I tried sendkey method but its not working in autocad

[norman.yuan]

Sorry, I do not know a way to dismiss that dialog box, except for SendKey as possible approach. 

I'd think it is really bad practice to get into Block Editor for what your want to do, which is rather simple, as I showed in my reply.