VB.NET读取Excel数据在CAD上展图

来源：互联网发布：建设工程预算软件编辑：程序博客网时间：2024/04/29 10:45

根据网友的需求,编写此程序:读取Excel文件当中的数据,在CAD图上展绘孔位及其桩号与孔深的属性.

本实例包含以下技术要点:

1.如何用代码创建带属性的块对象,而非导入外部图块文件(尤其是带填充对象的图块).

2.如何更改块属性的属性值.

3.如何创建文本样式.

4.如何读取Excel文件当中的数据.

5.最大的特色是用VB.Net语言编写(因为用VB.Net编写的实例代码,在本论坛较少),望给用VB.Net的朋友有帮助.

6.因本人极少写VB.Net代码,难免水平较低,如有不足之处,请指出批评.

Excel文件的数据格式:

JKC1静力触探孔3045304.377 543717.354 2.630 32.500 JKC2静力触探孔3045617.146 545348.081 3.200 35.800 JKC3静力触探孔3046038.390 546159.911 3.380 35.500 SKC1十字板3045617.739 545346.739 3.200 30.000 SKC2十字板3046138.556 548510.327 2.520 30.000 SKC3十字板3046605.847 555424.066 2.200 30.000 ZKC1取土样钻孔3045384.183 544032.220 2.680 80.000 ZKC2取土样钻孔3045436.779 544468.844 2.720 76.100 ZKC3取土样钻孔3045477.244 544827.897 2.680 80.500

创建图块的源码:

Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.Geometry

''' <summary>
''' 创建图块
''' </summary>
''' <remarks></remarks>
Public Class CreateBlock

    ''' <summary>
    ''' 创建JK图块
    ''' </summary>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Shared Function createBlockJK() As ObjectId
        Dim blockId As New ObjectId()
        Dim db As Database = HostApplicationServices.WorkingDatabase '得到当前文档图形数据库
        Dim record As New BlockTableRecord()

        '图块名称
        record.Name = "JK"
        record.Origin = New Point3d(0, 0, 0)

'打开事务
Using trans As Transaction = db.TransactionManager.StartOpenCloseTransaction()

            '创建第一个多段线对象
            Dim pts1 As New Point2dCollection()
            pts1.Add(New Point2d(-3.8, 0.0))
            pts1.Add(New Point2d(+3.8, 0.0))

            Dim pline1 As New Polyline()
            For i As Integer = 0 To pts1.Count - 1
                pline1.AddVertexAt(i, pts1.Item(i), 1, 0.4, 0.4)
            Next
            pline1.Closed = True
            pline1.Layer = "0"
            pline1.ColorIndex = 0
            record.AppendEntity(pline1)

            '创建第一个多段线对象
            Dim pts2 As New Point2dCollection()
            pts2.Add(New Point2d(0.0, -3.8))
            pts2.Add(New Point2d(3.2909, 1.9))
            pts2.Add(New Point2d(-3.2909, 1.9))

            Dim pline2 As New Polyline()
            For i As Integer = 0 To pts2.Count - 1
                pline2.AddVertexAt(i, pts2.Item(i), 0, 0.2, 0.2)
            Next
            pline2.Closed = True
            pline2.Layer = "0"
            pline2.ColorIndex = 0
            record.AppendEntity(pline2)

            '创建第一个多段线对象
            Dim pts3 As New Point2dCollection()
            pts3.Add(New Point2d(0.0, 4.0))
            pts3.Add(New Point2d(0.0, 14.0))
            pts3.Add(New Point2d(28.0, 14.0))

            Dim pline3 As New Polyline()
            For i As Integer = 0 To pts3.Count - 1
                pline3.AddVertexAt(i, pts3.Item(i), 0, 0.2, 0.2)
            Next
            pline3.Layer = "0"
            pline3.ColorIndex = 0
            record.AppendEntity(pline3)

            Dim att1 As New AttributeDefinition
            att1.Position = New Point3d(13.6683, 18.8785, 0.0)
            att1.Height = 7.8        '设置文字高度
            att1.WidthFactor = 0.7   '设置宽度因子
            att1.HorizontalMode = TextHorizontalMode.TextMid     '设置水平对齐方式
            att1.VerticalMode = TextVerticalMode.TextVerticalMid '设置垂直对齐方式
            att1.AlignmentPoint = att1.Position
            att1.Prompt = "孔号"     '设置属性提示
            att1.TextString = "JKS1" '设置属性的缺省值
            att1.Tag = "孔号"        '设置属性标签
            att1.Layer = "0"
            att1.TextStyleId = CreateEntity.CreateStyle() '指定文本样式
            att1.ColorIndex = 0
            record.AppendEntity(att1)

            Dim att2 As New AttributeDefinition
            att2.Position = New Point3d(13.6683, 8.3528, 0.0)
            att2.Height = 7.8        '设置文字高度
            att2.WidthFactor = 0.7   '设置宽度因子
            att2.HorizontalMode = TextHorizontalMode.TextMid     '设置水平对齐方式
            att2.VerticalMode = TextVerticalMode.TextVerticalMid '设置垂直对齐方式
            att2.AlignmentPoint = att2.Position
            att2.Prompt = "孔深"     '设置属性提示
            att2.TextString = "0.00" '设置属性的缺省值
            att2.Tag = "孔深"        '设置属性标签
            att2.Layer = "0"
            att2.TextStyleId = CreateEntity.CreateStyle() '指定文本样式
            att2.ColorIndex = 0
            record.AppendEntity(att2)

'以写的方式打开块表
Dim bt As BlockTable = trans.GetObject(db.BlockTableId, OpenMode.ForWrite)

            '判断图块是否存在
            If bt.Has(record.Name) = False Then
                '在块表中加入块
                blockId = bt.Add(record)
                '通知事务处理
                trans.AddNewlyCreatedDBObject(record, True)
                '提交事务
                trans.Commit()
            End If
        End Using
    End Function

    ''' <summary>
    ''' 创建MK图块
    ''' </summary>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Shared Function createBlockMK() As ObjectId
        Dim blockId As New ObjectId()
        Dim db As Database = HostApplicationServices.WorkingDatabase '得到当前文档图形数据库
        Dim record As New BlockTableRecord()

        '图块名称
        record.Name = "MK"
        record.Origin = New Point3d(0, 0, 0)

