VB .NET Select Existing Table and Read Data

[Anonymous]

I'm trying to convert my existing VBA application to .NET.  The VBA app prompted the user for the selection of the table (a two column table), would read the data, and input it as custom sheetset properties.  I've struggled through the learning curve of importing, running, etc. in the .NET world, but I'm stuck.  The error is somewhere between the reading of the table and passing that information into the sub to insert it into the sheetset manager.  I'm using Win 64bit and Autocad 2013.  Any advice is appreciated.  Code:

Imports ACSMCOMPONENTS19Lib
Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.Geometry
Imports Autodesk.AutoCAD
Imports Autodesk.AutoCAD.EditorInput

Public Class SSManagerProp

    Public ReadOnly Property ThisDrawing As AutoCAD.AcadDocument
        Get
            Return Autodesk.AutoCAD.ApplicationServices.DocumentExtension.GetAcadDocument(Autodesk.AutoCAD.ApplicationServices.Core.Application.DocumentManager.MdiActiveDocument)
        End Get
    End Property

    <CommandMethod("TestApp")>
    Public Sub SelectTable()

        'On Error GoTo MyError
        Dim tblObj As AutoCAD.IAcadTable
        Dim tblPt As Object

        Dim sheetsetCount As Integer
        Dim iterDb As IAcSmEnumDatabase
        Dim ItemDb As IAcSmPersist

        sheetSetMgr = New AcSmSheetSetMgr

        iterDb = sheetSetMgr.GetDatabaseEnumerator
        ItemDb = iterDb.Next
        sheetsetCount = 0
        Do While Not ItemDb Is Nothing

            sheetsetCount = sheetsetCount + 1
            ItemDb = iterDb.Next
        Loop

        If sheetsetCount > 1 Then
            MsgBox("There are multiple Sheet Sets Open." & Chr(10) & "You must close all other Sheet Sets.")
            Exit Sub

        ElseIf sheetsetCount = 0 Then
            MsgBox("There is no open Sheet Set." & Chr(10) & "Data was NOT updated.")
            Exit Sub
        End If

        With ThisDrawing.Utility
            .GetEntity(tblObj, tblPt, vbCrLf & "Select table: ")

        End With


        Dim vec0(0 To 2) As Double
        vec0(0) = 0.0# : vec0(1) = 0.0# : vec0(2) = 1.0#
        Dim gotRow As Long, gotCol As Long
        If tblObj.HitTest(tblPt, vec0, gotRow, gotCol) Then

            Dim RowCount As Integer
            RowCount = 0

            Dim SSData(200, 200) As String

            Dim Count As Integer
            Count = 0
            Do While tblObj.GetCellValue(Count, 0) <> ""
                SSData(Count, 0) = tblObj.GetCellValue(Count, 0)
                SSData(Count, 1) = tblObj.GetCellValue(Count, 1)
                Count = Count + 1

            Loop
        End If

        SetSheetSetCustomProp(SSData)
        MsgBox("Successful")
        Exit Sub
MyError:
        MsgBox("You did not select a table.  Try again.")
    End Sub


    Dim sheetSetMgr As IAcSmSheetSetMgr
    Dim sheetdb As IAcSmDatabase


    Private Sub SetSheetSetCustomProp(CustomName As Object)
        Dim sheetCount As Integer
        Dim iterDb As IAcSmEnumDatabase
        Dim ItemDb As IAcSmPersist

        sheetSetMgr = New AcSmSheetSetMgr

        iterDb = sheetSetMgr.GetDatabaseEnumerator
        ItemDb = iterDb.Next

        sheetdb = ItemDb

        '' Lock Database
        LockDatabase()


        Dim i As Integer
        i = 0

        Do While i < 201
            On Error Resume Next

            Dim sheet As IAcSmSheet
            Dim iter As IAcSmEnumPersist
            Dim Item As IAcSmPersist

            iter = sheetdb.GetEnumerator
            Item = iter.Next

            Dim cBag As IAcSmCustomPropertyBag
            Dim cBagVal As New AcSmCustomPropertyValue

            cBag = sheetdb.GetSheetSet().GetCustomPropertyBag

            cBagVal.InitNew(cBag)

            cBagVal.SetFlags(CUSTOM_SHEETSET_PROP)
            cBagVal.SetValue(CustomName(i, 1))

            cBag.SetProperty(CustomName(i, 0), cBagVal)


            cBagVal = Nothing

            i = i + 1
        Loop
        '' Unlock the database
        UnlockDatabase()

    End Sub


    '' Used to Lock the database
    Private Sub LockDatabase()
        On Error Resume Next

        Dim lockStatus As AcSmLockStatus
        lockStatus = sheetdb.GetLockStatus

        If lockStatus = AcSmLockStatus.AcSmLockStatus_UnLocked Then
            sheetdb.LockDb(sheetdb)
        End If
    End Sub

    '' Used to Unlock the database
    Private Sub UnlockDatabase()
        On Error Resume Next

        Dim lockStatus As AcSmLockStatus
        If lockStatus = AcSmLockStatus.AcSmLockStatus_Locked_Local Or AcSmLockStatus.AcSmLockStatus_Locked_Remote Then
            sheetdb.UnlockDb(sheetdb)
        End If
    End Sub

    Sub OpenSheetSets()

    End Sub

    Private Function CUSTOM_SHEETSET_PROP() As Object
        Throw New NotImplementedException
    End Function

    Private Function SSData() As Object
        Throw New NotImplementedException
    End Function

