Author Topic: Insert block in the current table  (Read 3463 times)

0 Members and 1 Guest are viewing this topic.

Offline fixo

  • Full Member
  • ***
  • Posts: 135
  • Karma: +4/-0
  • Gender: Male
    • prefered language: C
    • Prog expertise: Good
    • View Profile
Insert block in the current table
« on: June 28, 2012, 07:53:24 PM »
Code: [Select]
       <CommandMethod("BlockToTable", "btin", CommandFlags.Modal)> _
        Public Shared Sub TestBlockToTable()

            Dim ver As String = Autodesk.AutoCAD.ApplicationServices.Application.GetSystemVariable("acadver").ToString().Substring(0, 2)

            Dim intver As Integer = Convert.ToInt32(ver)

            Dim doc As Document = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument

            Dim db As Database = doc.Database

            Dim ed As Editor = doc.Editor

            Dim how As Boolean = False

                Using tr As Transaction = db.TransactionManager.StartTransaction

                    Dim pso As PromptSelectionOptions = New PromptSelectionOptions

                    pso.MessageForRemoval = vbLf + "You have select the table only"

                    pso.MessageForAdding = vbLf + " Select the table: "

                    Dim entres As PromptSelectionResult

                    Dim sset As SelectionSet

                    Dim filt(0) As TypedValue

                    filt(0) = New TypedValue(DxfCode.Start, "ACAD_TABLE")

                    Dim selfilter As New SelectionFilter(filt)

                    entres = ed.GetSelection(pso, selfilter)

                    sset = entres.Value

                    If entres.Status <> PromptStatus.OK Then

                        ed.WriteMessage(vbLf + "Wrong selection!")


                    End If

                    Dim tblid As ObjectId = entres.Value.GetObjectIds(0)

                    Dim obj As Entity = tr.GetObject(tblid, OpenMode.ForRead)

                    Dim atable As Table = TryCast(obj, Table)

                    Dim pio As PromptPointOptions = New PromptPointOptions(vbLf + "Pick a cell to insert block: ")

                    Dim pres As PromptPointResult = ed.GetPoint(pio)

                    If pres.Status <> PromptStatus.OK Then

                        ed.WriteMessage(vbLf + "Invalid point specification!")


                    End If

                    Dim pt As Point3d = pres.Value

                    Dim peo As PromptEntityOptions = New PromptEntityOptions(vbLf + "Select the single block: ")

                    Dim res As PromptEntityResult = ed.GetEntity(peo)

                    If res.Status <> PromptStatus.OK Then

                        ed.WriteMessage(vbLf + "Wrong selection!")


                    End If

                    Dim id As ObjectId = res.ObjectId

                    Dim ent As Entity = TryCast(tr.GetObject(id, OpenMode.ForRead), Entity)

                    If ent Is Nothing Then

                        ed.WriteMessage(vbLf + "Wrong object type selected!")


                    End If

                    Dim bref As BlockReference = TryCast(ent, BlockReference)

                    If bref Is Nothing Then

                        ed.WriteMessage(vbLf + "Impossible to cast BlockReference from entity!")


                    End If

                    Dim btrec As BlockTableRecord = DirectCast(tr.GetObject(bref.BlockTableRecord, OpenMode.ForRead), BlockTableRecord)

                    Dim blkid As ObjectId = btrec.ObjectId

                    Dim hit As TableHitTestInfo = atable.HitTest(pt, Vector3d.ZAxis)

                    Dim i As Integer = hit.Row

                    Dim j As Integer = hit.Column

                    If Not atable.IsWriteEnabled Then atable.UpgradeOpen()
                    '' select appropriate syntax from code block below
                    If intver = 17 Then

                        atable.SetBlockTableRecordId(i, j, blkid, True)

                    End If

                    'If intver = 18 Then

                    '    Dim c As Cell = atable.Cells(i, j)
                    '    c.Contents.Add()
                    '  c.Contents.InsertAt(0);
                    '  c.Contents(0).BlockTableRecordId =  blockId;

                    '    Autodesk.AutoCAD.ApplicationServices.Application.ShowAlertDialog("Change a syntax accordingly to the current version")

                    'End If


                    how = True


                End Using

            Catch ex As Autodesk.AutoCAD.Runtime.Exception

                ed.WriteMessage(ex.Message + vbLf + ex.StackTrace)

                how = False

            Catch ex As System.Exception

                ed.WriteMessage(ex.Message + vbLf + ex.StackTrace)

                how = False


                Dim result As String = "   ---   The program has ended up with " + IIf(how, "success", "bug").ToString

                ed.WriteMessage(vbLf + result)

            End Try

        End Sub