- UID
- 658062
- 积分
- 2147
- 精华
- 贡献
-
- 威望
-
- 活跃度
-
- D豆
-
- 在线时间
- 小时
- 注册时间
- 2008-10-22
- 最后登录
- 1970-1-1
|
马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。
您需要 登录 才可以下载或查看,没有账号?立即注册
×
<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 |
|