'打开事务
Using trans As Transaction = db.TransactionManager.StartOpenCloseTransaction()

            '创建第一个多段线对象
            Dim pts1 As New Point2dCollection()
            pts1.Add(New Point2d(-3.8, 0.0))
            pts1.Add(New Point2d(+3.8, 0.0))

            '创建第一个多段线对象
            Dim pts2 As New Point2dCollection()
            pts2.Add(New Point2d(0.0, 4.0))
            pts2.Add(New Point2d(0.0, 14.0))
            pts2.Add(New Point2d(28.0, 14.0))

            Dim pline2 As New Polyline()
            For i As Integer = 0 To pts2.Count - 1
                pline2.AddVertexAt(i, pts2.Item(i), 0, 0.2, 0.2)
            Next
            pline2.Layer = "0"
            pline2.ColorIndex = 0
            record.AppendEntity(pline2)

            Dim att1 As New AttributeDefinition
            att1.Position = New Point3d(13.6683, 18.8785, 0.0)
            att1.Height = 7.8        '设置文字高度
            att1.WidthFactor = 0.7   '设置宽度因子
            att1.HorizontalMode = TextHorizontalMode.TextMid     '设置水平对齐方式
            att1.VerticalMode = TextVerticalMode.TextVerticalMid '设置垂直对齐方式
            att1.AlignmentPoint = att1.Position
            att1.Prompt = "孔号"     '设置属性提示
            att1.TextString = "MK1" '设置属性的缺省值
            att1.Tag = "孔号"        '设置属性标签
            att1.Layer = "0"
            att1.TextStyleId = CreateEntity.CreateStyle() '指定文本样式
            att1.ColorIndex = 0
            record.AppendEntity(att1)

