Private Sub Command1_Click()
Dim pt1(0 To 2) As Double
Dim pt2(0 To 2) As Double
Dim pt0(0 To 2) As Double
Dim d1 As Double
Dim d2 As Double
Dim hui As Acad3DSolid
Dim circle1 As AcadCircle
Dim circle2 As AcadCircle
Dim h As Double
Dim d0 As Double
Dim angle As Double
d0 = Me.Text4
h = Me.Text5
d1 = Me.Text1
d2 = Me.Text2
If d0 > d1 Then
MsgBox "输入错误,请重新输入!"
End If
If d0 > d2 Then
MsgBox "输入错误,请重新输入!"
End If
angle = Atn(Sqr(d1 * d1 - d0 * d0) / d0) + Atn(Sqr(d2 * d2 - d0 * d0) / d0)
pt1(0) = 0: pt1(1) = 0: pt1(2) = 0
pt2(0) = 0: pt2(1) = 0: pt2(2) = -h
Set circle1 = ActiveDocument.ModelSpace.AddCircle(pt1, d1 / 2)
circle1.Color = acGreen
Set circle2 = ActiveDocument.ModelSpace.AddCircle(pt2, d2 / 2)
circle2.Color = acGreen
Dim i As Integer
Dim x1(0 To 360) As Double
Dim y1(0 To 360) As Double
Dim x2(0 To 360) As Double
Dim y2(0 To 360) As Double
Dim line As AcadLine
Dim stpt(0 To 2) As Double
Dim enpt(0 To 2) As Double
Dim k As Integer
k = Me.Text3
Me.Text6 = angle
For i = 1 To 359 Step 360 / k
x1(i) = (d1 / 2) * Cos(i * 3.1415926 / 180)
y1(i) = (d1 / 2) * Sin(i * 3.1415926 / 180)
x2(i) = (d2 / 2) * Cos(i * 3.1415926 / 180 + angle)
y2(i) = (d2 / 2) * Sin(i * 3.1415926 / 180 + angle)
stpt(0) = x1(i): stpt(1) = y1(i): stpt(2) = 0
enpt(0) = x2(i): enpt(1) = y2(i): enpt(2) = -h
Set line = ActiveDocument.ModelSpace.AddLine(stpt, enpt)
line.Color = acRed
Next i
line.Update
End Sub