怎么用了这个宏后，就打不开＂坐标＂这个excel表格了

licong

＇调用这个宏后,就打不开"坐标"这个excel表格了,这是怎么回事,请高手指点一下

Private Sub draw()
          Dim xlsApp     As Excel.Application
          Dim eworkbook     As Workbook
          Dim eworksheet     As Worksheet
          Dim cir(0 To 1) As AcadEntity
          Dim b(0 To 2) As Double, g(0 To 2) As Double
          Dim c  As Double
          Dim x As Acad3DSolid
          Dim d As Double
          Dim e As Double
          Dim f As Double
          Dim re As Variant
          Dim height(0 To 1) As Double
         
                         e = 0
          Set xlsApp = New Excel.Application
          Set eworkbook = xlsApp.Workbooks.Open("F:\国道112\坐标.xls")
          Set eworksheet = eworkbook.Sheets("8标的桥位坐标表")
      
            For i = 4 To 118
            
             With eworksheet
            
                 b(0) = .Cells(i, 4)
                 b(1) = .Cells(i, 5)
                 b(2) = .Cells(i, 6)
                    c = .Cells(i, 7)
                    height(0) = .Cells(i, 8)
                 g(0) = .Cells(i + 1, 4)
                 g(1) = .Cells(i + 1, 5)
                 g(2) = .Cells(i + 1, 6)
                    f = .Cells(i + 1, 7)
                    height(1) = .Cells(i + 1, 8)
         
             End With
            
             Set cir(0) = ThisDrawing.ModelSpace.addcircle(b, c)
             Set cir(1) = ThisDrawing.ModelSpace.addcircle(g, f)
            
             re = ThisDrawing.ModelSpace.AddRegion(cir)
            
        
                                            
          Set x = ThisDrawing.ModelSpace.AddExtrudedSolid(re(0), -height(0), e) '此中的re(0),即acadregion必须为一个域，而不是一个数组。
          Set x = ThisDrawing.ModelSpace.AddExtrudedSolid(re(1), -height(1), e)
         
              i = i + 2
            
              Next i
            
             ZoomAll
             eworkbook.Close
             xlsApp.Quit
            
          'eworkbook.Save
          Set xlsApp = Nothing
          Set eworkbook = Nothing
          Set eworksheet = Nothing
                                  
         End Sub

laoliu09

标准连接excel方法如下：

on error resume next

Set xlsApp =CreateObject(,"excel.Application")

if err then

    err.Clear

    Set xlsApp =GetObject(,"excel.Application")

    if err then

         msgbox "请先安装excel"

         exit sub

    end if 

end if

 

licong

不好意思,我不太懂这个,这一段程序应该放在什么位置?

我放在了声明后面,出错提示:参数不可选

Private Sub draw()
          '引用   Microsoft   Excel   11.0   Object   Library
          Dim xlsApp     As Excel.Application
          Dim eworkbook     As Workbook
          Dim eworksheet     As Worksheet
          Dim cir(0 To 1) As AcadEntity
          Dim b(0 To 2) As Double, g(0 To 2) As Double
          Dim c  As Double
          Dim x As Acad3DSolid
          Dim d As Double
          Dim e As Double
          Dim f As Double
          Dim re As Variant
          Dim height(0 To 1) As Double
         
          On Error Resume Next

            Set xlsApp = CreateObject(, "excel.Application")

                If Err Then

                   Err.Clear

                   Set xlsApp = GetObject(, "excel.Application")

                      If Err Then

                      MsgBox "请先安装excel"

                 Exit Sub

                       End If

                 End If
         
            e = 0
                        
          'Set xlsApp = New Excel.Application
          Set eworkbook = xlsApp.Workbooks.Open("F:\国道112\坐标.xls")
          Set eworksheet = eworkbook.Sheets("8标的桥位坐标表")
      
            For i = 4 To 118
            
             With eworksheet
            
                 b(0) = .Cells(i, 4)
                 b(1) = .Cells(i, 5)
                 b(2) = .Cells(i, 6)
                    c = .Cells(i, 7)
                    height(0) = .Cells(i, 8)
                 g(0) = .Cells(i + 1, 4)
                 g(1) = .Cells(i + 1, 5)
                 g(2) = .Cells(i + 1, 6)
                    f = .Cells(i + 1, 7)
                    height(1) = .Cells(i + 1, 8)
         
             End With
            
             Set cir(0) = ThisDrawing.ModelSpace.addcircle(b, c)
             Set cir(1) = ThisDrawing.ModelSpace.addcircle(g, f)
            
             re = ThisDrawing.ModelSpace.AddRegion(cir)
            
        
                                            
          Set x = ThisDrawing.ModelSpace.AddExtrudedSolid(re(0), -height(0), e) '此中的re(0),即acadregion必须为一个域，而不是一个数组。
          Set x = ThisDrawing.ModelSpace.AddExtrudedSolid(re(1), -height(1), e)
         
              i = i + 2
            
              Next i
            
             ZoomAll
             eworkbook.Close
             xlsApp.Quit
            
          'eworkbook.Save
          Set xlsApp = Nothing
          Set eworkbook = Nothing
          Set eworksheet = Nothing
                                  
         End Sub

再请指教一下,谢谢了!

licong

并且这按以前的做最以后还有一个问题就是会出现图形退化，请高手指点一下，这是怎么回事，程序如何更改一下呢？