'以写的方式打开块表
Dim bt As BlockTable = trans.GetObject(db.BlockTableId, OpenMode.ForWrite)

    ''' <summary>
    ''' 创建SZB图块
    ''' </summary>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Shared Function createBlockSZB() As ObjectId
        Dim blockId As New ObjectId()
        Dim db As Database = HostApplicationServices.WorkingDatabase '得到当前文档图形数据库
        Dim record As New BlockTableRecord()

        '图块名称
        record.Name = "SZB"
        record.Origin = New Point3d(0, 0, 0)

'打开事务
Using trans As Transaction = db.TransactionManager.StartOpenCloseTransaction()

            '创建第一个多段线对象
            Dim pts1 As New Point2dCollection()
            pts1.Add(New Point2d(-3.8, 0.0))
            pts1.Add(New Point2d(+3.8, 0.0))

            '创建第一个多段线对象
            Dim pline2 As New Polyline()
            pline2.AddVertexAt(0, New Point2d(-3.8, 0.0), 0, 0.2, 0.2)
            pline2.AddVertexAt(1, New Point2d(+3.8, 0.0), 0, 0.2, 0.2)
            pline2.Layer = "0"
            pline2.ColorIndex = 0
            record.AppendEntity(pline2)

            '创建第一个多段线对象
            Dim pline3 As New Polyline()
            pline3.AddVertexAt(0, New Point2d(0.0, +3.8), 0, 0.2, 0.2)
            pline3.AddVertexAt(1, New Point2d(0.0, -3.8), 0, 0.2, 0.2)
            pline3.Layer = "0"
            pline3.ColorIndex = 0
            record.AppendEntity(pline3)

            '创建第一个多段线对象
            Dim pts4 As New Point2dCollection()
            pts4.Add(New Point2d(0.0, 4.0))
            pts4.Add(New Point2d(0.0, 14.0))
            pts4.Add(New Point2d(28.0, 14.0))

            Dim pline4 As New Polyline()
            For i As Integer = 0 To pts4.Count - 1
                pline4.AddVertexAt(i, pts4.Item(i), 0, 0.2, 0.2)
            Next
            pline4.Layer = "0"
            pline4.ColorIndex = 0
            record.AppendEntity(pline4)

            Dim att1 As New AttributeDefinition
            att1.Position = New Point3d(13.6683, 18.8785, 0.0)
            att1.Height = 7.8        '设置文字高度
            att1.WidthFactor = 0.7   '设置宽度因子
            att1.HorizontalMode = TextHorizontalMode.TextMid     '设置水平对齐方式
            att1.VerticalMode = TextVerticalMode.TextVerticalMid '设置垂直对齐方式
            att1.AlignmentPoint = att1.Position
            att1.Prompt = "孔号"     '设置属性提示
            att1.TextString = "SKS1" '设置属性的缺省值
            att1.Tag = "孔号"        '设置属性标签
            att1.Layer = "0"
            att1.TextStyleId = CreateEntity.CreateStyle() '指定文本样式
            att1.ColorIndex = 0
            record.AppendEntity(att1)

'以写的方式打开块表
Dim bt As BlockTable = trans.GetObject(db.BlockTableId, OpenMode.ForWrite)

    ''' <summary>
    ''' 创建TC图块
    ''' </summary>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Shared Function createBlockTC() As ObjectId

Dim blockId As New ObjectId()
Dim db As Database = HostApplicationServices.WorkingDatabase '得到当前文档图形数据库

'打开事务
Using trans As Transaction = db.TransactionManager.StartTransaction()

'以写的方式打开块表
Dim bt As BlockTable = trans.GetObject(db.BlockTableId, OpenMode.ForWrite)

'判断图块是否存在
If bt.Has("TC") = False Then

                Dim MyHatch As New Hatch()
                MyHatch.SetDatabaseDefaults()
                MyHatch.SetHatchPattern(HatchPatternType.PreDefined, "SOLID")

