Sub InsertBlock()

    Dim InsertionPoint(0 To 2) As Double, Sh As Worksheet, acadDoc As AcadDocument
    Dim BlockName As String
    Set acadApp = Get_App
    On Error Resume Next
    Set acadDoc = acadApp.ActiveDocument
    If acadDoc Is Nothing Then
        Set acadDoc = acadApp.Documents.Add
    End If
    On Error GoTo 0
    Set Sh = ActiveSheet
    LastCol = Sh.Range("iv1").End(xlToLeft).Column
    LastRow = Sh.Cells(Sh.Rows.Count, 1).End(xlUp).Row
    dx = Sh.Range(Sh.Range("A1"), Sh.Cells(LastRow, LastCol))
    height_ = 0.5
    For n = 2 To UBound(dx)
        BlockName = dx(n, 1)
        InsertionPoint(0) = dx(n, 2)
        InsertionPoint(1) = dx(n, 3)
        InsertionPoint(2) = dx(n, 4)

        Dim points(0 To 14) As Double
        points(0) = dx(n, 2): points(1) = dx(n, 3): points(2) = dx(n, 4)
        points(3) = dx(n, 2): points(4) = dx(n, 3) + 15: points(5) = dx(n, 4)
        points(6) = dx(n, 2) + 15: points(7) = dx(n, 3) + 15: points(8) = dx(n, 4)
        points(9) = dx(n, 2) + 15: points(10) = dx(n, 3): points(11) = 0
        points(12) = dx(n, 2): points(13) = dx(n, 3): points(14) = dx(n, 4)

        Set acadBlock = acadDoc.Blocks.Add(InsertionPoint, BlockName)
        Set plineObj = acadBlock.AddPolyline(points)
        Set blockRefObj = acadDoc.ModelSpace.InsertBlock(InsertionPoint, BlockName, 1#, 1#, 1#, 0)

        For i = 5 To UBound(dx, 2)
            Attrname = dx(1, i)
            AValue = dx(n, i)
            Set attributeObj = acadBlock.AddAttribute(height_, 0, _
                                                      Attrname, InsertionPoint, Attrname, AValue)
        Next

    Next

End Sub

Function Get_App() As Object
    On Error Resume Next
    Dim App As Object
    Set App = GetObject(, "AutoCAD.Application")
    If App Is Nothing Then
        Set App = CreateObject("AutoCAD.Application")
    End If
    App.Visible = True
    Set Get_App = App

End Function