End Class

[Anonymous]

Ok, so I've made some progress.  My problem was in my array declaration/initialization.  I know there are better data structures than arrays, but this is such a simple routine I don't want to learn more than I have to to convert this from VBA 🙂

I now seem to have a different problem.  My program will write the data (I think) to the sheetset.  It's very ungraceful (right now it opens and closes the sheetset database for each value - takes a lot of time).  But I have a weird problem.  When I hover over the sheetset and get the pop-up preview, I see the custom values (image attached).  But when I right-click on the sheetset and edit the custom properties, there are none.  Any ideas about this?

Any help is appreciated.

[Balaji_Ram]

Hi,

In the sample code that you shared, I dont get the two subs called "CUSTOM_SHEETSET_PROP" and "ssdata" ? What are those methods for ?

Here is a test code mostly based on what you had posted that works ok and it adds a few custom properties to the sheetset. Maybe this helps you spot the actual error in your code.

        Public ReadOnly Property ThisDrawing() As AcadDocument
            Get
                Dim doc As Document = Application.DocumentManager.MdiActiveDocument
                Dim acadDoc As AcadDocument = TryCast(doc.AcadDocument, AcadDocument)
                Return acadDoc
            End Get
        End Property

        <CommandMethod("TestApp")> _
        Public Sub SelectTable()

            'On Error GoTo MyError
            Dim tblObj As AcadTable
            Dim tblPt As Object

            Dim sheetsetCount As Integer
            Dim iterDb As IAcSmEnumDatabase
            Dim ItemDb As IAcSmPersist

            sheetSetMgr = New AcSmSheetSetMgr

            iterDb = sheetSetMgr.GetDatabaseEnumerator
            ItemDb = iterDb.Next
            sheetsetCount = 0
            Do While Not ItemDb Is Nothing
                sheetsetCount = sheetsetCount + 1
                ItemDb = iterDb.Next
            Loop

            If sheetsetCount > 1 Then
                MsgBox("There are multiple Sheet Sets Open." & Chr(10) & "You must close all other Sheet Sets.")
                Exit Sub

            ElseIf sheetsetCount = 0 Then
                MsgBox("There is no open Sheet Set." & Chr(10) & "Data was NOT updated.")
                Exit Sub
            End If

            With ThisDrawing.Utility
                .GetEntity(tblObj, tblPt, vbCrLf & "Select table: ")
            End With

            SetSheetSetCustomProp()
            MsgBox("Successful")
            Exit Sub
MyError:
            MsgBox("You did not select a table.  Try again.")
        End Sub


        Dim sheetSetMgr As IAcSmSheetSetMgr
        Dim sheetdb As IAcSmDatabase


        Private Sub SetSheetSetCustomProp()
            Dim sheetCount As Integer
            Dim iterDb As IAcSmEnumDatabase
            Dim ItemDb As IAcSmPersist

            sheetSetMgr = New AcSmSheetSetMgr

            iterDb = sheetSetMgr.GetDatabaseEnumerator

            ItemDb = iterDb.Next

            sheetdb = ItemDb

            '' Lock Database
            LockDatabase()

            Dim i As Integer
            i = 0

            Do While i < 5
                On Error Resume Next

                Dim sheet As IAcSmSheet
                Dim iter As IAcSmEnumPersist
                Dim Item As IAcSmPersist

                iter = sheetdb.GetEnumerator
                Item = iter.Next

                Dim cBag As IAcSmCustomPropertyBag
                Dim cBagVal As New AcSmCustomPropertyValue

                cBag = sheetdb.GetSheetSet().GetCustomPropertyBag

                cBagVal.InitNew(cBag)

                cBagVal.SetFlags(PropertyFlags.CUSTOM_SHEETSET_PROP)
                cBagVal.SetValue("Test" + i.ToString())

                cBag.SetProperty("Test" + i.ToString(), cBagVal)


                cBagVal = Nothing

                i = i + 1
            Loop
            '' Unlock the database
            UnlockDatabase()

        End Sub


        '' Used to Lock the database
        Private Sub LockDatabase()
            On Error Resume Next

            Dim lockStatus As AcSmLockStatus
            lockStatus = sheetdb.GetLockStatus

            If lockStatus = AcSmLockStatus.AcSmLockStatus_UnLocked Then
                sheetdb.LockDb(sheetdb)
            End If
        End Sub

        '' Used to Unlock the database
        Private Sub UnlockDatabase()
            On Error Resume Next

            Dim lockStatus As AcSmLockStatus
            If lockStatus = AcSmLockStatus.AcSmLockStatus_Locked_Local Or AcSmLockStatus.AcSmLockStatus_Locked_Remote Then
                sheetdb.UnlockDb(sheetdb)
            End If
        End Sub

 This code inserts a few test values as custom properties and does not use the value from the table. But it should be straight forward to change that to use the values from the table.

Also the way you handle the array is a bit messy and it would help if you use a "System.Collections.Specialized.StringCollection" instead of the array.