VB
Imports System.Collections.Generic
Imports System.ComponentModel
Imports System.Drawing
Imports System.Data
Imports System.Linq
Imports System.Text
Imports System.Windows.Forms
Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.Geometry
Imports Autodesk.AutoCAD.EditorInput
Imports Autodesk.AutoCAD.ApplicationServices.Application
Imports Autodesk.AutoCAD.Interop.Common
Imports System.Runtime.InteropServices
Public Class BasicBlockMangerPalette
Private viewGroups As Boolean = False
Private Shared dwgFileName As String = Nothing
Private Sub FillListView()
Me.lvBlocks.Items.Clear()
Dim doc As Document = DocumentManager.MdiActiveDocument
Dim db As Database = doc.Database
Using trx As Transaction = db.TransactionManager.StartTransaction()
Dim bt As BlockTable = TryCast(db.BlockTableId.GetObject(OpenMode.ForRead), BlockTable)
For Each objID As ObjectId In bt
Dim btr As BlockTableRecord = TryCast(objID.GetObject(OpenMode.ForRead), BlockTableRecord)
If Not (btr.IsLayout) Then
Dim blkName As String = btr.Name
Dim blkThumbnail As Bitmap = TryCast(btr.PreviewIcon, Bitmap)
If blkThumbnail Is Nothing Then
Dim cbi As New CreateBlockIcon(blkName)
blkThumbnail = TryCast(btr.PreviewIcon, Bitmap)
cbi = Nothing
End If
If blkThumbnail Is Nothing Then
AddListViewItem(blkName)
Else
AddBlockImageToList(blkName, blkThumbnail)
AddListViewItem(blkName, True)
End If
End If
Next
' End foreach
trx.Commit()
End Using
' End trx
End Sub
' End FillListView
Private Sub FillListView(ByVal fileName As String)
Me.lvBlocks.Items.Clear()
Dim db As Database = TryCast(New Database(False, True), Database)
db.ReadDwgFile(fileName, FileOpenMode.OpenForReadAndAllShare, True, Nothing)
Using trx As Transaction = db.TransactionManager.StartTransaction()
Dim bt As BlockTable = (db.BlockTableId.GetObject(OpenMode.ForRead))
For Each objID As ObjectId In bt
Dim btr As BlockTableRecord = TryCast(objID.GetObject(OpenMode.ForRead), BlockTableRecord)
If Not (btr.IsLayout) Then
Dim blkName As String = btr.Name
Dim blkThumbnail As Bitmap = TryCast(btr.PreviewIcon, Bitmap)
If blkThumbnail Is Nothing Then
Dim cbi As New CreateBlockIcon(blkName)
blkThumbnail = TryCast(btr.PreviewIcon, Bitmap)
cbi = Nothing
End If
If blkThumbnail Is Nothing Then
AddListViewItem(blkName)
Else
AddBlockImageToList(blkName, blkThumbnail)
AddListViewItem(blkName, True)
End If
End If
Next
' End foreach
trx.Commit()
End Using
' End trx
End Sub
' End FillListView
Private Sub AddBlockImageToList(ByVal blkName As String, ByVal blkThumbnail As Bitmap)
If Not (Me.BlockLargeImage.Images.ContainsKey(blkName)) Then
Me.BlockLargeImage.Images.Add(blkName, blkThumbnail)
Me.BlockSmallImage.Images.Add(blkName, blkThumbnail)
End If
End Sub
' End AddBlockImageToList
Private Sub AddListViewItem(ByVal blkName As String, ByVal blkThumbnailExists As Boolean)
Dim lvi As ListViewItem = TryCast(New ListViewItem(blkName, blkName), ListViewItem)
lvi.ToolTipText = blkName
Me.lvBlocks.Items.Add(lvi)
End Sub
' End AddListViewItem
Private Sub AddListViewItem(ByVal blkName As String)
Dim lvi As ListViewItem = TryCast(New ListViewItem(blkName), ListViewItem)
lvi.ToolTipText = blkName
Me.lvBlocks.Items.Add(lvi)
End Sub
' End AddListViewItem
Private Sub SetGroups(ByVal column As Integer)
lvBlocks.Groups.Clear()
Dim groups As New List(Of String)()
For Each item As ListViewItem In lvBlocks.Items
Dim groupName As String = item.Text.Substring(0, 1).ToUpper()
If groups.Contains(groupName) Then
item.Group = lvBlocks.Groups(groupName)
Else
groups.Add(groupName)
item.Group = lvBlocks.Groups.Add(groupName, groupName)
End If
Next
End Sub
#Region "Context Menu Code"
Private Sub BlocksContextMenu_Opening(ByVal sender As System.Object, ByVal e As System.ComponentModel.CancelEventArgs) Handles BlocksContextMenu.Opening
Me.LargeIconToolStripMenuItem.Checked = False
Me.DetailToolStripMenuItem.Checked = False
Me.ListViewToolStripMenuItem.Checked = False
Me.SmallIconToolStripMenuItem.Checked = False
Me.TileViewToolStripMenuItem.Checked = False
Me.useCurrentFileToolStripMenuItem.Checked = False
Me.ChooseFileToolStripMenuItem.Checked = False
Select Case Me.lvBlocks.View
Case View.LargeIcon
Me.LargeIconToolStripMenuItem.Checked = True
Exit Select
Case View.Details
Me.DetailToolStripMenuItem.Checked = True
Exit Select
Case View.List
Me.ListViewToolStripMenuItem.Checked = True
Exit Select
Case View.SmallIcon
Me.SmallIconToolStripMenuItem.Checked = True
Exit Select
Case View.Tile
Me.TileViewToolStripMenuItem.Checked = True
Exit Select
End Select
ShowGroupsToolStripMenuItem.Checked = viewGroups
If dwgFileName Is Nothing Then
Me.useCurrentFileToolStripMenuItem.Checked = True
Else
Me.ChooseFileToolStripMenuItem.Checked = True
End If
End Sub
' End BlocksContextMenu_Opening
Private Sub LargeIconToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles LargeIconToolStripMenuItem.Click
Me.lvBlocks.View = View.LargeIcon
End Sub
Private Sub SmallIconToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles SmallIconToolStripMenuItem.Click
Me.lvBlocks.View = View.SmallIcon
End Sub
Private Sub DetailToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles DetailToolStripMenuItem.Click
Me.lvBlocks.View = View.Details
End Sub
Private Sub ListViewToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ListViewToolStripMenuItem.Click
Me.lvBlocks.View = View.List
End Sub
Private Sub TileViewToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TileViewToolStripMenuItem.Click
Me.lvBlocks.View = View.Tile
End Sub
Private Sub ShowGroupsToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ShowGroupsToolStripMenuItem.Click
viewGroups = (Not (viewGroups))
lvBlocks.ShowGroups = viewGroups
ShowGroupsToolStripMenuItem.Checked = Not ShowGroupsToolStripMenuItem.Checked
SetGroups(0)
End Sub
Private Sub ChooseFileToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ChooseFileToolStripMenuItem.Click
OFD.Filter = "Block Files|*.dwg;*.dwt"
OFD.Title = "Select Block File"
OFD.Multiselect = False
OFD.ShowHelp = True
OFD.CheckPathExists = True
OFD.CheckFileExists = True
OFD.FilterIndex = 1
Try
If OFD.ShowDialog() = DialogResult.OK Then
dwgFileName = OFD.FileName
FillListView(OFD.FileName)
End If
Catch ex As System.Exception
System.Windows.Forms.MessageBox.Show(ex.Message)
End Try
End Sub
Private Sub useCurrentFileToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles useCurrentFileToolStripMenuItem.Click
dwgFileName = Nothing
FillListView()
End Sub
#End Region
Private Sub InsertBlock(ByVal blkName As String)
Dim doc As Document = DocumentManager.MdiActiveDocument
Dim ed As Editor = doc.Editor
Dim db As Database = doc.Database
Using docloc As DocumentLock = doc.LockDocument()
Using trx As Transaction = db.TransactionManager.StartTransaction()
Dim bt As BlockTable = TryCast(db.BlockTableId.GetObject(OpenMode.ForRead), BlockTable)
Dim currBtr As BlockTableRecord = TryCast(db.CurrentSpaceId.GetObject(OpenMode.ForRead), BlockTableRecord)
If Not (bt.Has(blkName)) Then
Return
End If
Dim btrId As ObjectId = bt(blkName).GetObject(OpenMode.ForRead).ObjectId
Dim ppo As New PromptPointOptions("/nSelect Insertion Point: ")
Dim ppr As PromptPointResult = ed.GetPoint(ppo)
If ppr.Status = PromptStatus.OK Then
Dim insertPnt As Point3d = ppr.Value
currBtr.UpgradeOpen()
Dim bref As New BlockReference(insertPnt, btrId)
currBtr.AppendEntity(bref)
trx.AddNewlyCreatedDBObject(bref, True)
End If
trx.Commit()
End Using
End Using
End Sub
Private Sub InsertBlock(ByVal blkName As String, ByVal fileName As String)
Dim extDb As Database = TryCast(New Database(False, True), Database)
extDb.ReadDwgFile(fileName, FileOpenMode.OpenForReadAndAllShare, True, "")
Dim doc As Document = DocumentManager.MdiActiveDocument
Dim ed As Editor = doc.Editor
Dim db As Database = doc.Database
Using docloc As DocumentLock = doc.LockDocument()
Using trx As Transaction = db.TransactionManager.StartTransaction()
Using extTrx As Transaction = extDb.TransactionManager.StartTransaction()
Dim bt As BlockTable = TryCast(db.BlockTableId.GetObject(OpenMode.ForRead), BlockTable)
Dim currBtr As BlockTableRecord = TryCast(db.CurrentSpaceId.GetObject(OpenMode.ForRead), BlockTableRecord)
If Not (bt.Has(blkName)) Then
Dim extBt As BlockTable = TryCast(extDb.BlockTableId.GetObject(OpenMode.ForRead), BlockTable)
Dim map As New IdMapping()
Dim objIdColl As New ObjectIdCollection()
Try
objIdColl.Add(extBt(blkName))
Catch
trx.Commit()
Return
End Try
db.WblockCloneObjects(objIdColl, bt.ObjectId, map, DuplicateRecordCloning.Replace, False)
End If
Dim btrId As ObjectId = bt(blkName).GetObject(OpenMode.ForRead).ObjectId
Dim ppo As New PromptPointOptions("/nSelect Insertion Point: ")
Dim ppr As PromptPointResult = ed.GetPoint(ppo)
If ppr.Status = PromptStatus.OK Then
Dim insertPnt As Point3d = ppr.Value
currBtr.UpgradeOpen()
Dim bref As New BlockReference(insertPnt, btrId)
currBtr.AppendEntity(bref)
trx.AddNewlyCreatedDBObject(bref, True)
End If
trx.Commit()
End Using
End Using
End Using
End Sub
Private Sub lvBlocks_DoubleClick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles lvBlocks.DoubleClick
Dim blk As String = lvBlocks.FocusedItem.Text
If dwgFileName Is Nothing Then
InsertBlock(blk)
Else
InsertBlock(blk, dwgFileName)
End If
End Sub
Private Sub BasicBlockMangerPalette_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
Me.lvBlocks.ContextMenuStrip = BlocksContextMenu
Me.lvBlocks.LargeImageList = BlockLargeImage
Me.lvBlocks.SmallImageList = BlockSmallImage
FillListView()
Me.lvBlocks.ShowGroups = viewGroups
End Sub
End Class
Public Class CreateBlockIcon
<DllImport("acad.exe", CallingConvention:=CallingConvention.Cdecl, CharSet:=CharSet.Unicode)> _
Private Shared Function acedCommand(ByVal type1 As Integer, ByVal command As String, ByVal type2 As Integer, ByVal blockName As String, ByVal [end] As Integer) As Integer
End Function
Sub New(ByVal blkname As String)
acedCommand(5005, "BLOCKICON", 5005, blkname, 5000)
End Sub
End Class