Copy text strings from AutoCAD into Excel

**grobnik** · 2011-06-27, 12:11 PM

Originally Posted by fixo

Ok it's clearly enough,
I will be free just tomorrow only
Can you wait for?
on the quick glance I see just that these
two objects are different:

MyExcel_F1 and MyExcel

Thank you,
See later
Cheers

Thank you for your support, I'll try to explain the difference between the two variable, MyExcel should be the Excel Object and MyExcel_F1 should be the Sheet1 sheet.
Yes I can wait whenever you will be available.
Thank you.

**fixo** · 2011-06-27, 03:05 PM

I've found from my old codes
Try this out for the start on your machine
Don't forget to add references and change
Excel file name inside the code
Tested .xls file is as simple plain table with 3 columns
of decimals (x,y,z coordinates)

Code:

Option Explicit

'Tools->Options-->General tab-->Error Trapping--> Break on Unhandled Errors

Public Sub TestAcadExcel()
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim xlRange As Excel.Range

Dim pt(0 To 2) As Double
Dim oCircle As AcadCircle

Dim lngRows As Long
Dim lngCols As Long

Dim x As Double
Dim y As Double
Dim z As Double



MsgBox "Be patience, works slowly"

On Error Resume Next

Err.Clear ' clear any errors
Set xlApp = GetObject(, "Excel.application")      ' See if Excel is running
If Err <> 0 Then   '                              ' If Excel not running start a new session
Err.Clear
Set xlApp = CreateObject("Excel.application")     ' Start Excel if excel is not running
If Err <> 0 Then
MsgBox " Could not start Excel ! , Is Excel Installed ? ", vbCritical, " Excel Error ! "
 Err.Clear
End If
End If
Err.Clear

On Error GoTo Err_Control

xlApp.DisplayAlerts = False
xlApp.Visible = True   ' Make Excel application visible
''xlApp.WindowState = xlMinimized  ' Minimize application window so we don't see it
xlApp.WindowState = xlMaximized
Set xlBook = xlApp.Workbooks.Open(FileName:="C:\UsedFiles\points.xls") '<-- change xlFileName here

' Make Autocad window maximum
Application.WindowState = acMax

Set xlSheet = xlBook.Worksheets(1)

xlSheet.Activate     ' make sheet 1 the active sheet

'
' get Excel data
'
Set xlRange = xlBook.ActiveSheet.UsedRange
lngRows = xlRange.Rows.Count
lngCols = xlRange.Columns.Count

Dim dataArr() As Variant

dataArr = xlRange.Value2

For lngRows = 2 To UBound(dataArr, 1)

x = dataArr(lngRows, 1)
y = dataArr(lngRows, 2)
z = dataArr(lngRows, 3)

'position  dummy circle

          pt(0) = x
          pt(1) = y
          pt(2) = z

