ngeqt521 发表于 2007-4-4 12:45:00

[求助]那位大哥可以帮我写一个如图的二次开发程序



那位大哥可以帮我写一个如图这样的二次开发程序,如图中所示定义一个大圆与一个小圆中间的圆以大圆与小圆的切点依次递增,Help me..thanks a lot...

jkbanana 发表于 2007-4-4 17:24:00

问题不够清楚.太笼统.
应具体点.比如 "大圆与小圆中间的圆"以什么间距沿切点依次递增.
细分以下你的大问题,比如严格地用数学方法描述以下你的问题,可能比较好解决.

ngeqt521 发表于 2007-4-5 12:46:00

中间的圆位置是已知的如图A,在圆心不动的情况下中间的圆象限点依次与大圆小圆的象限点切线相垂直生成如图B的图形,

jkbanana 发表于 2007-4-5 17:42:00

做了个思路的简图.
1.先求两圆的切线P3P4(几何问题)
2.给出目标圆的圆心P0(所以需要给定间距t),过P0求直线P3P4的垂足P
(以前有求垂足的帖子).P0到P的距离r为目标圆的半径,这样就可以画出目标圆.


jkbanana 发表于 2007-4-6 10:53:00




'仅给出一个参考代码 (以两已知圆心的中点为圆心画一个切圆)
'                   按要求改变程序中 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

ngeqt521 发表于 2007-4-6 14:21:00

jkbanana谢谢你的回复,我的想法是:假定有4X4排圆也就是16个,先选择所有圆然后定义4个角上的4个圆直径大小(图中红色的四个圆),中间的圆以这4个圆象限切点垂直(绿色为相切线),圆心不动放大,如图

jkbanana 发表于 2007-4-6 14:51:00

你可以修改以上的代码作为一个子过程,
确定你所要的 t 值后,先画出边上的8个圆,再按行或列画出中间的4个圆.
不会很难,试试吧.

ngeqt521 发表于 2007-4-8 17:12:00

jkbanana,help me,像上次的一个程序一样,弄了二天无果,请给点帮助?对VBA我不太了解,附档为一位大哥写的LISP编压的VLX文件效果不太理想我想能通过光标拾取圆定直径而不是手工输数据不知可否做到,附档的执行命令是文件名
页: [1]
查看完整版本: [求助]那位大哥可以帮我写一个如图的二次开发程序