Topic: Excel VBA - creating table in Autocad - Error 91 - help?

[Yosso]

Application Parameters:
Autocad 2013, 64 bit
Excel  2010, 32 bit

Error:

Run-time error '91': Object variable or With block variable not set

Background:
I have a routine (based on code obtained  from around the web (most of it from Fixo)) that opens ACAD from Excel  and copies the worksheets values into a  table in the newly created AutoCAD drawing.

Keep getting error code 91 when I attempted to create a table.   The table is created but the program drops out to the error handler.  The error handler is swapped out to resume next and the program continues but doesn't update the table values.

I am going to try to create a table style before creating the table, but for now I'm reaching out for some assistance from somebody who actually knows what they're doing. 

I know that Dot.Net would be the optimum solution, but the VSTO has a very steep learning curve for a guy doing this on the side, i.e. for work but not during working hours.

Excel VBA Code:

Code: [Select]

' Sub to create drawing with submittal text

Sub ACADtxt(DataSheet As Worksheet) '

Dim RowCount As Integer, iCount As Integer

Dim tmpStr1 As String, tmpStr2 As String
Dim FileName As String

Dim acad As AcadApplication
Dim adoc As AcadDocument
Dim aspace As AcadBlock
Dim Alayer As AcadLayer
Dim entArray() As AcadEntity
Dim ListTable As acadTable
'Dim insPt(2) As Double
Dim insPt As Variant

On Error GoTo ErrorHandler

Dim appNum As String
appNum = acadVerNum

' See if ACAD is on the computer
If appNum = "" Then
    MsgBox "Sorry, but AutoCAD does not appear to be on this computer.", vbExclamation
    Exit Sub
End If

' Start ACAD
Set acad = CreateObject("Autocad.Application." & appNum)
Set adoc = acad.ActiveDocument
Set aspace = adoc.ActiveLayout.Block
acad.Visible = True

' Create layers Text1 and Text2
Call MakeSetLayer("Text1", 11)
Call MakeSetLayer("Text2", 12)

' Now load the marked cells with the appropriate drawing # and title
DataSheet.Activate

' See how many rows we need to check
With ActiveSheet
        RowCount = .Range("A" & .Rows.Count).End(xlUp).row
End With

insPt = adoc.Utility.GetPoint(, vbCrLf & "Pick the upper left point of table:")

