AutoCAD开发3--修改文字图层，颜色

Dim pText As AcadText

    Dim pColor1 As AcadAcCmColor

    Set pColor1 = Application.GetInterfaceObject("AutoCAD.AcCmColor.16")

    Call pColor1.SetRGB(0, 0, 255)

 

   

    Dim pColor2 As AcadAcCmColor

    Set pColor2 = Application.GetInterfaceObject("AutoCAD.AcCmColor.16")

    Call pColor2.SetRGB(127, 0, 0)

   

    Dim pColor3 As AcadAcCmColor

    Set pColor3 = Application.GetInterfaceObject("AutoCAD.AcCmColor.16")

    Call pColor3.SetRGB(255, 191, 0)

   

    Dim pSlct As AcadSelectionSet

    Set pSlct = CreateSelectionSet

   

    Dim gpCode(0) As Integer

    Dim dataValue(0) As Variant

    gpCode(0) = 0

    dataValue(0) = "Text"

   

    Dim groupCode As Variant, dataCode As Variant

    groupCode = gpCode

    dataCode = dataValue

 

    pSlct.SelectOnScreen gpCode, dataValue

   

    Dim sStr As String

   

    For Each pText In pSlct

    

        If Mid(pText.TextString, 1, 1) = "S" And HasTrim(pText.TextString) Then

            pText.Layer = "图层2"

            pText.TrueColor = pColor1

           

        ElseIf Mid(pText.TextString, 1, 1) = "X" And HasTrim(pText.TextString) Then

            pText.Layer = "图层2"

            pText.TrueColor = pColor2

           

        ElseIf Mid(pText.TextString, 1, 1) = "R" And Mid(pText.TextString, 2, 1) <> "Q" And HasTrim(pText.TextString) Then

            pText.Layer = "图层2"

            pText.TrueColor = pColor3

           

        End If

    Next pText

   

    pSlct.Delete