|
发表于 2007-4-6 10:53:00
|
显示全部楼层
fjbrivlbdfu.jpg
'仅给出一个参考代码 (以两已知圆心的中点为圆心画一个切圆)
' 按要求改变程序中 t 的值就可以实现你的目标.
Option Explicit
Public Sub TangentialCircle()
Dim c1 As AcadCircle
Dim c2 As AcadCircle
Dim c3 As AcadCircle
Dim retPnt As Variant
Dim r1 As Double
Dim r2 As Double
Dim rt As Double
Dim r As Double
Dim l As Double
Dim t As Double
Dim tmin As Double
Dim tmax As Double
Dim p1(0 To 2) As Double
Dim p2(0 To 2) As Double
Dim pt(0 To 2) As Double
Dim p0(0 To 2) As Double
Dim s(0 To 2) As Double
'1.找圆心,求半径等
ThisDrawing.Utility.GetEntity c1, retPnt, "Select a Circle"
ThisDrawing.Utility.GetEntity c2, retPnt, "Select a Circle"
retPnt = c1.Center
p1(0) = retPnt(0)
p1(1) = retPnt(1)
p1(2) = retPnt(2)
r1 = c1.Radius
retPnt = c2.Center
p2(0) = retPnt(0)
p2(1) = retPnt(1)
p2(2) = retPnt(2)
r2 = c2.Radius
'确定 r2 >= r1
If r2
'2.计算参数
l = ((p2(0) - p1(0)) ^ 2 + (p2(1) - p1(1)) ^ 2 + (p2(2) - p1(2)) ^ 2) ^ 0.5
s(0) = (p2(0) - p1(0)) / l
s(1) = (p2(1) - p1(1)) / l
s(2) = (p2(2) - p1(2)) / l
tmin = 2 * r1 * l / (l + r1 - r2)
tmax = (l - r1 - r2) / (l - r1 + r2) * l
'''
'''
'本例中 设t值固定 (设两圆心的中点为圆心画一个切圆.)
'按要求改变 t 的值就可以实现你的目标
t = l / 2
'''
'''
'判断 t 的值是否合理(保证要画的切圆不与两圆交叉)
If t > tmax Or t
'3.画目标圆
Set c3 = ThisDrawing.ModelSpace.AddCircle(p0, r)
End Sub
|
|