代码改变世界

AutoCAD VBA:过三点创建一个圆

2011-03-16 22:02  精诚所至 金石为开  阅读(518)  评论(0编辑  收藏  举报

基本思路,两点连线,两个线段中垂线交点就是圆心,圆心到任一点距离为半径,做圆。

代码如下:

Function BisectorPLine(Point1 As Variant, point2 As Variant) As AcadPolyline
Dim Dist As Double
Dim Circle1 As AcadCircle
Dim Circle2 As AcadCircle
Dim Pnts As Variant
Dist = Distance(Point1, point2)
Set Circle1 = ThisDrawing.ModelSpace.AddCircle(Point1, Dist)
Set Circle2 = ThisDrawing.ModelSpace.AddCircle(point2, Dist)
Pnts = Circle1.IntersectWith(Circle2, acExtendNone)
Set BisectorPLine = ThisDrawing.ModelSpace.AddPolyline(Pnts)
End Function


Function Distance(Points1 As Variant, point2 As Variant) As Double
Dim Line As AcadLine
Set Line = ThisDrawing.ModelSpace.AddLine(Point1, point2)
Distance = Line.Length
Line.Delete
End Function


Function ThreePointCircle(pnt1 As Variant, pnt2 As Variant, pnt3 As Variant) As AcadCircle
Dim Dist As Double
Dim Pnts As Variant
Dim Line1 As AcadPolyline
Dim Line2 As AcadPolyline
Set Line1 = BisectorPLine(pnt1, pnt2)
Set Line2 = BisectorPLine(pnt1, pnt3)
Pnts = Line1.lntersectwith(Line2, acExtendBoth)
Line1.Delete
Line2.Delete
Dist = Distance(Pnts, pnt1)
Set ThreePointCircle = ThisDrawing.ModelSpace.AddCircle(Pnts, Dist)
End Function

Public Sub DrawCircle()
Dim P1 As Variant
Dim P2 As Variant
Dim P3 As Variant
P1 = ThisDrawing.Utility.GetPoint(, vbCr & "第一点:")
P2 = ThisDrawing.Utility.GetPoint(, vbCr & "第二点:")
P3 = ThisDrawing.Utility.GetPoint(, vbCr & "第三点:")
Dim C As AcadCircle
Set C = ThreePointCricle(P1, P2, P3)
End Sub

不知道这些代码放在哪,悲剧。