找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

查看: 1180|回复: 0

[分享] Insert block in the current table

[复制链接]

已领礼包: 859个

财富等级: 财运亨通

发表于 2014-6-7 03:16:00 | 显示全部楼层 |阅读模式

马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。

您需要 登录 才可以下载或查看,没有账号?立即注册

×
       <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

            Try
                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!")

                        Return

                    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!")

                        Return

                    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!")

                        Return

                    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!")

                        Return

                    End If

                    Dim bref As BlockReference = TryCast(ent, BlockReference)

                    If bref Is Nothing Then

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

                        Return

                    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;

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

                    'End If

                    atable.RecomputeTableBlock(True)

                    how = True

                    tr.Commit()

                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

            Finally

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

                ed.WriteMessage(vbLf + result)

            End Try

        End Sub
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

QQ|申请友链|Archiver|手机版|小黑屋|辽公网安备|晓东CAD家园 ( 辽ICP备15016793号 )

GMT+8, 2024-11-17 22:27 , Processed in 0.229687 second(s), 27 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

快速回复 返回顶部 返回列表