【VBA源码】根据多段线弧的端点坐标和凸度求圆心

longxh28

根据多段线弧的端点坐标和凸度求圆心
注：之前一直在研究通过多段线弧的端点坐标和凸度求圆心，也发现了很多代码，但看了之后总觉得过于复杂，当时觉得奇怪，为什么bulge的定义会是1/4圆心角的tan，后来学习数学发现tan函数定义域以及万能公式，才明白这样取值的含义，真是太有学问了，把源码写下来发给大家一起研究
使用：在VBA中建一个窗口，窗口上加一个按钮，在按钮的点击事件中写下以下代码即可。
测试：选择一段圆弧转换成的多段线即可，别选其他的如圆弧之类的，圆、二维多段线也不行。
Private Sub LT_SFPY_Click()'子程序名应改成与你所建的按钮一致
Me.Hide
ThisDrawing.Activate
'定义
Dim A As Variant
Dim filtertype(0) As Integer
Dim filterdata(0) As Variant
Dim pS(2) As Double '起点坐标
Dim pE(2) As Double '终点坐标
Dim pC(2) As Double  '圆心坐标
Dim b As Double 'b=Bulge 凸度值
Dim L As Double 'L为弦长
Dim Lc As Double '弦心距（弦中心到圆弧中心的距离）
Dim R As Double '弧半径

'选择对象
Set filterset = ThisDrawing.SelectionSets.Add("SSETS" & CStr(Now()))
filtertype(0) = 0 '设置过滤数据
filterdata(0) = "LWPolyline"
'On Error Resume Next
filterset.SelectOnScreen filtertype, filterdata
For Each filterent In filterset
  A = filterent.Coordinates
Next
'赋初值
pS(0) = A(0): pS(1) = A(1)
pE(0) = A(2): pE(1) = A(3)
b = filterset.Item(0).GetBulge(0)
'计算
If b <> 0 Then
  L = Sqr((pS(0) - pE(0)) ^ 2 + (pS(1) - pE(1)) ^ 2)
  R = 0.25 * L * (1 + b ^ 2) / b
  Lc = 0.25 * L * (1 - b ^ 2) / b
  pC(0) = (pS(0) + pE(0)) / 2 + Lc / L * (pS(1) - pE(1))
  pC(1) = (pS(1) + pE(1)) / 2 + Lc / L * (pE(0) - pS(0))
ElseIf b = 0 Then
  pC(0) = (pS(0) + pE(0)) / 2
  pC(1) = (pS(1) + pE(1)) / 2
End If
'输出测试
If ThisDrawing.ActiveSpace = acModelSpace Then
    Set objSpace = ThisDrawing.ModelSpace
Else
    Set objSpace = ThisDrawing.PaperSpace
End If
Set c = objSpace.AddCircle(pC, 0.1)
end sub

zzyong00

支持一下楼主
真正数值计算，b定义为double,判定b是否为0,用b<>0是不可靠的，而且，在这种情况下直接 除以b，也有可能溢出！
常规做法：
if abs(b)<1e-8 then ...这时候认为b为0
精度可以根据需要调整

longxh28

zzyong00 发表于 2015-6-6 16:04
支持一下楼主
真正数值计算，b定义为double,判定b是否为0,用b0是不可靠的，而且，在这种情况下直接 除以b， ...

谢谢，没注意double类型的使用范围，确实是有可能出错，呵呵