Dim record As New BlockTableRecord()

                '图块名称
                record.Name = "TC"
                record.Origin = New Point3d(0, 0, 0)

                '在块表中加入块
                blockId = bt.Add(record)
                trans.AddNewlyCreatedDBObject(record, True)

                '创建第一个多段线对象
                Dim pts1 As New Point2dCollection()
                pts1.Add(New Point2d(-6.346, +2.866))
                pts1.Add(New Point2d(+6.346, +2.866))
                pts1.Add(New Point2d(+6.346, -2.866))
                pts1.Add(New Point2d(-6.346, -2.866))

                Dim pline1 As New Polyline()
                For i As Integer = 0 To pts1.Count - 1
                    pline1.AddVertexAt(i, pts1.Item(i), 0, 0.4, 0.4)
                Next
                pline1.Closed = True
                pline1.Layer = "0"
                pline1.ColorIndex = 0
                record.AppendEntity(pline1)

                '创建第一个多段线对象
                Dim pts2 As New Point2dCollection()
                pts2.Add(New Point2d(0.0, 2.866))
                pts2.Add(New Point2d(0.0, 12.866))
                pts2.Add(New Point2d(28.0, 12.866))

                Dim pline2 As New Polyline()
                For i As Integer = 0 To pts2.Count - 1
                    pline2.AddVertexAt(i, pts2.Item(i), 0, 0.2, 0.2)
                Next
                pline2.Closed = True
                pline2.Layer = "0"
                pline2.ColorIndex = 0
                record.AppendEntity(pline2)

                '创建第一个多段线对象
                Dim pts3 As New Point2dCollection()
                pts3.Add(New Point2d(+6.346, +2.866))
                pts3.Add(New Point2d(+6.346, -2.866))
                pts3.Add(New Point2d(-6.346, -2.866))

                Dim pline3 As New Polyline()
                For i As Integer = 0 To pts3.Count - 1
                    pline3.AddVertexAt(i, pts3.Item(i), 0, 0, 0)
                Next
                pline3.Closed = True
                pline3.Layer = "0"
                pline3.ColorIndex = 0
                pline3.Closed = True

