- 积分
- 781
- 明经币
- 个
- 注册时间
- 2009-7-17
- 在线时间
- 小时
- 威望
-
- 金钱
- 个
- 贡献
-
- 激情
-
|
发表于 2015-3-8 14:25:31
|
显示全部楼层
我是初学,起点到终点画一条直线,再画该直线的中垂线,最后求出中垂线和
多线段的交点,两个交点的中点就是圆心坐标。
Public Const PI As Double = 3.1415926
Public Sub demoACR()
Dim ptBase As Variant
Dim objEntity As AcadLWPolyline
Dim PT1(2) As Double '起点
Dim PT2(2) As Double '终点
Dim PT12(2) As Double '中心点
Dim LINE12 As AcadLine 'pt1,pt2画直线
Dim LineZ As AcadLine 'line12的中垂线
ThisDrawing.Utility.GetEntity objEntity, ptBase, "请选择图元:"
PT1(0) = objEntity.Coordinates(0): PT1(1) = objEntity.Coordinates(1): PT1(2) = 0
PT2(0) = objEntity.Coordinates(2): PT2(1) = objEntity.Coordinates(3): PT2(2) = 0
PT12(0) = (PT1(0) + PT2(0)) / 2: PT12(1) = (PT1(1) + PT2(1)) / 2: PT12(2) = 0
Set LINE12 = ThisDrawing.ModelSpace.AddLine(PT1, PT2)
Dim angleZ As Double
angleZ = LINE12.angle + PI / 2
Set LineZ = AddLineReAL(PT12, angleZ, 100)
Dim pt3 As Variant
pt3 = LineZ.IntersectWith(objEntity, acExtendBoth)
Dim PtCen(2) As Double
PtCen(0) = (pt3(0) + pt3(3)) / 2: PtCen(1) = (pt3(1) + pt3(4)) / 2: PtCen(2) = (pt3(2) + pt3(5)) / 2
Stop
End Sub
'根据起点和相对极坐标创建直线
Public Function AddLineReAL(ByVal ptSt As Variant, ByVal angle As Double, ByVal dist As Double) As AcadLine
Dim ptEn(2) As Double
ptEn(0) = ptSt(0) + dist * Cos(angle)
ptEn(1) = ptSt(1) + dist * Sin(angle)
ptEn(2) = ptSt(2)
Set AddLineReAL = ThisDrawing.ModelSpace.AddLine(ptSt, ptEn)
End Function
|
|