能不能帮我看看那里错了！！！！！！！！！！！

登山

Dim acadapp As AcadApplication
Dim d1() As Double
Dim d2() As Double
Dim d0() As Double
Dim data() As String
Dim shuju() As Double
Dim b As Variant
Dim splineobj As Acad3DPolyline
Dim orig(2) As Double
Dim za(2) As Double
Dim xa(2) As Double
Dim ya(2) As Double
Private Sub Command1_Click()
ReDim data(0)
i = 0
Open "E:\12月\菜单12.9\barrel.dat" For Input As #1
Do While Not EOF(1)
Line Input #1, data(i)
i = i + 1
ReDim Preserve data(i)
Loop
Close #1
ReDim d1(i - 1, 3)
ReDim d2(i - 1, 3)
ReDim d0(i - 1, 3)
For j = 0 To i - 1
b = Split(data(j), " ")
d1(j, 0) = Val(b(2))
d1(j, 1) = Val(b(3))
d1(j, 2) = Val(b(4))
d2(j, 0) = Val(b(5))
d2(j, 1) = Val(b(6))
d2(j, 2) = Val(b(7))
d0(j, 0) = (d1(j, 0) + d2(j, 0)) / 2
d0(j, 1) = (d1(j, 1) + d2(j, 1)) / 2
d0(j, 2) = (d1(j, 2) + d2(j, 2)) / 2 Next
ReDim shuju(3 * i - 1)
For j = 0 To i - 1
shuju(3 * j) = d0(j, 0)
shuju(3 * j + 1) = d0(j, 1)
shuju(3 * j + 2) = d0(j, 2)
Next orig(0) = shuju(0)
orig(1) = shuju(1)
orig(2) = shuju(2)
za(0) = shuju(3)
za(1) = shuju(4)
za(2) = shuju(5)
Dim points(0 To 7) As Double
points(0) = 7.5: points(1) = -15
points(2) = 7.5: points(3) = 15
points(4) = -7.5: points(5) = 15
points(6) = -7.5: points(7) = -15
Dim curves(0 To 0) As AcadLWPolyline
Set curves(0) = acadapp.ActiveDocument.ModelSpace.AddLightWeightPolyline(points)
curves(0).Closed = True
Set splineobj = acadapp.ActiveDocument.ModelSpace.Add3DPoly(shuju) Call axis(orig(), za(), xa(), ya())
Dim ucsobj As AcadUCS
Set ucsobj = acadapp.ActiveDocument.UserCoordinateSystems.Add(orig, xa, ya, "ucs1") acadapp.ActiveDocument.ActiveUCS = ucsobj
transmatrix = ucsobj.GetUCSMatrix() Dim transmartrix As Variant
curves(0).TransformBy (transmatrix)
Dim regionobj(0 To 0) As Variant
regionobj(0) = acadapp.ActiveDocument.ModelSpace.AddRegion(curves) Dim solidobj As Acad3DSolid
Set solidobj = acadapp.ActiveDocument.ModelSpace.AddExtrudedSolidAlongPath(regionobj(0), splineobj) End Sub Private Sub Form_Load()
On Error Resume Next
Set acadapp = GetObject(, "AutoCAD.application")
If Err Then
Err.Clear
Set acadapp = CreateObject("autocad.application")
If Err Then
MsgBox ("不能运行autocad 2000,请检查是否安装了autocad 2000")
Exit Sub
End If
End If
acadapp.Visible = True
End Sub

登山

拉深时出错，提示要求对象

mccad

AddRegion方法得到的是对象数组，而不是单纯的对象，就算对象数组中只有一个对象也是这样。
所以要取得对象数组regionobj中的对象，可以使用regionobj(0)取得。
所以你的
Dim regionobj(0 To 0) As Variant
这句直接改成
Dim regionobj As Variant

登山

谢了！