Extracting data from a table into vba

Extracting data from a table into vba

cve60069
Advocate Advocate
5,867 Views
4 Replies
Message 1 of 5

Extracting data from a table into vba

cve60069
Advocate
Advocate

Hello

 

I want to read the data from an existing table (table1) in modelspace into vba, do some code and then write the data back into another existing table (table2) in the same modelspace.  I have read the forums and am getting nowhere.

 

How do I declare the table in vba?

How do I access the table in vba?

How do I read the cell value?

How do I select another table and then write the data?

 

Many thanks

0 Likes
Accepted solutions (1)
5,868 Views
4 Replies
Replies (4)
Message 2 of 5

Alfred.NESWADBA
Consultant
Consultant

Hi,

 

welcome @Anonymous.autodesk.com!

 

Just as an idea, without any error handling (e.g. if destination table has less rows or columns than the source table, also the parameter "nContent" for "Table.GetValue" and "Table.SetValue" are currently unknown to me).

But with the attached sample drawing this code is working well, hope this is a good starter for you 😉

 

Public Sub transferTableValues()
   Dim tTable1 As AcadTable
   Dim tTable2 As AcadTable
   Dim tPickedPnt As Variant
   
   'select tables
   On Error Resume Next    'in case no object or wrong object type is selected
   Call ThisDrawing.Utility.GetEntity(tTable1, tPickedPnt, "Select Source-Table: ")
   If Err.Number = 0 Then
      Call ThisDrawing.Utility.GetEntity(tTable2, tPickedPnt, "Select Destination-Table: ")
   End If
   
   If Err.Number <> 0 Then
      Call MsgBox("Selection of Table(s) failed, function cancelled!")
   Else
      'well, two tables selected, verify that they are not the same ones
      If tTable1.Handle = tTable2.Handle Then
         Call MsgBox("Source- and Destination table are the same object, please select two different tables, function cancelled!")
      Else
         'let's start
         Dim tRow As Long
         Dim tCol As Long
         For tRow = 0 To tTable1.Rows - 1
            For tCol = 0 To tTable1.Columns - 1
               Dim tVal As Variant: tVal = tTable1.GetValue(tRow, tCol, 0)
               Call tTable2.SetValue(tRow, tCol, 0, tVal)
            Next
         Next
      End If
   End If
End Sub

 

- alfred -

------------------------------------------------------------------------------------
Alfred NESWADBA
ISH-Solutions GmbH / Ingenieur Studio HOLLAUS
www.ish-solutions.at ... blog.ish-solutions.at ... LinkedIn ... CDay 2026
------------------------------------------------------------------------------------

(not an Autodesk consultant)
Message 3 of 5

cve60069
Advocate
Advocate

Alfred

 

Thank you for the help.  I spent 6 hours working on the code and it was perfect.  I saved my drawing and closed AutoCAD.  I then opened this reply and went to copy my code to impress you, reopened AutoCAD and all my code has disappeared!  I am gutted.  Where did I go wrong.  How do I save my code, please?

 

Regards

 

Daniel

0 Likes
Message 4 of 5

Alfred.NESWADBA
Consultant
Consultant

Hi,

 

>> I saved my drawing and closed AutoCAD

>> eopened AutoCAD and all my code has disappeared!  I am gutted.  Where did I go wrong

When you close AutoCAD and you do have unsaved changed in VBA-editor then you will be asked if you want to save the VBA code.

 

>> How do I save my code, please?

In the VBA-editor you do  have the default save menu's

 

20170121_2157.png

 

- alfred -

------------------------------------------------------------------------------------
Alfred NESWADBA
ISH-Solutions GmbH / Ingenieur Studio HOLLAUS
www.ish-solutions.at ... blog.ish-solutions.at ... LinkedIn ... CDay 2026
------------------------------------------------------------------------------------

(not an Autodesk consultant)
0 Likes
Message 5 of 5

cve60069
Advocate
Advocate
Accepted solution

Alfred

 

I opened the VBA manager and found that the project was not embedded. Ticked that box and I have saved the module.

 

My code reads data from one table, does some math and writes to the second table and then plots a point.  Many thanks for the help.

 

Regards

 

The Code:

Option Explicit
Option Base 1

Sub GetData()

'Declare the Tables
    Dim inputTable As AcadTable
    Dim outputTable As AcadTable

'Define Tables
    Dim entity As Object
    Dim tTable As AcadTable
    For Each entity In ThisDrawing.ModelSpace
        If entity.EntityName = "AcDbTable" Then
            Set tTable = entity
            If tTable.GetCellValue(0, 0) = "Input" Then Set inputTable = entity
            If tTable.GetCellValue(0, 0) = "Output" Then Set outputTable = entity
        End If
    Next entity

'Define Input Variables
    Dim span() As Double
    Dim Load() As Double
    
'Declare number of loads and spans
    Dim nSpans, nLoads As Integer
        nSpans = 1
        nLoads = 1
        
'Set Arrays and Initials
    ReDim span(nSpans), Load(nLoads)
    Dim spanIndex, loadIndex As Integer
        spanIndex = 1
        loadIndex = 1
        
'Get Data
    With inputTable
        span(spanIndex) = .GetCellValue(1, 1)
        Load(loadIndex) = .GetCellValue(2, 1)
    End With
    
'CALCULATIONS
    'Declare Diagrams
        Const Loading = 1, SF = 2, BM = 3, Slope = 4, Deflection = 5
        
    'Declare Results
        Dim result(5) As Double
       
    'Bending Moment
        result(BM) = Load(loadIndex) * (span(spanIndex) / 1000) ^ 2 / 8
        
'RESULTS
    'Write to Output table
        With outputTable
            Call .SetValue(1, 1, 0, result(BM))
        End With

    'Declare Diagram Offsets
        Dim dOffset(5) As Integer
            dOffset(BM) = 1500

    'Write to Diagrams
        'Set Diagram Scales
            Dim dScale(5) As Integer
                dScale(BM) = 100
                
        'Set Coordinates
            Dim x, y(5) As Double
                x = span(spanIndex) / 2
                y(BM) = -1 * (result(BM) * dScale(BM) + dOffset(BM))
                
        'Plot Point
            Call DrawPoint(x, y(BM))
                

End Sub

Sub DrawPoint(x, y As Double, Optional z As Double = 0)

   Dim PointPosition(3) As Double
        
        PointPosition(1) = x
        PointPosition(2) = y
        PointPosition(3) = z

    With ThisDrawing.ModelSpace
        .AddPoint PointPosition
        .Item(.Count - 1).Update
    End With

End Sub