Identify RBG color of selected Text entities

[Anonymous]

Hi,

I am trying to select text entities in Autocad using VBA and store the text string and RBG color values in Excel. But i get only Zero's stored for all the 3 R B G colors. I am not sure what mistake i am making. I also tried extracting color of entity, still does not work. Program is as below.

Can any one help me out.

Option Explicit
' Requires:
' Microsoft Excel Object Library
' go to Tools->Options->General Tab and check 'Break on Unhandled Errors'

Const xlFileName As String = "D:\API\AUTOCAD-VBA\TestFile.xlsx" '<--change existing file name here

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
Public Sub ExportText()

Dim oSset As AcadSelectionSet
Dim oEnt As AcadEntity
Dim oText As AcadText
Dim i As Long

Dim ftype(0) As Integer
Dim fdata(0) As Variant
ftype(0) = 0: fdata(0) = "TEXT"

Dim dxftype As Variant
Dim dxfdata As Variant

dxftype = ftype
dxfdata = fdata
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
Dim xlApp As Object
Dim xlBook As Workbook
Dim xlSheet As Worksheet
Dim lngRow As Long, lngCol As Long
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
Dim color As AcadAcCmColor

On Error Resume Next
Set xlApp = GetObject(, "Excel.Application")
If Err <> 0 Then
Err.Clear
Set xlApp = CreateObject("Excel.Application")
If Err <> 0 Then
MsgBox "Impossible to run Excel.", vbExclamation
End
End If
End If
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
On Error GoTo Err_Control

With ThisDrawing.SelectionSets
While .Count > 0
.Item(0).Delete
Wend
Set oSset = .Add("$Texts$")
End With
oSset.SelectOnScreen dxftype, dxfdata
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
xlApp.Visible = True
Set xlBook = xlApp.Workbooks.Open(xlFileName)
Set xlSheet = xlBook.Sheets(1)
xlApp.ScreenUpdating = False
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
lngRow = 1: lngCol = 1
For Each oEnt In oSset
Set oText = oEnt
Set color = oText.TrueColor
xlSheet.Cells(lngRow, lngCol).Value = oText.TextString
xlSheet.Cells(lngRow, lngCol + 1).Value = oText.TrueColor.Red
xlSheet.Cells(lngRow, lngCol + 2).Value = oText.TrueColor.Green
xlSheet.Cells(lngRow, lngCol + 3).Value = oText.TrueColor.Blue
lngRow = lngRow + 1

Next oEnt
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
xlSheet.Columns.HorizontalAlignment = xlHAlignLeft
xlSheet.Columns.AutoFit

xlApp.ScreenUpdating = True

xlBook.Save
xlBook.Close
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
xlApp.Application.Quit
Set xlApp = Nothing
Set xlBook = Nothing
Set xlSheet = Nothing
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
MsgBox "Done"
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
Err_Control:
If Err.Number <> 0 Then
MsgBox Err.Description
End If

End Sub

[Alfred.NESWADBA · Accepted solution]

Hi,

can you show your drawing? Just to make sure your text-objects really have a RGB value assigened (and not something like "byLayer"?

- alfred -

PS: welcome @Anonymous.autodesk.com! ... after 13 years registration and now the first post 😉

[Anonymous]

Thank you so much Alfred,

you were right, my entities color were in bylayer.

But how do i find if the entity has its own color(RBG) or a Bylayer color.

True, my first post after 13 years, was a very lean user of Autocad, now i need to learn more about Autocad and VBA customization to realise my Idea.

[Alfred.NESWADBA]

Hi,

But how do i find if the entity has its own color(RBG) or a Bylayer color.

You can verify it by:

   MTextObj.TrueColor.ColorIndex

If that value is 256 then it's ByLayer

But be careful with MTEXT objects: it might have assigned any color, but within the MTEXT every single letter might have it's own color-override. That can be seen in the MTEXT.TextString property like shown here:

HTH, - alfred -

[Anonymous]

Thank u so much Alfred