Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.EditorInput
Imports Autodesk.AutoCAD.Geometry
Imports Autodesk.AutoCAD.Windows

Public Class Class1
    'Gets the coordinates for the selected polylines
    Public Shared Function GetPolylineCoordinates(ByVal ent As Polyline) As Point3dCollection
        Dim pts As Point3dCollection = New Point3dCollection()
        Dim coord As Point3d
        Dim i As Integer = 0
        For i = 0 To ent.NumberOfVertices - 1
            coord = ent.GetPoint3dAt(i)
            pts.Add(coord)
        Next
        Return pts
    End Function
    'Gets the coordinates for the selected points
    Public Shared Function GetPointCoordinates(ByVal ent2 As PointEntity3d) As Point3d
        Dim pts2 As Point3d = New Point3d()
        Dim pot As Point3d
        pot = ent2.GetPoint
        pts2.Add(pot.GetAsVector)
        Return pts2
    End Function
    'Get the Coordinates for the selected lines
    Public Shared Function GetLineCoordinates(ByVal ent3 As Line) As Point3d
        Dim pts3 As Point3d = New Point3d()
        Dim spt As Point3d
        Dim ept As Point3d
        spt = ent3.StartPoint
        ept = ent3.EndPoint
        pts3.Add(spt.GetAsVector)
        pts3.Add(ept.GetAsVector)
        Return pts3
    End Function
    'Specifies the command that is used
    <CommandMethod("instblk")> _
    Public Sub InsertBlocks()
        'Selects the dwg file to be used as the block that is inserted
        Dim ofd As New OpenFileDialog(title:="Block Selection", defaultName:="", dialogName:="Block Selection", extension:="dwg", flags:=OpenFileDialog.OpenFileDialogFlags.NoFtpSites)
        ofd.ShowDialog()
        Dim doc As Document = Application.DocumentManager.MdiActiveDocument
        Dim db As Database = doc.Database
        Dim ed As Editor = doc.Editor
        'Specifies the selection area
        Dim ppo As New PromptPointOptions(vbLf & "First Corner:")
        Dim ppr As PromptPointResult = ed.GetPoint(ppo)
        Dim pco As New PromptCornerOptions(vbLf & "Second Corner:", ppr.Value)
        Dim pcr As PromptPointResult = ed.GetCorner(pco)
        'Gets the start and end points of the selected polylines
        Dim p1 As Point3d = ppr.Value
        Dim p2 As Point3d = pcr.Value
        Dim pts As New Point3dCollection()
        pts.Add(p1)
        pts.Add(New Point3d(p2.X, p1.Y, 0))
        pts.Add(p2)
        pts.Add(New Point3d(p1.X, p2.Y, 0))
        'Creates a selection filter
        Dim tv As TypedValue() = New TypedValue() {New TypedValue(0, "LWPOLYLINE"), New TypedValue(1, "POINT"), New TypedValue(2, "LINE")}
        Dim flt As New SelectionFilter(tv)
        Dim res As PromptSelectionResult = ed.SelectCrossingPolygon(pts, flt)
        Using doclock As DocumentLock = doc.LockDocument
            Using tr As Transaction = db.TransactionManager.StartTransaction()
                Try
                    'Creates the specified block within the dwg
                    Dim bt As BlockTable
                    bt = tr.GetObject(db.BlockTableId, OpenMode.ForRead)
                    Dim blkid As ObjectId
                    Dim ndb As Database = New Database(False, True)
                    ndb.ReadDwgFile(ofd.Filename, FileOpenMode.OpenForReadAndReadShare, True, Nothing)
                    Dim name As String = SymbolUtilityServices.GetBlockNameFromInsertPathName(ofd.Filename)
                    Dim btr As BlockTableRecord = tr.GetObject(db.CurrentSpaceId, OpenMode.ForWrite)
                    blkid = db.Insert(name, ndb, True)
                    For Each selobj As SelectedObject In res.Value
                        Dim ent As Entity = tr.GetObject(selobj.ObjectId, OpenMode.ForRead)
                        'Gets the selected polylines
                        Dim pline As Polyline
                        pline = TryCast(ent, Polyline)
                        'Gets the selected lines
                        Dim pt As PointEntity3d
                        pt = TryCast(ent, PointEntity3d)
                        Dim ln As Line
                        ln = TryCast(ent, Line)
                        If pline IsNot Nothing Then
                            'Runs the shared function to get the coordinates of the polylines
                            Dim vertices As Point3dCollection = GetPolylineCoordinates(pline)
                            For i As Integer = 0 To vertices.Count - 1
                                'Adds the block to the polylines
                                Dim br As BlockReference = New BlockReference(vertices(i), blkid)
                                br.SetDatabaseDefaults()
                                btr.AppendEntity(br)
                                tr.AddNewlyCreatedDBObject(br, True)
                            Next
                        Else
                            If pt IsNot Nothing Then
                                Dim verts As Point3d = GetPointCoordinates(pt)
                                'Adds the block to the points
                                Dim br2 As BlockReference = New BlockReference(verts, blkid)
                                br2.SetDatabaseDefaults()
                                btr.AppendEntity(br2)
                                tr.AddNewlyCreatedDBObject(br2, True)
                            Else
                                If ln IsNot Nothing Then
                                    Dim vts As Point3d = GetLineCoordinates(ln)
                                    'Adds the block to the lines
                                    Dim br3 As BlockReference = New BlockReference(vts, blkid)
                                    br3.SetDatabaseDefaults()
                                    btr.AppendEntity(br3)
                                    tr.AddNewlyCreatedDBObject(br3, True)
                                End If
                            End If
                        End If
                    Next
                    'Commits to the changes made
                    tr.Commit()
                Catch ex As Exception
                    ed.WriteMessage(ex.Message + vbLf + ex.StackTrace)
                End Try
            End Using
        End Using
    End Sub
End Class