|
|
问一下,图形退化是怎么回事?
程序如下:
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
e = 0
Set xlsApp = New Excel.Application
Set eworkbook = xlsApp.Workbooks.Open("F:\国道112\坐标.xls")
Set eworksheet = eworkbook.Sheets("8标的桥位坐标表")
For j = 4 To 20
For i = 4 To 118
With eworksheet
b(0) = .Cells(i, j)
b(1) = .Cells(i, j + 1)
b(2) = .Cells(i, j + 2)
c = .Cells(i, j + 3)
height(0) = .Cells(i, j + 4)
g(0) = .Cells(i + 1, j)
g(1) = .Cells(i + 1, j + 1)
g(2) = .Cells(i + 1, j + 2)
f = .Cells(i + 1, j + 3)
height(1) = .Cells(i + 1, j + 4)
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
j = j + 16
Next j
ZoomAll
eworkbook.Close
xlsApp.Quit
'eworkbook.Save
Set xlsApp = Nothing
Set eworkbook = Nothing
Set eworksheet = Nothing
End Sub
哪位高手给看一下是哪出问题了?
|
|
置顶卡
