Тема: Как создать таблицу?

Использую VB.Net
В help приведен пример создания таблицы:
Sub Example_AddTable()
    ' This example adds a table in model space
    Dim MyModelSpace As IAcadModelSpace2
    Set MyModelSpace = ThisDrawing.ModelSpace
    Dim pt(2) As Double
    Dim MyTable As AcadTable
    Set MyTable = MyModelSpace.Addtable(pt, 5, 5, 10, 30)
    ZoomExtents
End Sub
Но при попытки использования данной функции компилятор говорит, что ее нет. Класс AcadTable существует, а функции нет!

Re: Как создать таблицу?

потому что это пример не для VB.NET, а дял VBА
на VB.NET все по-другому:

    Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
        Dim acad As New AcadApplication
        acad.Application.Visible = True
        Dim t As AcadTable
        Dim pt(2) As Double
        t = acad.ActiveDocument.ModelSpace.AddTable(pt, 5, 5, 10, 30)
        t.InsertColumns(1, 100, 5)
    End Sub

Re: Как создать таблицу?

> detox
Если тебе действительно нужно для VB.NET
можешь попробовать
Создай Эксель файл с таблицей в 3 столбца
без заголовка
В Автокаде будет создана таблица такого
же вида

Imports System
Imports Microsoft.Office.Interop
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.EditorInput
Imports Autodesk.AutoCAD.Geometry
Imports Autodesk.AutoCAD.Colors
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.GraphicsInterface
Imports Autodesk.AutoCAD.Internal
Imports Autodesk.AutoCAD.ApplicationServices.Application
Imports Autodesk.AutoCAD.Runtime.Interop
Imports AcadRT = Autodesk.AutoCAD.Runtime
Imports AcadED = Autodesk.AutoCAD.EditorInput
Imports AcadDB = Autodesk.AutoCAD.DatabaseServices
Imports AcadApp = Autodesk.AutoCAD.ApplicationServices.Application
Public Class AcadTableUtilities
    <CommandMethod("ITA", CommandFlags.Modal Or CommandFlags.Session)> _
    Public Sub addTable()
        Dim adoc As Document = AcadApp.DocumentManager.MdiActiveDocument
        Dim ed As Editor = adoc.Editor
        Dim lock As DocumentLock = adoc.LockDocument()
        Dim dbase As Database = HostApplicationServices.WorkingDatabase
        Using trans As Transaction = dbase.TransactionManager.StartTransaction()
            Try
                Dim Path As String = "C:\MyVBA\Layers.xls" '// изменить на свое
                Dim arr(,) As String = ReadExcel(Path)
                Dim nmRows As Int32 = UBound(arr, 1) + 3
                Dim nmColumns As Int32 = UBound(arr, 2) + 1
                Dim position As Point3d = New Point3d(2.0, 2.0, 0.0)
                Dim rowHeight As Double = 0.2
                Dim blkTbl As BlockTable = CType(trans.GetObject(dbase.BlockTableId, OpenMode.ForRead),
BlockTable)
                Dim blkTblRec As BlockTableRecord = CType(trans.GetObject(blkTbl(BlockTableRecord.ModelSpace),
OpenMode.ForWrite), BlockTableRecord)
                Dim styDef As ObjectId = makeTableStyle()
                Dim myTable As Table = New Table()
                myTable.IsHeaderSuppressed = False
                myTable.IsTitleSuppressed = False
                myTable.NumColumns = nmColumns
                myTable.NumRows = nmRows
                myTable.Height = nmRows * rowHeight
                myTable.Position = position
                myTable.TableStyle = styDef
                blkTblRec.AppendEntity(myTable)
                trans.AddNewlyCreatedDBObject(myTable, True)
                myTable.RecomputeTableBlock(False)
                myTable.GenerateLayout()
                myTable.SetTextString(0, 0, "Title goes here") '// изменить на свое
                Dim trg As TableRegion = New TableRegion(0, 0, 0, CInt(UBound(arr, 2)))
                myTable.MergeCells(trg)
                Dim hdl(2) As String
                hdl(0) = "Layer" '// изменить на свое
                hdl(1) = "LineType" '// изменить на свое
                hdl(2) = "Color" '// изменить на свое
                For i As Int32 = 0 To UBound(arr, 1)
                    For j As Int32 = 0 To UBound(arr, 2)
                        Dim s As String
                        s = arr(i, j)
                        myTable.SetValue(i + 2, j, s, ParseOption.SetDefaultFormat)
                    Next
                Next
                myTable.SetColumnWidth(0, 2)
                myTable.SetColumnWidth(1, 3)
                myTable.SetColumnWidth(2, 1.5)
                myTable.SetTextHeight(0.2, 2) 'title row
                myTable.SetTextHeight(0.15, 4) 'header row
                myTable.SetTextHeight(0.1, 1) 'data row
                myTable.RecomputeTableBlock(True)
                ed.Regen()
                myTable.Dispose()
                blkTbl.Dispose()
                blkTblRec.Dispose()
            Catch ex As System.Exception
                MsgBox(ex.StackTrace)
            End Try
            trans.Commit()
            trans.Dispose()
        End Using
    End Sub
    Private Function makeTableStyle() As ObjectId
        Dim styDef As ObjectId = ObjectId.Null
        Dim color1 As Color = Color.FromColorIndex(ColorMethod.ByAci, 1)
        Dim color2 As Color = Color.FromColorIndex(ColorMethod.ByAci, 2)
        Dim color3 As Color = Color.FromColorIndex(ColorMethod.ByAci, 3)
        Dim dbase As Database = HostApplicationServices.WorkingDatabase
        Dim trans As Transaction = dbase.TransactionManager.StartTransaction()
        Dim listStyle As TableStyle = New TableStyle()
        Dim tblStyle As DBDictionary = CType(trans.GetObject(dbase.TableStyleDictionaryId, OpenMode.ForRead,
False), DBDictionary)
        Try
            listStyle = CType(trans.GetObject(tblStyle.GetAt("LayerData"), OpenMode.ForRead), TableStyle) '// изменить