Set oCircle = ThisDrawing.ModelSpace.AddCircle(pt, 2#)

Next

xlApp.DisplayAlerts = True

xlBook.Close Savechanges:=False
xlApp.Quit
' clean up
Set xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing

AppActivate Application.Caption, True

ZoomExtents
ThisDrawing.Regen acActiveViewport
MsgBox "Done"

Err_Control:
If Err.Number <> 0 Then
MsgBox Err.Description & vbCrLf & Err.Number
xlBook.Close Savechanges:=False
xlApp.Quit
' clean up
Set xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing

End If
End Sub

**grobnik** · 2011-06-27, 04:50 PM

Thank you I'll try your code !.

I'll keep you update

**fixo** · 2011-06-28, 09:35 AM

Can you upload the sample dtawing here
with explanation to see your problem a bit closely
I don't remember that acad table functionality was accessible
in 2005
Did you mean about plain table that was drawn manually
using separate lines and texts?
I'm confused with that part..

**grobnik** · 2011-06-29, 11:30 AM

Originally Posted by fixo

Can you upload the sample dtawing here
with explanation to see your problem a bit closely
I don't remember that acad table functionality was accessible
in 2005
Did you mean about plain table that was drawn manually
using separate lines and texts?
I'm confused with that part..

Thank you for your excellent support, I had no time to try you software, but, concerning the Autocad Table, what I mean is the creation of a table (exactly as a MSWord table, composed by row and columns).
The Table will be populated from the Excel File data contents.
The Autocad 2005 version it's little poor from the interaction of the table object with excel instead newer versions (2009 or 2011) which has a direct connection with the excel file.
However my application required Autocad 2005.
For copyright reason I cannot post the dwg file.

Thank you again for your support.

**fixo** · 2011-06-29, 12:00 PM

Show me just a screenshot of this table

then upload this picture as .jpeg or .tiff here

**fixo** · 2011-06-29, 09:11 PM

I've found one from my old codes,that
will populate table with dummy data
Probably it will work with your Acad release
I can't test it on my machine, sorry
Hope this will helps for you

Code:

Option Explicit

Sub DummyTable()

    Dim minp As Variant
    Dim maxp As Variant
    Dim pt(2) As Double
    Dim acTable As AcadTable
     Dim pickPt As Variant
    
    pickPt = ThisDrawing.Utility.GetPoint(, vbLf & "Enter a table inserion point: ")
    pt(0) = pickPt(0): pt(1) = pickPt(1): pt(2) = 0#
    Set acTable = ThisDrawing.ActiveLayout.Block.AddTable(pt, 10, 4, 10, 60)

    With acTable
        .RegenerateTableSuppressed = True
        .RecomputeTableBlock False
        .TitleSuppressed = False
        .HeaderSuppressed = False
        .SetTextStyle AcRowType.acTitleRow, "Standard"    '<-- change text style name here
        .SetTextStyle AcRowType.acHeaderRow, "Standard"
        .SetTextStyle AcRowType.acDataRow, "Standard"
        Dim i As Double, j As Double
        Dim col As New AcadAcCmColor
        col.SetRGB 255, 0, 255

        'title
        .SetCellTextHeight i, j, 6.4
        .SetCellAlignment i, j, acMiddleCenter
        col.SetRGB 194, 212, 235
        .SetCellBackgroundColor i, j, col
        col.SetRGB 127, 0, 0
        .SetCellContentColor i, j, col
        .SetCellType i, j, acTextCell
        .SetText 0, 0, "Table Title"

        i = i + 1

        'headers
        For j = 0 To .Columns - 1
            col.SetRGB 203, 220, 183
            .SetCellBackgroundColor i, j, col
            col.SetRGB 0, 0, 255
            .SetCellContentColor i, j, col
            .SetCellTextHeight i, j, 5.2
            .SetCellAlignment i, j, acMiddleCenter
            .SetCellType i, j, acTextCell
            .SetText i, j, "Header" & CStr(j + 1)
        Next

        'data rows
        For i = 2 To .Rows - 1
            For j = 0 To .Columns - 1

                .SetCellTextHeight i, j, 4.5
                .SetCellAlignment i, j, acMiddleCenter
                If i Mod 2 = 0 Then
                col.SetRGB 239, 235, 195
                Else
                col.SetRGB 227, 227, 227
                End If
                .SetCellBackgroundColor i, j, col
                col.SetRGB 0, 76, 0
                .SetCellContentColor i, j, col
                .SetCellType i, j, acTextCell
                .SetText i, j, "Row" & CStr(i - 1) & " Column" & CStr(j + 1)

            Next j
        Next i

        ' set color for grid
        col.SetRGB 0, 127, 255
        .SetGridColor AcGridLineType.acHorzBottom, AcRowType.acTitleRow, col
        .SetGridColor AcGridLineType.acHorzInside, AcRowType.acTitleRow, col
        .SetGridColor AcGridLineType.acHorzTop, AcRowType.acTitleRow, col
        .SetGridColor AcGridLineType.acVertInside, AcRowType.acTitleRow, col
        .SetGridColor AcGridLineType.acVertLeft, AcRowType.acTitleRow, col
        .SetGridColor AcGridLineType.acVertRight, AcRowType.acTitleRow, col

        .SetGridColor AcGridLineType.acHorzBottom, AcRowType.acHeaderRow, col
        .SetGridColor AcGridLineType.acHorzInside, AcRowType.acHeaderRow, col
        .SetGridColor AcGridLineType.acHorzTop, AcRowType.acHeaderRow, col
        .SetGridColor AcGridLineType.acVertInside, AcRowType.acHeaderRow, col
        .SetGridColor AcGridLineType.acVertLeft, AcRowType.acHeaderRow, col
        .SetGridColor AcGridLineType.acVertRight, AcRowType.acHeaderRow, col

        .SetGridColor AcGridLineType.acHorzBottom, AcRowType.acDataRow, col
        .SetGridColor AcGridLineType.acHorzInside, AcRowType.acDataRow, col
        .SetGridColor AcGridLineType.acHorzTop, AcRowType.acDataRow, col
        .SetGridColor AcGridLineType.acVertInside, AcRowType.acDataRow, col
        .SetGridColor AcGridLineType.acVertLeft, AcRowType.acDataRow, col
        .SetGridColor AcGridLineType.acVertRight, AcRowType.acDataRow, col

        'set line weights for grid
        .SetGridLineWeight AcGridLineType.acVertLeft, AcRowType.acTitleRow, AcLineWeight.acLnWt040
        .SetGridLineWeight AcGridLineType.acVertRight, AcRowType.acTitleRow, AcLineWeight.acLnWt040
        .SetGridLineWeight AcGridLineType.acHorzTop, AcRowType.acTitleRow, AcLineWeight.acLnWt040
        .SetGridLineWeight AcGridLineType.acHorzBottom, AcRowType.acHeaderRow, AcLineWeight.acLnWt040
        .SetGridLineWeight AcGridLineType.acHorzInside, AcRowType.acHeaderRow, AcLineWeight.acLnWt040
        .SetGridLineWeight AcGridLineType.acHorzTop, AcRowType.acHeaderRow, AcLineWeight.acLnWt040
        .SetGridLineWeight AcGridLineType.acVertInside, AcRowType.acHeaderRow, AcLineWeight.acLnWt040
        .SetGridLineWeight AcGridLineType.acVertLeft, AcRowType.acHeaderRow, AcLineWeight.acLnWt040
        .SetGridLineWeight AcGridLineType.acVertRight, AcRowType.acHeaderRow, AcLineWeight.acLnWt040
        .SetGridLineWeight AcGridLineType.acHorzBottom, AcRowType.acDataRow, AcLineWeight.acLnWt040
        .SetGridLineWeight AcGridLineType.acHorzInside, AcRowType.acDataRow, AcLineWeight.acLnWt040
        .SetGridLineWeight AcGridLineType.acHorzTop, AcRowType.acDataRow, AcLineWeight.acLnWt040
        .SetGridLineWeight AcGridLineType.acVertInside, AcRowType.acDataRow, AcLineWeight.acLnWt040
        .SetGridLineWeight AcGridLineType.acVertLeft, AcRowType.acDataRow, AcLineWeight.acLnWt040
        .SetGridLineWeight AcGridLineType.acVertRight, AcRowType.acDataRow, AcLineWeight.acLnWt040
        
        .RegenerateTableSuppressed = False
        .RecomputeTableBlock True
        .Update

        .GetBoundingBox minp, maxp
        ZoomWindow minp, maxp
        ZoomScaled 0.9, acZoomScaledRelative
        ThisDrawing.SetVariable "LWDISPLAY", 1
        Set col = Nothing
        
    End With

    MsgBox "Done"

End Sub

**grobnik** · 2011-06-30, 06:19 AM

Originally Posted by fixo

I've found one from my old codes,that
will populate table with dummy data
Probably it will work with your Acad release
I can't test it on my machine, sorry
Hope this will helps for you

Code:

Option Explicit

Sub DummyTable()

    Dim minp As Variant
    Dim maxp As Variant
    Dim pt(2) As Double
    Dim acTable As AcadTable
     Dim pickPt As Variant
    
    pickPt = ThisDrawing.Utility.GetPoint(, vbLf & "Enter a table inserion point: ")
    pt(0) = pickPt(0): pt(1) = pickPt(1): pt(2) = 0#
    Set acTable = ThisDrawing.ActiveLayout.Block.AddTable(pt, 10, 4, 10, 60)

    With acTable
        .RegenerateTableSuppressed = True
        .RecomputeTableBlock False
        .TitleSuppressed = False
        .HeaderSuppressed = False
        .SetTextStyle AcRowType.acTitleRow, "Standard"    '<-- change text style name here
        .SetTextStyle AcRowType.acHeaderRow, "Standard"
        .SetTextStyle AcRowType.acDataRow, "Standard"
        Dim i As Double, j As Double
        Dim col As New AcadAcCmColor
        col.SetRGB 255, 0, 255

        'title
        .SetCellTextHeight i, j, 6.4
        .SetCellAlignment i, j, acMiddleCenter
        col.SetRGB 194, 212, 235
        .SetCellBackgroundColor i, j, col
        col.SetRGB 127, 0, 0
        .SetCellContentColor i, j, col
        .SetCellType i, j, acTextCell
        .SetText 0, 0, "Table Title"

        i = i + 1

        'headers
        For j = 0 To .Columns - 1
            col.SetRGB 203, 220, 183
            .SetCellBackgroundColor i, j, col
            col.SetRGB 0, 0, 255
            .SetCellContentColor i, j, col
            .SetCellTextHeight i, j, 5.2
            .SetCellAlignment i, j, acMiddleCenter
            .SetCellType i, j, acTextCell
            .SetText i, j, "Header" & CStr(j + 1)
        Next

        'data rows
        For i = 2 To .Rows - 1
            For j = 0 To .Columns - 1

                .SetCellTextHeight i, j, 4.5
                .SetCellAlignment i, j, acMiddleCenter
                If i Mod 2 = 0 Then
                col.SetRGB 239, 235, 195
                Else
                col.SetRGB 227, 227, 227
                End If
                .SetCellBackgroundColor i, j, col
                col.SetRGB 0, 76, 0
                .SetCellContentColor i, j, col
                .SetCellType i, j, acTextCell
                .SetText i, j, "Row" & CStr(i - 1) & " Column" & CStr(j + 1)

            Next j
        Next i

        ' set color for grid
        col.SetRGB 0, 127, 255
        .SetGridColor AcGridLineType.acHorzBottom, AcRowType.acTitleRow, col
        .SetGridColor AcGridLineType.acHorzInside, AcRowType.acTitleRow, col
        .SetGridColor AcGridLineType.acHorzTop, AcRowType.acTitleRow, col
        .SetGridColor AcGridLineType.acVertInside, AcRowType.acTitleRow, col
        .SetGridColor AcGridLineType.acVertLeft, AcRowType.acTitleRow, col
        .SetGridColor AcGridLineType.acVertRight, AcRowType.acTitleRow, col

        .SetGridColor AcGridLineType.acHorzBottom, AcRowType.acHeaderRow, col
        .SetGridColor AcGridLineType.acHorzInside, AcRowType.acHeaderRow, col
        .SetGridColor AcGridLineType.acHorzTop, AcRowType.acHeaderRow, col
        .SetGridColor AcGridLineType.acVertInside, AcRowType.acHeaderRow, col
        .SetGridColor AcGridLineType.acVertLeft, AcRowType.acHeaderRow, col
        .SetGridColor AcGridLineType.acVertRight, AcRowType.acHeaderRow, col

        .SetGridColor AcGridLineType.acHorzBottom, AcRowType.acDataRow, col
        .SetGridColor AcGridLineType.acHorzInside, AcRowType.acDataRow, col
        .SetGridColor AcGridLineType.acHorzTop, AcRowType.acDataRow, col
        .SetGridColor AcGridLineType.acVertInside, AcRowType.acDataRow, col
        .SetGridColor AcGridLineType.acVertLeft, AcRowType.acDataRow, col
        .SetGridColor AcGridLineType.acVertRight, AcRowType.acDataRow, col

        'set line weights for grid
        .SetGridLineWeight AcGridLineType.acVertLeft, AcRowType.acTitleRow, AcLineWeight.acLnWt040
        .SetGridLineWeight AcGridLineType.acVertRight, AcRowType.acTitleRow, AcLineWeight.acLnWt040
        .SetGridLineWeight AcGridLineType.acHorzTop, AcRowType.acTitleRow, AcLineWeight.acLnWt040
        .SetGridLineWeight AcGridLineType.acHorzBottom, AcRowType.acHeaderRow, AcLineWeight.acLnWt040
        .SetGridLineWeight AcGridLineType.acHorzInside, AcRowType.acHeaderRow, AcLineWeight.acLnWt040
        .SetGridLineWeight AcGridLineType.acHorzTop, AcRowType.acHeaderRow, AcLineWeight.acLnWt040
        .SetGridLineWeight AcGridLineType.acVertInside, AcRowType.acHeaderRow, AcLineWeight.acLnWt040
        .SetGridLineWeight AcGridLineType.acVertLeft, AcRowType.acHeaderRow, AcLineWeight.acLnWt040
        .SetGridLineWeight AcGridLineType.acVertRight, AcRowType.acHeaderRow, AcLineWeight.acLnWt040
        .SetGridLineWeight AcGridLineType.acHorzBottom, AcRowType.acDataRow, AcLineWeight.acLnWt040
        .SetGridLineWeight AcGridLineType.acHorzInside, AcRowType.acDataRow, AcLineWeight.acLnWt040
        .SetGridLineWeight AcGridLineType.acHorzTop, AcRowType.acDataRow, AcLineWeight.acLnWt040
        .SetGridLineWeight AcGridLineType.acVertInside, AcRowType.acDataRow, AcLineWeight.acLnWt040
        .SetGridLineWeight AcGridLineType.acVertLeft, AcRowType.acDataRow, AcLineWeight.acLnWt040
        .SetGridLineWeight AcGridLineType.acVertRight, AcRowType.acDataRow, AcLineWeight.acLnWt040
        
        .RegenerateTableSuppressed = False
        .RecomputeTableBlock True
        .Update

        .GetBoundingBox minp, maxp
        ZoomWindow minp, maxp
        ZoomScaled 0.9, acZoomScaledRelative
        ThisDrawing.SetVariable "LWDISPLAY", 1
        Set col = Nothing
        
    End With

    MsgBox "Done"

End Sub

Thank you very much, I'll try.

**grobnik** · 2011-07-04, 02:30 PM

@fixo,
Hi Fixo, I tried both your code and are working well, for my necessity.

Thank you very much for your support.

Regards

**fixo** · 2011-07-04, 09:37 PM

Glad to help
Cheers

Thread: Copy text strings from AutoCAD into Excel

Thread Tools

Display

Re: Copy text strings from AutoCAD into Excel

Re: Copy text strings from AutoCAD into Excel

Re: Copy text strings from AutoCAD into Excel

Re: Copy text strings from AutoCAD into Excel

Re: Copy text strings from AutoCAD into Excel

Re: Copy text strings from AutoCAD into Excel

Re: Copy text strings from AutoCAD into Excel

Re: Copy text strings from AutoCAD into Excel

Re: Copy text strings from AutoCAD into Excel

Re: Copy text strings from AutoCAD into Excel

Similar Threads

Macro to copy data from Autocad to Excel

Entering text from excel into autocad

2015: IS IT POSSIBLE TO COPY TEXT FROM AUTOCAD INTO AN EXCEL SHEET ???

text strings on schedules?

Strange formatting when Copy Paste Special Excel into AutoCAD

Posting Permissions