Searching All Specific Text in TextObject and assign to a Layer CAD VBA

[Anonymous]

I have around 5000 textObject in CAD 2013. I create 200 Layers through VBA code. I know a lot about Excel VBA but i'm new in CAD VBA. My problem is, searching specific text in CAD Model and assign to named layer. Something Like

Dim i as Integer

Dim strToFind as String

strToFind =Column1

For i=1 to textObject.Count 'textObject.Count total number of textObject in CAD

  If textObject(i)=strToFind Then 'textObject are text object to search in CAD

  textObject(i).Layer=ColumnLayer 'ColumnLayer is named layer in CAD

  Endif

Next

[norman.yuan · Accepted solution]

In AutoCAD, there are 2 types of entities (AcadText and AcadMText) that would the "TextObject" you are referring to, if we do not count attributes in a block reference.

To find all the text-objects (AcadText and/or AcadMText), you can either use AcadSelectionSet with filter to select them, or you can simply loop through Model/PaperSpace to find them. For xample, assuming you are interested in all text-objects in ModelSpace, you can do this:

Dim ent As AcadEntity

Dim txt As AcadText

Dim mtxt As AcadMText

Dim textValue As String

For Each ent in ThisDrawing.ModelSpace

     textValue=""

    If TypeOf ent Is AcadText Then

        Set txt=ent

        textValue=txt.TextString

    Else If TypeOf ent Is AcadMText Then

        Set mtxt=ent

        textValue=mtext.TextString

    End if

    If textValue<>"" Then

        Select Case UCase(textValue)

             Case "XXXX"

                 ent.Layer="Layer1" ''' You may want to make sure the layer does exist before you can assign it to an entity

             Case "YYYY"

                  ent.Layer="Layer2"

        End Select

    End If

Next