на свое
        Catch
            tblStyle.UpgradeOpen()
            styDef = tblStyle.SetAt("LayerData", listStyle) '// изменить на свое
            listStyle.Name = "Layer list" '// изменить на свое
            listStyle.Description = "Table style for layer list" '// изменить на свое
            listStyle.IsHeaderSuppressed = False
            listStyle.IsTitleSuppressed = False
            listStyle.SetGridLineWeight(LineWeight.LineWeight100, 1, 2)
            listStyle.SetGridLineWeight(LineWeight.LineWeight100, 1, 1)
            listStyle.SetGridLineWeight(LineWeight.LineWeight100, 8, 1)
            listStyle.SetGridLineWeight(LineWeight.LineWeight100, 4, 1)
            listStyle.SetTextHeight(0.2, 2) 'title row
            listStyle.SetTextHeight(0.15, 4) 'header row
            listStyle.SetTextHeight(0.1, 1) 'data row
            listStyle.SetAlignment(CellAlignment.MiddleCenter, 2) 'title row
            listStyle.SetAlignment(CellAlignment.MiddleCenter, 4) 'header row
            listStyle.SetAlignment(CellAlignment.MiddleCenter, 1) 'data row
            listStyle.SetColor(color1, 2) 'title row
            listStyle.SetColor(color2, 4) 'header row
            listStyle.SetColor(color3, 1) 'data row
            trans.AddNewlyCreatedDBObject(listStyle, True)
        End Try
        trans.Commit()
        Return styDef
    End Function
    Friend Function ReadExcel(ByVal Path As String) As String(,)
        Dim app As Excel.ApplicationClass = New Excel.ApplicationClass
        Dim workBook As Excel.Workbook = app.Workbooks.Open(Path, 0, True, 5, "", "", True,
Excel.XlPlatform.xlWindows, "" & Microsoft.VisualBasic.Chr(9) & "", False, False, 0, True, 1, 0)
        Dim workSheet As Excel.Worksheet = CType(workBook.Worksheets(1), Excel.Worksheet)
        Dim SheetRange As Excel.Range = CType(workSheet.UsedRange, Excel.Range)
        Dim rowIndex As Long = SheetRange.Rows.Count
        Dim colIndex As Long = SheetRange.Columns.Count
        Dim valArray(0 To rowIndex - 1, 0 To colIndex - 1) As String
        Dim itm As String
        Try
            For i As Long = 1 To rowIndex
                For j As Long = 1 To colIndex
                    Dim val As String = CType(SheetRange.Cells(i, j), Excel.Range).Value.ToString
                    If Not val Is Nothing Then
                        itm = val
                    Else
                        itm = "Empty"
                    End If
                    valArray(i - 1, j - 1) = itm
                Next
            Next
        Catch ex As Autodesk.AutoCAD.Runtime.Exception
            app.Quit()
        End Try
        Return valArray
    End Function
End Class

~'J'~