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

根据网友的需求,编写此程序:读取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
                '在块表中加入块
   &nb