|
|
发表于 2003-5-21 22:06:00
|
显示全部楼层
Sub tulun()
Dim tulunobj As Acad3DSolid
Dim curves(0 To 3) As AcadEntity
Dim points(0 To 5) As Double
Dim points1(0 To 5) As Double
Dim x1 As Double
Dim x2 As Double
Dim y1 As Double
Dim y2 As Double
Dim n1 As Double
Dim n2 As Double
Dim m1 As Double
Dim m2 As Double
Dim centpoint(0 To 2) As Double
Dim radius As Double
Dim sangle As Double
Dim eangle As Double
Dim sangle1 As Double
'定义参数
x1 = 0
y1 = 0
n1 = 0
m1 = 0
centpoint(0) = 4
centpoint(1) = 0
centpoint(2) = 0
radius = 8
sangle = 3 * 3.1415926 / 2
eangle = 3.1415926 / 2
sangle1 = 0
Dim tPt(0 To 2) As Double '这里增加了一个三维的Double数组，用于存放顶点
Do While x1 < 4
x2 = x1 + 0.1
y2 = Sqr(16 * x2)
points(0) = x1: points(1) = y1: points(2) = 0
points(3) = x2: points(4) = y2: points(5) = 0
tPt(0) = points(3): tPt(1) = points(4): tPt(2) = points(5)
If curves(0) Is Nothing Then
Set curves(0) = ThisDrawing.ModelSpace.AddPolyline(points)
Else
curves(0).AppendVertex tPt '改用AppendVertex来对刚生成的多义线添加顶点，新增的顶点为多义线的最后一点
End If
x1 = x2
y1 = y2
Loop
Do While n1 < 4
n2 = n1 + 0.1
m2 = Sqr(16 * n2) * (-1)
points1(0) = n1: points1(1) = m1: points1(2) = 0
points1(3) = n2: points1(4) = m2: points1(5) = 0
tPt(0) = points1(3): tPt(1) = points1(4): tPt(2) = points1(5)
If curves(1) Is Nothing Then
Set curves(1) = ThisDrawing.ModelSpace.AddPolyline(points1)
Else
curves(1).AppendVertex tPt
End If
n1 = n2
m1 = m2
Loop
Set curves(2) = ThisDrawing.ModelSpace.AddArc(centpoint, radius, sangle, sangle1)
Set curves(3) = ThisDrawing.ModelSpace.AddArc(centpoint, radius, sangle1, eangle)
Dim regionobj As Variant '这里应该为Variant类型
regionobj = ThisDrawing.ModelSpace.AddRegion(curves)
Dim height As Double
Dim langle As Double
height = 10
langle = 0
Set tulunobj = ThisDrawing.ModelSpace.AddExtrudedSolid(regionobj(0), height, langle)
End Sub |
|
置顶卡
