[原创]三点的外接圆内切圆和九点圆函数
本帖最后由 作者 于 2007-5-31 12:05:47 编辑三点的外接圆，内切圆，和九点圆如果用CAD的画圆命令来说很容易，但是对于那些不希望用命令的场合下，VB就需要编写一个函数了。
下面是我写的，初次学VBA,望各位多多指教
Option Explicit
Const Pi = 3.14159265358979
Public Sub drawCircle()
Dim pt1, pt2, pt3, Mp1, Mp2, Mp3 As Variant
Dim CirObj As AcadCircle
Dim CIR1, CIR2 As Variant
On Error Resume Next
'数据输入
pt1 = ThisDrawing.Utility.GetPoint(, vbCr & "请输入圆的第一点:")
pt2 = ThisDrawing.Utility.GetPoint(, vbCr & "请输入圆的第二点:")
pt3 = ThisDrawing.Utility.GetPoint(, vbCr & "请输入圆的第三点:")
'三边长的中点
Mp1 = Midpt(pt2, pt3)
Mp2 = Midpt(pt3, pt1)
Mp3 = Midpt(pt1, pt2)
'求得结果
CIR1 = ThreePointCircle(pt1, pt2, pt3)
CIR2 = ThreePointCircle(Mp1, Mp2, Mp3)
'画圆
Set CirObj = ThisDrawing.ModelSpace.AddCircle(CIR1(0), CIR1(1)) '画外接圆
Set CirObj = ThisDrawing.ModelSpace.AddCircle(CIR1(2), CIR1(3)) '画内切圆
Set CirObj = ThisDrawing.ModelSpace.AddCircle(CIR2(0), CIR2(1)) '画九点圆
End Sub
Function ThreePointCircle(ByVal ptA, ptB, ptC As Variant) As Variant
Dim a, b, c, p, Rad1, Rad2 As Double
Dim TanHalfA, AngleofA, xA, xB, xC, H_AA As Double
Dim ptAM, ptAT, Cen1, Cen2 As Variant
Dim HPi, Direct As Double
Dim CircleList(0 To 4) As Variant
HPi = Pi / 2
'三边边长
a = Distance(ptB, ptC) 'A边边长
b = Distance(ptC, ptA) 'B边边长
c = Distance(ptA, ptB) 'C边边长
'边X轴角
xA = ThisDrawing.Utility.AngleFromXAxis(ptB, ptC) 'A边X轴角
xB = ThisDrawing.Utility.AngleFromXAxis(ptC, ptA) 'B边X轴角
xC = ThisDrawing.Utility.AngleFromXAxis(ptA, ptB) 'C边X轴角
'下面的判断必不可少,否则会出错
Direct = Delta(ptA, ptB, ptC)
If Direct < 0 Then
HPi = -HPi
End If
'开始计算
If Abs(Sin(xA - xB) * Sin(xB - xC) * Sin(xC - xA)) < 0.00000001 Then
MsgBox "你输入的三点在同一条直线上!", vbOKOnly, "出错警告"
Else
p = (a + b + c) / 2 '半周长
TanHalfA = Sqr((p - b) * (p - c) / (p * (p - a))) '半角A的正切值
AngleofA = 2 * Atn(TanHalfA) '角A
'外接圆
ptAM = ThisDrawing.Utility.PolarPoint(ptB, xA, a / 2) 'A边中点
H_AA = a * tan(HPi - AngleofA) / 2 'A边弦高
Cen1 = ThisDrawing.Utility.PolarPoint(ptAM, xA + HPi, H_AA) '外接圆圆心
Rad1 = Distance(ptA, Cen1) '外接圆半径
'内切圆
ptAT = ThisDrawing.Utility.PolarPoint(ptA, xC, p - a) 'C边内切点
Rad2 = Sqr((p - a) * (p - b) * (p - c) / p) '内切圆半径
Cen2 = ThisDrawing.Utility.PolarPoint(ptAT, xC + HPi, Rad2)'内切圆圆心
End If
CircleList(0) = Cen1
CircleList(1) = Rad1
CircleList(2) = Cen2
CircleList(3) = Rad2
ThreePointCircle = CircleList
End Function
'距离函数
Function Distance(pt1, pt2 As Variant) As Double
Dim x, y, z As Double
x = pt1(0) - pt2(0)
y = pt1(1) - pt2(1)
z = pt1(2) - pt2(2)
Distance = Sqr(x ^ 2 + y ^ 2 + z ^ 2)
End Function
'三点形成的左右拐的判定
Function Delta(pt1, pt2, pt3 As Variant) As Double
Dim dx1, dy1, dx2, dy2 As Double
dx1 = pt2(0) - pt1(0)
dy1 = pt2(1) - pt1(1)
dx2 = pt3(0) - pt1(0)
dy2 = pt3(1) - pt1(1)
Delta = dx1 * dy2 - dx2 * dy1
End Function
'中点函数
Function Midpt(pt1, pt2 As Variant) As Variant
Dim vv(0 To 2) As Double
vv(0) = (pt1(0) + pt2(0)) / 2
vv(1) = (pt1(1) + pt2(1)) / 2
vv(2) = (pt1(2) + pt2(2)) / 2
Midpt = vv
End Function
页:
[1]