Creating a table of block attributes in AutoCAD


Creating a table of block attributes in AutoCAD using .NET

程序代码:

Imports System
Imports System.Collections.Specialized
Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.Geometry
Imports Autodesk.AutoCAD.EditorInput
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.ApplicationServices

Namespace TableCreation
    Public Class Commands
        ' Set up some formatting constants
        ' for the table

        Const colWidth As Double = 1500
        Const rowHeight As Double = 300
        Const textHeight As Double = 100
        Const cellAlign As CellAlignment = CellAlignment.MiddleCenter

        ' Helper function to set text height
        ' and alignment of specific cells,
        ' as well as inserting the text

        Public Shared Sub SetCellText(ByVal tb As Autodesk.AutoCAD.DatabaseServices.Table, ByVal row As Long, ByVal col As Long, ByVal value As String)
            tb.Cells(row, col).Alignment = cellAlign
            tb.Cells(row, col).TextHeight = textHeight
            tb.Cells(row, col).TextString = value
            'tb.SetAlignment(row, col, cellAlign)
            'tb.SetTextHeight(row, col, textHeight)
            'tb.SetTextString(row, col, value)
        End Sub

        <CommandMethod("BAT")> _
        Public Shared Sub BlockAttributeTable()
            Dim doc As Document = Application.DocumentManager.MdiActiveDocument
            Dim db As Database = doc.Database
            Dim ed As Editor = doc.Editor

            ' Ask for the name of the block to find

            Dim opt As New PromptStringOptions(vbLf & "Enter name of block to list: ")
            Dim pr As PromptResult = ed.GetString(opt)

            If pr.Status = PromptStatus.OK Then
                Dim blockToFind As String = pr.StringResult.ToUpper()
                Dim embed As Boolean = False

                ' Ask whether to embed or link the data

                Dim pko As New PromptKeywordOptions(vbLf & "Embed or link the attribute values: ")

                pko.AllowNone = True
                pko.Keywords.Add("Embed")
                pko.Keywords.Add("Link")
                pko.Keywords.[Default] = "Embed"
                Dim pkr As PromptResult = ed.GetKeywords(pko)

                If pkr.Status = PromptStatus.None OrElse pkr.Status = PromptStatus.OK Then
                    If pkr.Status = PromptStatus.None OrElse pkr.StringResult = "Embed" Then
                        embed = True
                    Else
                        embed = False
                    End If
                End If

                Dim tr As Transaction = doc.TransactionManager.StartTransaction()
                Using tr
                    ' Let's check the block exists

                    Dim bt As BlockTable = CType(tr.GetObject(doc.Database.BlockTableId, OpenMode.ForRead), BlockTable)

                    If Not bt.Has(blockToFind) Then
                        ed.WriteMessage(vbLf & "Block " + blockToFind + " does not exist.")
                    Else
                        ' And go through looking for
                        ' attribute definitions

                        Dim colNames As New StringCollection()

                        Dim bd As BlockTableRecord = CType(tr.GetObject(bt(blockToFind), OpenMode.ForRead), BlockTableRecord)
                        For Each adId As ObjectId In bd
                            Dim adObj As DBObject = tr.GetObject(adId, OpenMode.ForRead)

                            ' For each attribute definition we find...

                            Dim ad As AttributeDefinition = TryCast(adObj, AttributeDefinition)
                            If ad IsNot Nothing Then
                                ' ... we add its name to the list

                                colNames.Add(ad.Tag)
                            End If
                        Next
                        If colNames.Count = 0 Then
                            ed.WriteMessage(vbLf & "The block " + blockToFind + " contains no attribute definitions.")
                        Else
                            ' Ask the user for the insertion point
                            ' and then create the table

                            Dim ppr As PromptPointResult = ed.GetPoint(vbLf & "Enter table insertion point: ")

                            If ppr.Status = PromptStatus.OK Then
                                Dim tb As New Table()
                                tb.TableStyle = db.Tablestyle
                                'tb.NumRows = 1
                                'tb.NumColumns = colNames.Count
                                tb.SetSize(1, colNames.Count)
                                tb.SetRowHeight(rowHeight)
                                tb.SetColumnWidth(colWidth)
                                tb.Position = ppr.Value

                                ' Let's add our column headings

                                Dim i As Integer = 0
                                While i < colNames.Count
                                    SetCellText(tb, 0, i, colNames(i))
                                    i += 1
                                End While

                                ' Now let's search for instances of
                                ' our block in the modelspace

                                Dim ms As BlockTableRecord = CType(tr.GetObject(bt(BlockTableRecord.ModelSpace), OpenMode.ForRead), BlockTableRecord)

                                Dim rowNum As Integer = 1
                                For Each objId As ObjectId In ms
                                    Dim obj As DBObject = tr.GetObject(objId, OpenMode.ForRead)
                                    Dim br As BlockReference = TryCast(obj, BlockReference)
                                    If br IsNot Nothing Then
                                        Dim btr As BlockTableRecord = CType(tr.GetObject(br.BlockTableRecord, OpenMode.ForRead), BlockTableRecord)
                                        Using btr
                                            If btr.Name.ToUpper() = blockToFind Then
                                                ' We have found one of our blocks,
                                                ' so add a row for it in the table

                                                tb.InsertRows(rowNum, rowHeight, 1)

                                                ' Assume that the attribute refs
                                                ' follow the same order as the
                                                ' attribute defs in the block

                                                Dim attNum As Integer = 0
                                                For Each arId As ObjectId In br.AttributeCollection
                                                    Dim arObj As DBObject = tr.GetObject(arId, OpenMode.ForRead)
                                                    Dim ar As AttributeReference = TryCast(arObj, AttributeReference)
                                                    If ar IsNot Nothing Then
                                                        ' Embed or link the values

                                                        Dim strCell As String
                                                        If embed Then
                                                            strCell = ar.TextString
                                                        Else
                                                            Dim strArId As String = arId.ToString()
                                                            strArId = strArId.Trim(New Char() {"("c, ")"c})
                                                            strCell = "%<\AcObjProp Object(" + "%<\_ObjId " + strArId + ">%).TextString>%"
                                                        End If
                                                        SetCellText(tb, rowNum, attNum, strCell)
                                                    End If
                                                    attNum += 1
                                                Next
                                                rowNum += 1
                                            End If
                                        End Using
                                    End If
                                Next
                                tb.GenerateLayout()

                                ms.UpgradeOpen()
                                ms.AppendEntity(tb)
                                tr.AddNewlyCreatedDBObject(tb, True)
                                tr.Commit()
                            End If
                        End If
                    End If
                End Using
            End If
        End Sub
    End Class
End Namespace




深度开源



欢迎关注微信公众账号ByCAD