' Create the table
ListTable = adoc.ModelSpace.AddTable(insPt, RowCount, 2, 3.5, 20#) ' <-------This is where it all goes wrong...

ListTable.RecomputeTableBlock False  ' Hold off creating the actual table

' Supress the title and headers row
ListTable.TitleSuppressed = True         ' No title row
ListTable.HeaderSuppressed = True   ' No header row
ListTable.Setgridvisiblity = False    ' No grid lines

' Copy Excel values to the Acad table
For iCount = 0 To RowCount - 1
    tmpStr1 = CStr(ActiveSheet.Cells(iCount + 1, 1).Value)
    tmpStr2 = CStr(ActiveSheet.Cells(iCount + 1, 2).Value)
   
    ListTable.SetText iCount, 0, tmpStr1
    ListTable.SetText iCount, 1, tmpStr2
    'ListTable.SetAlignment iCount, 0, acMiddleCenter
    'ListTable.SetAlignment iCount, 1, acMiddleCenter
 
Next iCount

ListTable.RecomputeTableBlock True

ErrorHandler:
    Stop
    If Err.Number <> 0 Then
        'MsgBox Err.Description
        Stop
    End If

End Sub
Corrected my mistake...

Revised...

Code: [Select]

ListTable = adoc.ModelSpace.AddTable(insPt, RowCount, 2, 3.5, 20#) ' <-------This is where it all goes wrong...
 - to -

Code: [Select]

Set ListTable = adoc.ModelSpace.AddTable(insPt, RowCount, 2, 3.5, 20#) ' <-------This is where it all goes wrong...
Now I'm trying to cipher how to set the tablestyle.

There are no code examples in the VBA help file.

object.StyleName

Object

Table
The object this property applies to.

StyleName

String; read-write
The name of the table style.

I have created an TableStyle named "DwgList", here's my code snippet (borrowed from Fixo).

Code: [Select]

'grab the tablestyle dictionary object
     Set oDict = adoc.Database.Dictionaries.Item("acad_tablestyle")
     sKeyName = "Block Table"
     sClassName = "AcDbTableStyle"
     'create the TableStyle object in the dictionary
     Set oTblSty = oDict.AddObject(sKeyName, sClassName)
     With oTblSty
          .Name = "DwgList"
          .Description = "Drawing Number and Description"
          .HorzCellMargin = 0.03
          .TitleSuppressed = True
          .HeaderSuppressed = False
          .SetTextHeight 3, 0.93625
         
          .SetGridVisibility 3, 3, False
          .SetAlignment 3, acMiddleCenter
          'aColor.SetRGB 244, 0, 0
     End With
Set the Stylename to "DwgList"

Code: [Select]

Set ListTable.StyleName = "DwgList"
Which gives a compile error, Invalid use of property.

I'm getting closer... 

[Yosso]

Just in case anyone has a similar problem/question, here is the working (in progress) VBA code that I finally ended up using.

Code: [Select]

' Sub to create drawing with submittal text

Sub ACADtxt(DataSheet As Worksheet) '

Dim RowCount As Long
Dim iCount As Integer
Dim txtHgt As Double
Dim tmpStrLen1 As Long, tmpStrLen2 As Long

Dim tmpStr1 As String, tmpStr2 As String
Dim ContFlag As String, FROFlag As String

Dim acad As AcadApplication
Dim adoc As AcadDocument
Dim aspace As AcadBlock
Dim Alayer As AcadLayer
Dim entArray() As AcadEntity
Dim ListTable As acadTable

Dim insPt(0 To 2) As Double
'Dim insPt As Variant

' creates a TableStyle object
Dim oDict As AcadDictionary
Dim aColor As New AcadAcCmColor
Dim oTblSty As AcadTableStyle
Dim sKeyName As String
Dim sClassName As String
     
'On Error Resume Next
On Error GoTo ErrorHandler

Dim appNum As String
appNum = acadVerNum

' See if ACAD is on the computer
If appNum = "" Then
    MsgBox "Sorry, but AutoCAD does not appear to exist on this computer.", vbExclamation
    Exit Sub
End If

' Color notes http://forums.autodesk.com/t5/Visual-Basic-Customization/Changing-background-color-in-table-cells/td-p/3367317

' Start ACAD
Set acad = CreateObject("Autocad.Application." & appNum)
Set adoc = acad.ActiveDocument
Set aspace = adoc.ActiveLayout.Block
Set aColor = acad.GetInterfaceObject("Autocad.AcCmColor.19")

' Color table http://www.isctex.com/acadcolors.php
aColor.ColorMethod = acColorMethodByACI

' Not visible when not debugging.
'acad.Visible = True

' Create the simplex text style
Dim txtStyle As AcadTextStyle
Set txtStyle = adoc.TextStyles.Add("simplex")
txtStyle.SetFont "simplex", False, False, 0, 0
'txtStyle.BigFontFile = "fraction" ' keep getting error code 91

' Set the text height - future add to the user form
txtHgt = 0.14

'grab the tablestyle dictionary object
     Set oDict = adoc.Database.Dictionaries.Item("acad_tablestyle")
     sKeyName = "Block Table"
     sClassName = "AcDbTableStyle"
     'create the TableStyle object in the dictionary
     Set oTblSty = oDict.AddObject(sKeyName, sClassName)
     With oTblSty
          .Name = "DwgList"
          .Description = "Drawing Number and Description"
          .HorzCellMargin = 0.15 * txtHgt
          .VertCellMargin = 0.15 * txtHgt
          .TitleSuppressed = True
          .HeaderSuppressed = True
          .SetTextHeight 3, txtHgt
          .SetGridVisibility 63, AcRowType.acDataRow, False
          .SetAlignment 3, acMiddleLeft
          .SetTextStyle AcRowType.acDataRow, "simplex"
        'aColor.ColorIndex 10
     End With

' Create layers Text1 and Text2
Call MakeSetLayer("Text1", 11)
Call MakeSetLayer("Text2", 12)

' See how many rows we need to check
DataSheet.Activate ' Activate the datasheet
With ActiveSheet
        RowCount = .Range("A" & .Rows.Count).End(xlUp).row
End With

' Set the table insertion point as 0,0,0
insPt(0) = 0#
insPt(1) = 0#
insPt(2) = 0#

' Turned off when not debugging.
'insPt = adoc.Utility.GetPoint(, vbCrLf & "Pick the upper left point of table:")

' Create the table
Set ListTable = aspace.AddTable(insPt, RowCount, 2, 0.25, 1.5)

ListTable.StyleName = "DwgList"

ListTable.RegenerateTableSuppressed = True ' Hold off creating the actual table

' Supress the title and headers row
ListTable.TitleSuppressed = True         ' No title row
ListTable.HeaderSuppressed = True   ' No header row

' Copy Excel values to the Acad table

' First column = Drawing Number
' Second column = Drawing Title
' Third column = Contract Flag
' Fourth Column = FRO flag

For iCount = 0 To RowCount - 1
    tmpStr1 = CStr(ActiveSheet.Cells(iCount + 1, 1).Value)
    ' Do we add the "*" or not ?
    If FROFlag = "Y" Then
        tmpStr1 = "*" + tmpStr1
        Else
        tmpStr1 = " " + tmpStr1
    End If
    tmpStrLen1 = MaxVal(Len(tmpStr1), tmpStrLen1)

    tmpStr2 = " " + CStr(ActiveSheet.Cells(iCount + 1, 2).Value) ' Add additional buffer character
    tmpStrLen2 = MaxVal(Len(tmpStr2), tmpStrLen2)
   
    ContFlag = ActiveSheet.Cells(iCount + 1, 3).Value
    FROFlag = ActiveSheet.Cells(iCount + 1, 4).Value
   
    ' Change the color of the cell contents
    ' based on the ContFlag
    If ContFlag = "Y" Then
        aColor.SetRGB 255, 0, 0 ' ACIIndex = 10
    Else ' Not included
        aColor.SetRGB 0, 0, 0 ' ACIIndex = 0
    End If
    ' Set the row height
    ListTable.RowHeight = 1.5 * txtHgt ' ((0.25 * txtHgt) * 2) + txtHgt
    ' Load the cells
    ListTable.SetText iCount, 0, tmpStr1
    ListTable.SetText iCount, 1, tmpStr2
    ' Set the content color
    ListTable.SetCellContentColor iCount, 0, aColor
    ListTable.SetCellContentColor iCount, 1, aColor
    ' Set the alignment
    ListTable.SetCellAlignment iCount, 0, acMiddleLeft
    ListTable.SetCellAlignment iCount, 1, acMiddleLeft
   
Next iCount

ListTable.UnmergeCells 0, 0, 0, 1 ' Unmerge the first row

' Set the table column widths based on the maximum string length
ListTable.SetColumnWidth 0, (txtHgt * tmpStrLen1) + (2 * (0.6 * txtHgt))    ' First column
ListTable.SetColumnWidth 1, (txtHgt * tmpStrLen2) + (2 * (0.6 * txtHgt))    ' Second column

ListTable.RegenerateTableSuppressed = False
ListTable.Update

' Maximize the AutoCAD window
'adoc.WindowState = acMax
'acad.Application.ZoomExtents

' Save newly created AutoCAD file
' Source of Public Class Code for the File Dialogs:
' http://forums.autodesk.com/t5/Visual-Basic-Customization/VBA-Open-File-with-Dialog-Box/td-p/1726554/page/2

Dim FilePath As String
Dim FileName  As String
Dim objFile As FileDialogs
Dim strFilter As String
Dim strFileName As String

FileName = frmTransmittalData.txtLOTtitle.Value
FilePath = Application.ActiveWorkbook.Path

Set objFile = New FileDialogs
strFilter = "All Files (*.*)|*.*|Drawings (*.dwg)|*.dwg"
objFile.Title = "Save the drawing"
objFile.StartInDir = FilePath
objFile.Filter = strFilter
strFileName = objFile.ShowSave

' Hide the user form
Unload frmTransmittalData

If Not strFileName = vbNullString Then
    acad.ActiveDocument.SaveAs strFileName
    MsgBox "File saved at :" & vbCrLf & strFileName, vbExclamation
End If

' Need to check if file name already exists?

' Close the AutoCAD session...
acad.Application.Quit ' file was just saved...

' Exit sub
Exit Sub

ErrorHandler:
    If Err.Number <> 0 Then
        MsgBox Err.Description
        Stop
    End If

End Sub