Jump to content

Recommended Posts

Posted

Hello

 

I have pulled the following two routines off of the intent in an attempt to remove all the empty Text and Mtext strings in my drawings. The programs seem to work for Text but they do not work for MText. I am not sure why. I suspect the empty MText strings in my particular drawings possibly contain more than one space, but I’m not sure if that’s true or not. Can someone help me adjust one or both of these routines so that they will pick up and delete all empty MText strings no matter how many spaces they may contain? I would appreciate your help.

 

 

(I apologize for not giving credit to the original authors but I don’t have that information. I have had these programs in my chickenscratch files and do not know who wrote them)

 

 

 
Sub RemoveTextInPaperSpace()

Dim elem As Object
Dim found As Boolean

   For Each elem In ThisDrawing.PaperSpace
       ' With used so we don't have to reference our object by name
       With elem
           ' Check for EntityType by database name
           If (.EntityName = "AcDbText") Then
               If (.TextString = "") Or (.TextString = " ") Then
                   .Delete
                   found = True
               End If
           End If

       End With
   Next elem

   ' Clean up memory and release object
   Set elem = Nothing

   ' If we didn't find leaders, notify user
   If Not found Then
       MsgBox "No text found, or all have been removed", vbInformation
   End If

End Sub

- and

 

[font=Arial][color=#232323][color=#232323][font=Arial]Sub NewString()[/font][/color]
[font=Arial][color=#232323]Dim oEnt As AcadEntity[/color][/font]
[font=Arial][color=#232323]Dim oBlock As AcadBlock[/color][/font]
[font=Arial][color=#232323]For Each oBlock In ThisDrawing.Blocks[/color][/font]
[font=Arial][color=#232323]If Not oBlock.IsXRef Then[/color][/font]
[font=Arial][color=#232323]For Each oEnt In oBlock[/color][/font]
[font=Arial][color=#232323]If oEnt.ObjectName = "AcDbMtext" Or oEnt.ObjectName = "AcDbText" Then[/color][/font]
[font=Arial][color=#232323]If oEnt.TextString = "OldString" Then oEnt.TextString = "NewString"[/color][/font]
[font=Arial][color=#232323]End If[/color][/font]
[font=Arial][color=#232323]Next oEnt[/color][/font]
[font=Arial][color=#232323]End If[/color][/font]
[font=Arial][color=#232323]Next oBlock[/color][/font]
[font=Arial][color=#232323]End Sub[/color][/font]
[/color][/font]

 

Thank you for the help,

Mike

Posted

When checking I would use String.IsNullOrEmpty(tstString)

I think this will check for a double space.

Someone please correct me if I'm wrong.

Posted

Thanks for the input bsamc2000. I worked with your idea a bit but haven’t had any luck.

 

I’ve now adjusted the code in order to run some tests on the attached drawing. It appears to work well for the empty Text strings but I’m still having problems getting it to recognize and adjust the empty MText strings. If I can get it to recognize and adjust the MText then I can work on putting this into a loop and cleaning it up.

 

Can someone tell me why the code below won’t recognize empty MText strings?

 

 

 
Sub RemoveTextInModelSpace()

Dim elem As Object

Dim TheEmptyTextString1 As String
TheEmptyTextString1 = " "
Dim TheEmptyTextString2 As String
TheEmptyTextString2 = "  "
Dim TheEmptyTextString3 As String
TheEmptyTextString3 = "   "
Dim TheEmptyTextString4 As String
TheEmptyTextString4 = "    "
Dim TheEmptyTextString5 As String
TheEmptyTextString5 = "     "
Dim TheEmptyTextString6 As String
TheEmptyTextString6 = "      "
Dim TheEmptyTextString7 As String
TheEmptyTextString7 = "       "
Dim TheEmptyTextString8 As String
TheEmptyTextString8 = "        "
Dim TheEmptyTextString9 As String
TheEmptyTextString9 = "         "
Dim TheEmptyTextString10 As String
TheEmptyTextString10 = "          "

   For Each elem In ThisDrawing.ModelSpace
       With elem
           If (.EntityName = "AcDbText") Or (.EntityName = "AcDbMText") Then

                   If (.TextString = TheEmptyTextString1) Then
                   .TextString = "1"
                   elem.Update
                    '.Delete
                   ElseIf (.TextString = TheEmptyTextString2) Then
                   .TextString = "2"
                   elem.Update
                    '.Delete
                   ElseIf (.TextString = TheEmptyTextString3) Then
                   .TextString = "3"
                   elem.Update
                    '.Delete
                   ElseIf (.TextString = TheEmptyTextString4) Then
                   .TextString = "4"
                   elem.Update
                    '.Delete
                   ElseIf (.TextString = TheEmptyTextString5) Then
                   .TextString = "5"
                   elem.Update
                    '.Delete
                   ElseIf (.TextString = TheEmptyTextString6) Then
                   .TextString = "6"
                   elem.Update
                    '.Delete
                   ElseIf (.TextString = TheEmptyTextString7) Then
                   .TextString = "7"
                   elem.Update
                    '.Delete
                   ElseIf (.TextString = TheEmptyTextString8) Then
                   .TextString = "8"
                   elem.Update
                    '.Delete
                   ElseIf (.TextString = TheEmptyTextString9) Then
                   .TextString = "9"
                   elem.Update
                    '.Delete
                   ElseIf (.TextString = TheEmptyTextString10) Then
                   .TextString = "10"
                   elem.Update
                    '.Delete
                   End If
           End If
       End With
   Next elem

Set elem = Nothing
MsgBox "Complete"

End Sub

EmptyTextStringTestDrawing.dwg

Posted

This should work.

Sub RemoveTextInModelSpace()
Dim elem As Object

   For Each elem In ThisDrawing.ModelSpace

       With elem

           If (.EntityName = "AcDbText") Or (.EntityName = "AcDbMText") Then
               If Len(Trim(.TextString)) <= 0 Or Trim(.TextString) = "\pxqc;" Then
                   .TextString = "X"
                   .Update
               End If
           End If
       End With
   Next elem
Set elem = Nothing
MsgBox "Complete"
End Sub

Posted

That worked very nicely! Thank you! I'm still not sure why I couldn't get it to pick up the MText but I suppose thats irrelevant at this point since the code you supplied works for the desired task. Thank you very much. I appreciate your help!

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...