[求助]我写的cad vba读取excel文件数据，总是不能完全通过

西北风

Sub shuru()
Dim i, row As Integer
Dim j, k As Integer
Dim time(300) As String
Dim zmax, q2max As Double
Dim pmax, xh(300) As Double
Dim z(300), q1(300) As Double
Dim q2(300), p(300) As Double
Dim point1(599), point2(2) As Double
Dim centerp(2) As Double
Dim courtlay1, courtlay2, courtlay3, courtlay4 As ACAD_LAYER
Dim Excel   As Excel.Application
Dim ExcelSheet   As Object
Dim ExcelWorkbook   As Object
Dim zl As Object
Dim q1l As Object
Dim q2l As Object
Dim pl As Object
'创建Excel应用程序
On Error Resume Next
  Set Excel = GetObject(, "Excel.Application")
If Err <> 0 Then
    Set Excel = CreateObject("Excel.Application")
End If
Set ExcelWorkbook = Excel.Workbooks.Open("d:\基础数据.xls") '(App.Path & "\数据\基础数据.xls") '打开已经存在的EXCEL工件簿文件
Set ExcelWorkbook.Visible = True
Set ExcelSheet = ExcelWorkbook.Worksheets("基础数据") '设置活动工作表，sheet1表示表名，可以使用字符型变量代替。
ExcelSheet.Activate '激活工作表，让它处于前台活动中。

row = ExcelSheet.cells(1, 2).Value '获得数据条数
zmax = ExcelSheet.cells(2, 2).Value '获得水位轴最大值
q2max = ExcelSheet.cells(3, 2).Value '获得流量轴最大值
pmax = ExcelSheet.cells(4, 2).Value ' 获得雨量轴最大值
MsgBox "row=" & row
For i = 1 To row ' 从excel文件中读取数据
  xh(i) = ExcelSheet.cells(i + 5, 1).Value
  time(i) = ExcelSheet.cells(i + 5, 2).Value
  z(i) = ExcelSheet.cells(i + 5, 3).Value
  p(i) = ExcelSheet.cells(i + 5, 4).Value
  q1(i) = ExcelSheet.cells(i + 5, 5).Value
  q2(i) = ExcelSheet.cells(i + 5, 6).Value
Next
centerp(0) = 15 '设置中心点坐标
centerp(1) = 10
Set courtlay1 = ThisDrawing.Layers.Add("过程线") '设置图层
Set courtlay2 = ThisDrawing.Layers.Add("坐标轴")
Set courtlay3 = ThisDrawing.Layers.Add("标题")
ThisDrawing.ActiveLayer = courtlay1 '确定当前图层
'画绘图区
point2(0) = (row + 2) * 1.5 + 15
point2(1) = zmax + pmax * 2# + 10
Call drawbox(Center, point2)
'画水位过程线
point1(0) = 15 + 1.5 - 0.75
point1(1) = 10
For i = 1 To row
   point1(2 * i) = 15 + (i + 1) * 1.5 - 0.75
   point1(2 * i + 1) = z(i)
Next
Set zl = ThisDrawing.ModelSpace.AddLightWeightPolyline(point1)
ZoomExtents
End Sub
 '根据对角线坐标画矩形的子程序
Private Sub drawbox(p1, p2)
Dim boxp(0 To 14) As Double
boxp(0) = p1(0)
boxp(1) = p1(1)
boxp(3) = p1(0)
boxp(4) = p2(1)
boxp(6) = p2(0)
boxp(7) = p2(1)
boxp(9) = p2(0)
boxp(10) = p1(1)
boxp(12) = p1(0)
boxp(13) = p1(1)
Call ThisDrawing.ModelSpace.AddPolyline(boxp)
End Sub

这段程序总是不能完整通过，总在给zmax赋值的这里开始就不能完成了（row的赋值是可以的），请帮我看看是怎么了（我的数据库文件放在D盘根目录下）。

fjfhgdwfn

基础数据.xls文件有问题了。

西北风

我把文件上传上来，你帮我看看好吗？

西北风

谢谢 fjfhgdwfn ，是excel文件的问题，现在读数据和画矩形都可以了，但是最后一步画多段线还是画不出来（point数据都是正确的，就最后一步不成功啊）。

fjfhgdwfn

point1可以定义成动态的吧。没有必要后边的都是0值吧！没有看到哪有问题

fjfhgdwfn