Dim objId As ObjectId = record.AppendEntity(pline3)
record.AppendEntity(MyHatch)

                Dim att1 As New AttributeDefinition
                att1.Position = New Point3d(13.6683, 18.8785, 0.0)
                att1.Height = 7.8        '设置文字高度
                att1.WidthFactor = 0.7   '设置宽度因子
                att1.HorizontalMode = TextHorizontalMode.TextMid     '设置水平对齐方式
                att1.VerticalMode = TextVerticalMode.TextVerticalMid '设置垂直对齐方式
                att1.AlignmentPoint = att1.Position
                att1.Prompt = "孔号"     '设置属性提示
                att1.TextString = "TS1" '设置属性的缺省值
                att1.Tag = "孔号"        '设置属性标签
                att1.Layer = "0"
                att1.TextStyleId = CreateEntity.CreateStyle() '指定文本样式
                att1.ColorIndex = 0
                record.AppendEntity(att1)

                Dim att2 As New AttributeDefinition
                att2.Position = New Point3d(13.6683, 8.3528, 0.0)
                att2.Height = 7.8        '设置文字高度
                att2.WidthFactor = 0.7   '设置宽度因子
                att2.HorizontalMode = TextHorizontalMode.TextMid     '设置水平对齐方式
                att2.VerticalMode = TextVerticalMode.TextVerticalMid '设置垂直对齐方式
                att2.AlignmentPoint = att2.Position
                att2.Prompt = "孔深"     '设置属性提示
                att2.TextString = "0.00" '设置属性的缺省值
                att2.Tag = "孔深"        '设置属性标签
                att2.Layer = "0"
                att2.TextStyleId = CreateEntity.CreateStyle() '指定文本样式
                att2.ColorIndex = 0
                record.AppendEntity(att2)

                '通知事务处理
                trans.AddNewlyCreatedDBObject(pline1, True)
                trans.AddNewlyCreatedDBObject(pline2, True)
                trans.AddNewlyCreatedDBObject(pline3, True)
                trans.AddNewlyCreatedDBObject(att1, True)
                trans.AddNewlyCreatedDBObject(att2, True)
                trans.AddNewlyCreatedDBObject(MyHatch, True)

                Dim Ids As New ObjectIdCollection()
                Ids.Add(objId)
                MyHatch.Associative = True
                MyHatch.AppendLoop(HatchLoopTypes.Default, Ids)
                MyHatch.EvaluateHatch(True)
                MyHatch.Layer = "0"
                MyHatch.ColorIndex = 0

                '提交事务
                trans.Commit()
            End If
        End Using
    End Function

    ''' <summary>
    ''' 创建ZK图块
    ''' </summary>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Shared Function createBlockZK() As ObjectId

Dim blockId As New ObjectId()
Dim db As Database = HostApplicationServices.WorkingDatabase '得到当前文档图形数据库

'打开事务
Using trans As Transaction = db.TransactionManager.StartTransaction()

'以写的方式打开块表
Dim bt As BlockTable = trans.GetObject(db.BlockTableId, OpenMode.ForWrite)

'判断图块是否存在
If bt.Has("ZK") = False Then

                Dim MyHatch As New Hatch()
                MyHatch.SetDatabaseDefaults()
                MyHatch.SetHatchPattern(HatchPatternType.PreDefined, "SOLID")

Dim record As New BlockTableRecord()

                '图块名称
                record.Name = "ZK"
                record.Origin = New Point3d(0, 0, 0)

                '在块表中加入块
                blockId = bt.Add(record)
                trans.AddNewlyCreatedDBObject(record, True)

                '创建第一个多段线对象
                Dim pts1 As New Point2dCollection()
                pts1.Add(New Point2d(-3.8, 0.0))
                pts1.Add(New Point2d(+3.8, 0.0))

                Dim pline1 As New Polyline()
                For i As Integer = 0 To pts1.Count - 1
                    pline1.AddVertexAt(i, pts1.Item(i), 1, 0.4, 0.4)
                Next
                pline1.Closed = True
                pline1.Layer = "0"
                pline1.ColorIndex = 0
                record.AppendEntity(pline1)

                '创建第一个多段线对象
                Dim pts2 As New Point2dCollection()
                pts2.Add(New Point2d(0.0, 3.8))
                pts2.Add(New Point2d(0.0, 14.0))
                pts2.Add(New Point2d(28.0, 14.0))

                Dim pline2 As New Polyline()
                For i As Integer = 0 To pts2.Count - 1
                    pline2.AddVertexAt(i, pts2.Item(i), 0, 0.2, 0.2)
                Next
                pline2.Layer = "0"
                pline2.ColorIndex = 0
                record.AppendEntity(pline2)

                '创建第一个多段线对象
                Dim pline3 As New Polyline()
                pline3.AddVertexAt(0, New Point2d(0.0, -3.8), 1, 0, 0)
                pline3.AddVertexAt(1, New Point2d(0.0, +3.8), 0, 0, 0)
                pline3.Layer = "0"
                pline3.ColorIndex = 0
                pline3.Closed = True

Dim objId As ObjectId = record.AppendEntity(pline3)
record.AppendEntity(MyHatch)

                Dim att1 As New AttributeDefinition
                att1.Position = New Point3d(13.668, 18.878, 0.0)
                att1.Height = 7.8        '设置文字高度
                att1.WidthFactor = 0.7   '设置宽度因子
                att1.HorizontalMode = TextHorizontalMode.TextMid     '设置水平对齐方式
                att1.VerticalMode = TextVerticalMode.TextVerticalMid '设置垂直对齐方式
                att1.AlignmentPoint = att1.Position
                att1.Prompt = "孔号"     '设置属性提示
                att1.TextString = "ZKS1" '设置属性的缺省值
                att1.Tag = "孔号"        '设置属性标签
                att1.Layer = "0"
                att1.TextStyleId = CreateEntity.CreateStyle() '指定文本样式
                att1.ColorIndex = 0
                record.AppendEntity(att1)

                Dim att2 As New AttributeDefinition
                att2.Position = New Point3d(13.668, 8.649, 0.0)
                att2.Height = 7.8        '设置文字高度
                att2.WidthFactor = 0.7   '设置宽度因子
                att2.HorizontalMode = TextHorizontalMode.TextMid     '设置水平对齐方式
                att2.VerticalMode = TextVerticalMode.TextVerticalMid '设置垂直对齐方式
                att2.AlignmentPoint = att2.Position
                att2.Prompt = "孔深"     '设置属性提示
                att2.TextString = "0.00" '设置属性的缺省值
                att2.Tag = "孔深"        '设置属性标签
                att2.Layer = "0"
                att2.TextStyleId = CreateEntity.CreateStyle() '指定文本样式
                att2.ColorIndex = 0
                record.AppendEntity(att2)

                '提交事务
                trans.Commit()
            End If
        End Using
    End Function
End Class

创建实体源码:

Imports Autodesk.AutoCAD.Geometry
Imports Autodesk.AutoCAD.DatabaseServices

''' <summary>
''' 创建实体对象
''' </summary>
''' <remarks></remarks>
Public Class CreateEntity

    ''' <summary>
    ''' 将图形对象加入到模型空间的函数
    ''' </summary>
    ''' <param name="ent"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Shared Function AppendEntity(ByVal ent As Entity) As ObjectId
        ' 得到当前文档图形数据库.
        Dim db As Database = HostApplicationServices.WorkingDatabase
        Dim entId As ObjectId
        Using trans As Transaction = db.TransactionManager.StartTransaction
            ' 以读方式打开块表.
            Dim bt As BlockTable = trans.GetObject(db.BlockTableId, OpenMode.ForRead)
            ' 以写方式打开模型空间块表记录.
            Dim btr As BlockTableRecord = trans.GetObject(bt(BlockTableRecord.ModelSpace), OpenMode.ForWrite)
            ' 将图形对象的信息添加到块表记录中,并返回ObjectId对象.
            entId = btr.AppendEntity(ent)
            ' 把图形对象添加到事务处理中.
            trans.AddNewlyCreatedDBObject(ent, True)
            ' 提交事务处理.
            trans.Commit()
        End Using
        Return entId
    End Function

    ''' <summary>
    ''' 由二维点集合和线宽创建二维优化多段线的函数
    ''' </summary>
    ''' <param name="pts">Point2d集合</param>
    ''' <param name="width">线宽</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Shared Function AddPline(ByVal pts As Point2dCollection, ByVal width As Double) As ObjectId
        Try
            ' 得到点集合的数量.
            Dim n As Integer = pts.Count
            ' 在内存中创建一个二维优化多段线对象.
            Dim ent As New Polyline(n)
            ' 向多段线添加顶点.
            For i As Integer = 0 To n - 1
                ent.AddVertexAt(i, pts.Item(i), 0, width, width)
            Next
            ' 调用EntityToModelSpace函数，将二维多段线加入到模型空间.
            Dim entId As ObjectId = AppendEntity(ent)
            Return entId
        Catch
            ' 创建失败,则返回一个空的ObjectId.
            Dim nullId As ObjectId = ObjectId.Null
            Return nullId
        End Try
    End Function

    ''' <summary>
    ''' 插入一个带属性的块
    ''' </summary>
    ''' <param name="blockName">图块名称</param>
    ''' <param name="point">插入点</param>
    ''' <param name="scale">图块比例</param>
    ''' <param name="rotateAngle">图块旋转角度</param>
    ''' <param name="KHstring">属性值:孔号</param>
    ''' <param name="KSdouble">属性值:孔深</param>
    ''' <remarks></remarks>
    Public Sub InsertBlockRefWithAtt(ByVal blockName As String, _
                                     ByVal point As Point3d, _
                                     ByVal scale As Scale3d, _
                                     ByVal rotateAngle As Double, _
                                     ByVal KHstring As String, _
                                     ByVal KSdouble As Double)

        Dim db As Database = HostApplicationServices.WorkingDatabase
        Using trans As Transaction = db.TransactionManager.StartTransaction
            Dim bt As BlockTable = trans.GetObject(db.BlockTableId, OpenMode.ForRead)
            If (bt.Has(blockName) = False) Then
                Return
            End If
            Dim block As BlockTableRecord = trans.GetObject(bt(blockName), OpenMode.ForRead)
            Dim blockref As BlockReference = New BlockReference(point, bt(blockName))
            blockref.ScaleFactors = scale
            blockref.Rotation = rotateAngle
            Dim btr As BlockTableRecord = trans.GetObject(db.CurrentSpaceId, OpenMode.ForWrite)
            btr.AppendEntity(blockref)
            trans.AddNewlyCreatedDBObject(blockref, True)
            '获取blockName块的遍历器，以实现对块中对象的访问
            Dim iterator As BlockTableRecordEnumerator = block.GetEnumerator()
            '如果blockName块包含属性
            If block.HasAttributeDefinitions Then
                '利用块遍历器对块中的对象进行遍历
                While iterator.MoveNext
                    '获取块遍历器当前指向的块中的对象
                    Dim obj As DBObject = trans.GetObject(iterator.Current, OpenMode.ForRead)
                    '定义一个新的属性参照对象
                    Dim att As New AttributeReference()
                    '判断块遍历器当前指向的块中的对象是否为属性定义
                    If TypeOf (obj) Is AttributeDefinition Then
                        '获取属性定义对象
                        Dim attdef As AttributeDefinition = obj
                        '从属性定义对象中继承相关的属性到属性参照对象中
                        att.SetAttributeFromBlock(attdef, blockref.BlockTransform)
                        '设置属性参照对象的位置为属性定义的位置+块参照的位置
                        att.Position = attdef.Position + blockref.Position.GetAsVector()
                        '判断属性定义的名称
                        Select Case attdef.Tag
                            '设置块参照的属性值
                            Case "孔号"
                                att.TextString = KHstring
                            Case "孔深"
                                att.TextString = FormatNumber(KSdouble, 2)

                        End Select
                        '判断块参照是否可写，如不可写，则切换为可写状态
                        If Not blockref.IsWriteEnabled Then
                            blockref.UpgradeOpen()
                        End If
                        '添加新创建的属性参照
                        blockref.AttributeCollection.AppendAttribute(att)
                        '通知事务处理添加新创建的属性参照
                        trans.AddNewlyCreatedDBObject(att, True)
                    End If
                End While
            End If
            trans.Commit() '提交事务处理
        End Using
    End Sub

    ''' <summary>
    ''' 创建文本样式
    ''' </summary>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Shared Function CreateStyle() As ObjectId
        Dim TextstyleId As New ObjectId
        Dim db As Database = HostApplicationServices.WorkingDatabase
        Using trans As Transaction = db.TransactionManager.StartTransaction
            ' 得到文字样式表
            Dim st As TextStyleTable = trans.GetObject(db.TextStyleTableId, OpenMode.ForWrite)
            Dim StyleName As String = "hzhz"
            ' 如果文字样式不存在，则新建一个文字样式.
            If st.Has(StyleName) = False Then
                ' 新建一个文字样式表记录.
                Dim str As New TextStyleTableRecord()
                ' 设置文字样式名.
                str.Name = StyleName
                ' 设置TrueType字体(黑体）
                str.FileName = "SIMHEI.TTF"
                '---------------------------------------------
                ' 设置SHX字体
                ' str.FileName = "gbenor"
                ' 设置大字体.
                ' str.BigFontFileName = "gbcbig"
                ' --------------------------------------------
                ' 设置倾斜角(弧度).
                'str.ObliquingAngle = 15 * Math.PI / 180
                ' 设置宽度比例.
                'str.XScale = 0.67
                ' 把文字样式表记录添加到文字样式表中.
                TextstyleId = st.Add(str)
                ' 把文字样式表记录添加到事务处理中.
                trans.AddNewlyCreatedDBObject(str, True)
                ' 将文字样式设置为当前文字样式
                db.Textstyle = TextstyleId
                trans.Commit()
            Else
                TextstyleId = st(StyleName)
            End If
        End Using
    End Function
End Class

我在工程项目添加了一个窗体及一个按钮,按钮的单击事件代码如下:

Imports System.Data.OleDb
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.Geometry

Public Class Form1

Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click

        Me.OpenFileDialog1.Title = "打开展点文件"
        Me.OpenFileDialog1.Filter = "Excle 文件(*.xls)|*xls"
        Me.OpenFileDialog1.FileName = ""
        If Me.OpenFileDialog1.ShowDialog() = Windows.Forms.DialogResult.OK Then
            Dim PathString As String = Me.OpenFileDialog1.FileName
            Dim strConn As String = "Provider=Microsoft.Jet.OLEDB.4.0;" + "Data Source=" + PathString + ";" + "Extended Properties='Excel 8.0;HDR=NO;IMEX=1';"
            Dim strExcel As String = "select * from [sheet1$]"

            Dim conn As New OleDbConnection
            Try
                conn = New OleDbConnection(strConn)
                conn.Open()
                Dim cmd As OleDbCommand = New OleDbCommand(strExcel, conn)
                Dim read As OleDbDataReader = cmd.ExecuteReader()

                '得到当前文档图形数据库.
                Dim db As Database = HostApplicationServices.WorkingDatabase
                '图形文档加锁
                Using Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.LockDocument()

                    '创建图块
                    CreateBlock.createBlockJK()
                    CreateBlock.createBlockMK()
                    CreateBlock.createBlockTC()
                    CreateBlock.createBlockZK()
                    CreateBlock.createBlockSZB()

Using trans As Transaction = db.TransactionManager.StartTransaction

                        '以读方式打开块表.
                        Dim bt As BlockTable = trans.GetObject(db.BlockTableId, OpenMode.ForRead)
                        '以写方式打开模型空间块表记录.
                        Dim btr As BlockTableRecord = trans.GetObject(bt(BlockTableRecord.ModelSpace), OpenMode.ForWrite)

While read.Read()

                            '获取坐标值
                            Dim strX As String = read.GetValue(2)
                            Dim strY As String = read.GetValue(3)
                            Dim strZ As String = read.GetValue(4)

                            If IsNumeric(strX) And IsNumeric(strY) And IsNumeric(strZ) Then
                                Dim pt As New Point3d(CDbl(strX), CDbl(strY), CDbl(strZ))
                                Dim strBlockName As String
                                Select Case read.GetString(1)
                                    Case "静力触探孔", "静力触探", "静探"
                                        strBlockName = "JK"
                                    Case "十字板孔", "十字板试验孔", "十字板"
                                        strBlockName = "SZB"
                                    Case "槽探", "探槽"
                                        strBlockName = "TC"
                                    Case "麻花钻", "麻花钻孔", "螺纹钻", "螺纹钻孔"
                                        strBlockName = "MK"
                                    Case Else
                                        strBlockName = "ZK"
                                End Select

                                '获取深度值
                                Dim douSD As Double
                                Dim strSD As String = read.GetValue(5)
                                If IsNumeric(strSD) Then
                                    douSD = CDbl(strSD)
                                Else
                                    douSD = 0.0
                                End If
                                Dim createEntity As New CreateEntity()
                                createEntity.InsertBlockRefWithAtt(strBlockName, pt, New Scale3d(1), 0, read.GetString(0), douSD)
                            End If
                        End While
                        trans.Commit()
                    End Using
                End Using
                Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.SendStringToExecute("zoom e ", True, False, False)
            Catch

            End Try
            conn.Close()
            Me.Close()
        End If
    End Sub
End Class