其实只要是顺时针方向画的三个点,画出来的圆弧都有问题!!!我编一个小函数来验证:
Sub ttest()
Dim aPoint(2) As Double
Dim bPoint(2) As Double
Dim cPoint(2) As Double
aPoint(0) = 1340
aPoint(1) = 610
bPoint(0) = 1434
bPoint(1) = 505
cPoint(0) = 1369
cPoint(1) = 335
Dim t As Variant
'''创建三点所画的弧
Set t = f_AddArc3Pt(aPoint, bPoint, cPoint)
Dim lwPLine As AcadLWPolyline
Dim pp(0 To 5) As Double
pp(0) = 1340
pp(1) = 610
pp(2) = 1434
pp(3) = 505
pp(4) = 1369
pp(5) = 335
'''创建三点所画的直线
Set lwPLine = ThisDrawing.ModelSpace.AddLightWeightPolyline(pp)
End Sub
比较弧和线就会发现问题!不通过的二点
同时附上你们的程序代码:
Private Function GetCenOf3Pt(pt1 As Variant, pt2 As Variant, pt3 As Variant, ByRef radius As Double) As Variant
''''根据三点计算出圆心和半径
Dim xysm, xyse, xy As Double
Dim ptCen(2) As Double
xy = pt1(0) ^ 2 + pt1(1) ^ 2
xyse = xy - pt3(0) ^ 2 - pt3(1) ^ 2
xysm = xy - pt2(0) ^ 2 - pt2(1) ^ 2
xy = (pt1(0) - pt2(0)) * (pt1(1) - pt3(1)) - (pt1(0) - pt3(0)) * (pt1(1) - pt2(1))
'''判断参数有效性
If Abs(xy)
objArc.Update
Set AddArc3Pt = objArc
End Function
Private Function AddArcCSEP(ByVal ptCen As Variant, ByVal ptSt As Variant, ByVal ptEn As Variant) As AcadArc
Dim objArc As AcadArc
Dim radius As Double
Dim stAng, enAng As Double
''计算半径
radius = GetDistance(ptCen, ptSt)
''计算起点角度和终点角度
stAng = ThisDrawing.Utility.AngleFromXAxis(ptCen, ptSt)
enAng = ThisDrawing.Utility.AngleFromXAxis(ptCen, ptEn)
Set objArc = ThisDrawing.ModelSpace.AddArc(ptCen, radius, stAng, enAng)
objArc.Update
Set AddArcCSEP = objArc
End Function
帅哥,你的算法还是有问题!!比如:
Sub ttest()
Dim aPoint(2) As Double
Dim bPoint(2) As Double
Dim cPoint(2) As Double
aPoint(0) = 19358
aPoint(1) = -3402
bPoint(0) = 20779
bPoint(1) = -4141
cPoint(0) = 22649
cPoint(1) = -1360
Dim t As Variant
'''创建三点所画的弧
Set t = f_AddArc3Pt(aPoint, bPoint, cPoint)
Dim lwPLine As AcadLWPolyline
Dim pp(0 To 5) As Double
pp(0) = 19358
pp(1) = -3402
pp(2) = 20779
pp(3) = -4141
pp(4) = 22649
pp(5) = -1360
'''创建三点所画的直线
Set lwPLine = ThisDrawing.ModelSpace.AddLightWeightPolyline(pp)
End Sub
'判断三点的方向(自己改了一下,供大家测试)
Function isClockWise(ptSt, ptSc, ptEn) As Boolean
'''顺时针为false，逆时针为true
Dim y As Double
If ptSc(0) > ptSt(0) Then '在右半边
y = ((ptSc(1) - ptSt(1)) * ptEn(0) + ptSt(1) * ptSc(0) - ptSt(0) * ptSc(1)) / (ptSc(0) - ptSt(0))
If y > ptEn(1) Then '如果在线下面
isClockWise = false
Else
isClockWise = true
End If
Exit Function
End If
If ptSc(0) ptEn(1) Then '如果在线下面
isClockWise =true
Else
isClockWise = false
End If
Exit Function
End If
If (ptSc(0) = ptSt(0)) And (ptSc(1) > ptSt(1)) Then '90度
If ptEn(0) > ptSc(0) Then '右顺
isClockWise = false
Else
isClockWise = true
End If
Exit Function
End If
If (ptSc(0) = ptSt(0)) And (ptSc(1) ptSc(0) Then '左顺
isClockWise =true
Else
isClockWise = false
End If
Exit Function
End If
End Function
Public Function AddArc3Pt(ByVal ptSt As Variant, ByVal ptSc As Variant, ByVal ptEn As Variant) As AcadArc
''''三点法创建圆弧
Dim objArc As AcadArc
Dim ptCen As Variant
Dim radius As Double
ptCen = GetCenOf3Pt(ptSt, ptSc, ptEn, radius)
If isClockWise(ptCen, ptSt, ptSc, ptEn) Then
Set objArc = AddArcCSEP(ptCen, ptSt, ptEn)
Else
Set objArc = AddArcCSEP(ptCen, ptEn, ptSt)
End If
objArc.Update
Set AddArc3Pt = objArc
End Function
Private Function AddArcCSEP(ByVal ptCen As Variant, ByVal ptSt As Variant, ByVal ptEn As Variant) As AcadArc
Dim objArc As AcadArc
Dim radius As Double
Dim stAng, enAng As Double
''计算半径
radius = GetDistance(ptCen, ptSt)
''计算起点角度和终点角度
stAng = ThisDrawing.Utility.AngleFromXAxis(ptCen, ptSt)
enAng = ThisDrawing.Utility.AngleFromXAxis(ptCen, ptEn)
Set objArc = ThisDrawing.ModelSpace.AddArc(ptCen, radius, stAng, enAng)
objArc.Update
Set AddArcCSEP = objArc
End Function
'判断三点的方向
Function isClockWise(ptCen, ptSt, ptSc, ptEn) As Boolean
a1 = ThisDrawing.Utility.AngleFromXAxis(ptCen, ptSt)
a2 = ThisDrawing.Utility.AngleFromXAxis(ptCen, ptSc)
a3 = ThisDrawing.Utility.AngleFromXAxis(ptCen, ptEn)
置顶卡