Sub shuru()
Dim i, row As Integer
Dim j, k As Integer
Dim time(300) As String
Dim zmax, q2max As Double
Dim pmax, xh(300) As Double
Dim z(300), q1(300) As Double
Dim q2(300), p(300) As Double
Dim point2(2) As Double
Dim centerp(2) As Double
Dim courtlay1, courtlay2, courtlay3, courtlay4 As ACAD_LAYER
Dim Excel   As Excel.Application
Dim ExcelSheet   As Object
Dim ExcelWorkbook   As Object
Dim zl As Object
Dim q1l As Object
Dim q2l As Object
Dim pl As Object
'创建Excel应用程序
On Error Resume Next
  Set Excel = GetObject(, "Excel.Application")
If Err <> 0 Then
    Set Excel = CreateObject("Excel.Application")
End If
Set ExcelWorkbook = Excel.Workbooks.Open("d:\基础数据.xls") '(App.Path & "\数据\基础数据.xls") '打开已经存在的EXCEL工件簿文件
Set ExcelWorkbook.Visible = True
Set ExcelSheet = ExcelWorkbook.Worksheets("基础数据") '设置活动工作表，sheet1表示表名，可以使用字符型变量代替。
ExcelSheet.Activate '激活工作表，让它处于前台活动中。

row = ExcelSheet.cells(1, 2).Value '获得数据条数
zmax = ExcelSheet.cells(2, 2).Value '获得水位轴最大值
q2max = ExcelSheet.cells(3, 2).Value '获得流量轴最大值
pmax = ExcelSheet.cells(4, 2).Value ' 获得雨量轴最大值
MsgBox "row=" & row
For i = 1 To row ' 从excel文件中读取数据
  xh(i) = ExcelSheet.cells(i + 5, 1).Value
  time(i) = ExcelSheet.cells(i + 5, 2).Value
  z(i) = ExcelSheet.cells(i + 5, 3).Value
  p(i) = ExcelSheet.cells(i + 5, 4).Value
  q1(i) = ExcelSheet.cells(i + 5, 5).Value
  q2(i) = ExcelSheet.cells(i + 5, 6).Value
Next
centerp(0) = 15 '设置中心点坐标
centerp(1) = 10
Set courtlay1 = ThisDrawing.Layers.Add("过程线") '设置图层
Set courtlay2 = ThisDrawing.Layers.Add("坐标轴")
Set courtlay3 = ThisDrawing.Layers.Add("标题")
ThisDrawing.ActiveLayer = courtlay1 '确定当前图层
'画绘图区
point2(0) = (row + 2) * 1.5 + 15
point2(1) = zmax + pmax * 2# + 10
Call drawbox(centerp, point2)
'画水位过程线
Dim point1(599) As Double
point1(0) = 15 + 1.5 - 0.75
point1(1) = 10
For i = 1 To row
   point1(2 * i) = 15 + (i + 1) * 1.5 - 0.75
   point1(2 * i + 1) = z(i)
Next
Set zl = ThisDrawing.ModelSpace.AddLightWeightPolyline(point1)
ZoomExtents
End Sub
 '根据对角线坐标画矩形的子程序
Private Sub drawbox(p1, p2)
Dim boxp(0 To 14) As Double
boxp(0) = p1(0)
boxp(1) = p1(1)
boxp(3) = p1(0)
boxp(4) = p2(1)
boxp(6) = p2(0)
boxp(7) = p2(1)
boxp(9) = p2(0)
boxp(10) = p1(1)
boxp(12) = p1(0)
boxp(13) = p1(1)
Call ThisDrawing.ModelSpace.AddPolyline(boxp)
End Sub

把数组定义到下边就可以了，不知道什么原因啊。再有你有一个写错了。看红色部分了。

西北风

     谢谢 fjfhgdwfn，现在图像基本能完成！

       图可以出来了，但是那个多段线在最后总是默认连到坐标原点（0，0）上，这个该怎么解决下才能使它在我最后给出的那个点上那？

fjfhgdwfn

Dim point1() As Double
ReDim point1(row * 2 + 1)

西北风

其它地方需要怎样设置那？比如循环次数怎样设置，画线的最后点的坐标该是怎样的等？

还有，我要写文本，正常情况下文本总是水平方向的，当我需要把时间立起来写，也就是时间文本行为垂直方向？

fjfhgdwfn

看看TEXT的属性了，可以旋转的。