将所选对象定义成块（块定义）

Imports ZwSoft.ZwCAD.Runtime
Imports ZwSoft.ZwCAD.ApplicationServices
Imports ZwSoft.ZwCAD.DatabaseServices
Imports ZwSoft.ZwCAD.EditorInput
Imports ZwSoft.ZwCAD.Geometry


Public Class ZwcadApps
    <CommandMethod("DefineBlock")> _
    Public Sub DefineBlock()
        Dim ZcDoc As Document = Application.DocumentManager.MdiActiveDocument
        Dim ZcDB As Database = ZcDoc.Database
        Dim ZcEd As Editor = ZcDoc.Editor


        Dim per As PromptSelectionResult = ZcEd.GetSelection()
        If per.Status = PromptStatus.OK Then
            Using ZcTrans As Transaction = ZcDB.TransactionManager.StartTransaction()
                Dim ZcBT As BlockTable = ZcTrans.GetObject(ZcDB.BlockTableId, OpenMode.ForWrite)


                Dim pso As New PromptStringOptions(vbLf & "Enter new block name: ")
                Dim blkName As String = ""
                Do
                    Dim pr As PromptResult = ZcEd.GetString(pso)
                    If pr.Status <> PromptStatus.OK Then
                        Return
                    End If
                    Try
                        SymbolUtilityServices.ValidateSymbolName(pr.StringResult, False)
                        If ZcBT.Has(pr.StringResult) Then
                            ZcEd.WriteMessage(vbLf & "A block with this name already exists.")
                        Else
                            blkName = pr.StringResult
                        End If
                    Catch
                        ZcEd.WriteMessage(vbLf & "Invalid block name.")
                    End Try
                Loop While blkName = ""


                Dim Block_ZcBTR As BlockTableRecord = New BlockTableRecord()
                Block_ZcBTR.Name = blkName


                Dim btrId As ObjectId = ZcBT.Add(Block_ZcBTR)
                ZcTrans.AddNewlyCreatedDBObject(Block_ZcBTR, True)


                Dim Ents_SS As SelectionSet = per.Value
                For Each objID As ObjectId In Ents_SS.GetObjectIds
                    Dim Ent As Entity = ZcTrans.GetObject(objID, OpenMode.ForWrite)
                    Dim SubEnt As Entity = Ent.Clone()
                    Block_ZcBTR.AppendEntity(SubEnt)
                    ZcTrans.AddNewlyCreatedDBObject(SubEnt, True)
                    Ent.Erase()
                Next


                Dim ZcBTR As BlockTableRecord = DirectCast(ZcTrans.GetObject(ZcBT(BlockTableRecord.ModelSpace), OpenMode.ForWrite), BlockTableRecord)
                Dim ZcBR As New BlockReference(Point3d.Origin, btrId)
                ZcBTR.AppendEntity(ZcBR)
                ZcTrans.AddNewlyCreatedDBObject(ZcBTR, True)

                ZcTrans.Commit()
            End Using
        End If
    End Sub

End Class

执行DefineBlock命令后，会将用户所选择的对象转换成块。