[求助]我写的cad vba读取excel文件数据，总是不能完全通过
<p>Sub shuru()<br/>Dim i, row As Integer<br/>Dim j, k As Integer<br/>Dim time(300) As String<br/>Dim zmax, q2max As Double<br/>Dim pmax, xh(300) As Double<br/>Dim z(300), q1(300) As Double<br/>Dim q2(300), p(300) As Double<br/>Dim point1(599), point2(2) As Double<br/>Dim centerp(2) As Double<br/>Dim courtlay1, courtlay2, courtlay3, courtlay4 As ACAD_LAYER<br/>Dim Excel As Excel.Application<br/>Dim ExcelSheet As Object<br/>Dim ExcelWorkbook As Object<br/>Dim zl As Object<br/>Dim q1l As Object<br/>Dim q2l As Object<br/>Dim pl As Object<br/>'创建Excel应用程序<br/>On Error Resume Next<br/> Set Excel = GetObject(, "Excel.Application")<br/>If Err <> 0 Then<br/> Set Excel = CreateObject("Excel.Application")<br/>End If<br/>Set ExcelWorkbook = Excel.Workbooks.Open("d:\基础数据.xls") '(App.Path & "\数据\基础数据.xls") '打开已经存在的EXCEL工件簿文件<br/>Set ExcelWorkbook.Visible = True<br/>Set ExcelSheet = ExcelWorkbook.Worksheets("基础数据") '设置活动工作表，sheet1表示表名，可以使用字符型变量代替。<br/>ExcelSheet.Activate '激活工作表，让它处于前台活动中。</p><p>row = ExcelSheet.cells(1, 2).Value '获得数据条数<br/>zmax = ExcelSheet.cells(2, 2).Value '获得水位轴最大值<br/>q2max = ExcelSheet.cells(3, 2).Value '获得流量轴最大值<br/>pmax = ExcelSheet.cells(4, 2).Value ' 获得雨量轴最大值<br/>MsgBox "row=" & row<br/>For i = 1 To row ' 从excel文件中读取数据<br/> xh(i) = ExcelSheet.cells(i + 5, 1).Value<br/> time(i) = ExcelSheet.cells(i + 5, 2).Value<br/> z(i) = ExcelSheet.cells(i + 5, 3).Value<br/> p(i) = ExcelSheet.cells(i + 5, 4).Value<br/> q1(i) = ExcelSheet.cells(i + 5, 5).Value<br/> q2(i) = ExcelSheet.cells(i + 5, 6).Value<br/>Next<br/>centerp(0) = 15 '设置中心点坐标<br/>centerp(1) = 10<br/>Set courtlay1 = ThisDrawing.Layers.Add("过程线") '设置图层<br/>Set courtlay2 = ThisDrawing.Layers.Add("坐标轴")<br/>Set courtlay3 = ThisDrawing.Layers.Add("标题")<br/>ThisDrawing.ActiveLayer = courtlay1 '确定当前图层<br/>'画绘图区<br/>point2(0) = (row + 2) * 1.5 + 15<br/>point2(1) = zmax + pmax * 2# + 10<br/>Call drawbox(Center, point2)<br/>'画水位过程线<br/>point1(0) = 15 + 1.5 - 0.75<br/>point1(1) = 10<br/>For i = 1 To row<br/> point1(2 * i) = 15 + (i + 1) * 1.5 - 0.75<br/> point1(2 * i + 1) = z(i)<br/>Next<br/>Set zl = ThisDrawing.ModelSpace.AddLightWeightPolyline(point1)<br/>ZoomExtents<br/>End Sub<br/> '根据对角线坐标画矩形的子程序<br/>Private Sub drawbox(p1, p2)<br/>Dim boxp(0 To 14) As Double<br/>boxp(0) = p1(0)<br/>boxp(1) = p1(1)<br/>boxp(3) = p1(0)<br/>boxp(4) = p2(1)<br/>boxp(6) = p2(0)<br/>boxp(7) = p2(1)<br/>boxp(9) = p2(0)<br/>boxp(10) = p1(1)<br/>boxp(12) = p1(0)<br/>boxp(13) = p1(1)<br/>Call ThisDrawing.ModelSpace.AddPolyline(boxp)<br/>End Sub</p><p></p><p>这段程序总是不能完整通过，总在给zmax赋值的这里开始就不能完成了（row的赋值是可以的），请帮我看看是怎么了（我的数据库文件放在D盘根目录下）。</p> 基础数据.xls文件有问题了。 我把文件上传上来，你帮我看看好吗？ <p></p><p>谢谢 <strong><font face="Verdana" color="#61b713">fjfhgdwfn ，是excel文件的问题，现在读数据和画矩形都可以了，但是最后一步画多段线还是画不出来（point数据都是正确的，就最后一步不成功啊）。</font></strong></p> point1可以定义成动态的吧。没有必要后边的都是0值吧！没有看到哪有问题 <p>Sub shuru()<br/>Dim i, row As Integer<br/>Dim j, k As Integer<br/>Dim time(300) As String<br/>Dim zmax, q2max As Double<br/>Dim pmax, xh(300) As Double<br/>Dim z(300), q1(300) As Double<br/>Dim q2(300), p(300) As Double<br/>Dim point2(2) As Double<br/>Dim centerp(2) As Double<br/>Dim courtlay1, courtlay2, courtlay3, courtlay4 As ACAD_LAYER<br/>Dim Excel As Excel.Application<br/>Dim ExcelSheet As Object<br/>Dim ExcelWorkbook As Object<br/>Dim zl As Object<br/>Dim q1l As Object<br/>Dim q2l As Object<br/>Dim pl As Object<br/>'创建Excel应用程序<br/>On Error Resume Next<br/> Set Excel = GetObject(, "Excel.Application")<br/>If Err <> 0 Then<br/> Set Excel = CreateObject("Excel.Application")<br/>End If<br/>Set ExcelWorkbook = Excel.Workbooks.Open("d:\基础数据.xls") '(App.Path & "\数据\基础数据.xls") '打开已经存在的EXCEL工件簿文件<br/>Set ExcelWorkbook.Visible = True<br/>Set ExcelSheet = ExcelWorkbook.Worksheets("基础数据") '设置活动工作表，sheet1表示表名，可以使用字符型变量代替。<br/>ExcelSheet.Activate '激活工作表，让它处于前台活动中。</p><p>row = ExcelSheet.cells(1, 2).Value '获得数据条数<br/>zmax = ExcelSheet.cells(2, 2).Value '获得水位轴最大值<br/>q2max = ExcelSheet.cells(3, 2).Value '获得流量轴最大值<br/>pmax = ExcelSheet.cells(4, 2).Value ' 获得雨量轴最大值<br/>MsgBox "row=" & row<br/>For i = 1 To row ' 从excel文件中读取数据<br/> xh(i) = ExcelSheet.cells(i + 5, 1).Value<br/> time(i) = ExcelSheet.cells(i + 5, 2).Value<br/> z(i) = ExcelSheet.cells(i + 5, 3).Value<br/> p(i) = ExcelSheet.cells(i + 5, 4).Value<br/> q1(i) = ExcelSheet.cells(i + 5, 5).Value<br/> q2(i) = ExcelSheet.cells(i + 5, 6).Value<br/>Next<br/>centerp(0) = 15 '设置中心点坐标<br/>centerp(1) = 10<br/>Set courtlay1 = ThisDrawing.Layers.Add("过程线") '设置图层<br/>Set courtlay2 = ThisDrawing.Layers.Add("坐标轴")<br/>Set courtlay3 = ThisDrawing.Layers.Add("标题")<br/>ThisDrawing.ActiveLayer = courtlay1 '确定当前图层<br/>'画绘图区<br/>point2(0) = (row + 2) * 1.5 + 15<br/>point2(1) = zmax + pmax * 2# + 10<br/><font color="#f70968">Call drawbox(centerp, point2)</font><br/>'画水位过程线<br/><font color="#ff0033">Dim point1(599) As Double</font><br/>point1(0) = 15 + 1.5 - 0.75<br/>point1(1) = 10<br/>For i = 1 To row<br/> point1(2 * i) = 15 + (i + 1) * 1.5 - 0.75<br/> point1(2 * i + 1) = z(i)<br/>Next<br/>Set zl = ThisDrawing.ModelSpace.AddLightWeightPolyline(point1)<br/>ZoomExtents<br/>End Sub<br/> '根据对角线坐标画矩形的子程序<br/>Private Sub drawbox(p1, p2)<br/>Dim boxp(0 To 14) As Double<br/>boxp(0) = p1(0)<br/>boxp(1) = p1(1)<br/>boxp(3) = p1(0)<br/>boxp(4) = p2(1)<br/>boxp(6) = p2(0)<br/>boxp(7) = p2(1)<br/>boxp(9) = p2(0)<br/>boxp(10) = p1(1)<br/>boxp(12) = p1(0)<br/>boxp(13) = p1(1)<br/>Call ThisDrawing.ModelSpace.AddPolyline(boxp)<br/>End Sub</p><p><br/>把数组定义到下边就可以了，不知道什么原因啊。再有你有一个写错了。看红色部分了。</p> <p> 谢谢 <strong><font face="Verdana" color="#61b713">fjfhgdwfn，现在图像基本能完成！</font></strong></p><p><strong><font face="Verdana" color="#61b713"> 图可以出来了，但是那个多段线在最后总是默认连到坐标原点（0，0）上，这个该怎么解决下才能使它在我最后给出的那个点上那？</font></strong></p> 本帖最后由 作者 于 2008-9-26 15:21:28 编辑 <br /><br /> Dim point1() As Double<br/>ReDim point1(row * 2 + 1)<br/> <p>其它地方需要怎样设置那？比如循环次数怎样设置，画线的最后点的坐标该是怎样的等？</p><p>还有，我要写文本，正常情况下文本总是水平方向的，当我需要把时间立起来写，也就是时间文本行为垂直方向？</p> 看看TEXT的属性了，可以旋转的。
页:
[1]