[VBA]AutoCAD VBA开发精彩实例教程的错误

gogogo168

最近看同事的《AutoCAD VBA开发精彩实例教程》，是你们网站张帆等编著的书。发现在53页，三点法画弧中所示例的程序代码是错误的！！！当用Set objArc=AddArcCSEP(ptCen,ptSt,ptEn)画弧时，所画的圆弧永远都是逆时针方向的。很可能不通过第二点！！请高手示例正确的代码以解我的疑惑！！！

MJTD_7777

你在那里买的这书，有电子版吗？能把书中附带的东西发上来吗？

gogogo168

估计斑竹不会同意的

mccad

圆弧只有一个方向，没有正反之分。
需要你给出三个点的数据来证明这个程序有问题。注意：三个点的中间那个点不代表就是圆弧的中点，所以你用圆弧的中点来与中间那个点比较肯定是不同的。

gogogo168

其实只要是顺时针方向画的三个点,画出来的圆弧都有问题!!!我编一个小函数来验证:

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
比较弧和线就会发现问题!不通过的二点

gogogo168

同时附上你们的程序代码:

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) < 0.000001 Then
   MsgBox "所输入的参数无法创建圆形！"
   Exit Function
End If
'获得圆心和半径
ptCen(0) = (xysm * (pt1(1) - pt3(1)) - xyse * (pt1(1) - pt2(1))) / (2 * xy)
ptCen(1) = (xyse * (pt1(0) - pt2(0)) - xysm * (pt1(0) - pt3(0))) / (2 * xy)
ptCen(2) = 0
radius = Sqr((pt1(0) - ptCen(0)) * (pt1(0) - ptCen(0)) + (pt1(1) - ptCen(1)) * (pt1(1) - ptCen(1)))
If radius < 0.000001 Then
   MsgBox "半径过小！"
   Exit Function
End If
''函数返回圆心的位置，而半径则在参数中通过引用方式返回
GetCenOf3Pt = ptCen
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)
Set objArc = AddArcCSEP(ptCen, ptSt, ptEn)

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

mccad

2. Public Function AddArc3Pt(ByVal ptSt As Variant, ByVal ptSc As Variant, ByVal ptEn As Variant) As AcadArc
3. ''''三点法创建圆弧
4. Dim objArc As AcadArc
5. Dim ptCen As Variant
6. Dim radius As Double
7. ptCen = GetCenOf3Pt(ptSt, ptSc, ptEn, radius)
8. [b]If isClockWise(ptSt, ptSc, ptEn) Then
9.     Set objArc = AddArcCSEP(ptCen, ptSt, ptEn)
10. Else
11.     Set objArc = AddArcCSEP(ptCen, ptEn, ptSt)
12. End If[/b]objArc.Update
13. Set AddArc3Pt = objArc
14. End Function
15. [b]'判断三点的方向
16. Function isClockWise(ptSt, ptSc, ptEn) As Boolean
17.     If (ThisDrawing.Utility.AngleFromXAxis(ptSt, ptSc) - ThisDrawing.Utility.AngleFromXAxis(ptSc, ptEn) < 0 _
18.     And ThisDrawing.Utility.AngleFromXAxis(ptSt, ptSc) - ThisDrawing.Utility.AngleFromXAxis(ptSc, ptEn) > -3.14159265) _
19.     Then isClockWise = True
20. End Function[/b]

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) [b]If isClockWise(ptSt, ptSc, ptEn) Then     Set objArc = AddArcCSEP(ptCen, ptSt, ptEn) Else     Set objArc = AddArcCSEP(ptCen, ptEn, ptSt) End If[/b]objArc.Update Set AddArc3Pt = objArc End Function [b]'判断三点的方向 Function isClockWise(ptSt, ptSc, ptEn) As Boolean     If (ThisDrawing.Utility.AngleFromXAxis(ptSt, ptSc) - ThisDrawing.Utility.AngleFromXAxis(ptSc, ptEn) < 0 _     And ThisDrawing.Utility.AngleFromXAxis(ptSt, ptSc) - ThisDrawing.Utility.AngleFromXAxis(ptSc, ptEn) > -3.14159265) _     Then isClockWise = True End Function[/b]

gogogo168

帅哥,你的算法还是有问题!!比如:

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

gogogo168

'判断三点的方向(自己改了一下,供大家测试)
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) < 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 =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) < ptSt(1)) Then    '270度
   If ptEn(0) > ptSc(0) Then   '左顺
      isClockWise =true
      Else
      isClockWise = false
   End If
   Exit Function
End If
End Function

雪山飞狐_lzh

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)
    
    isClockWise = (a1 < a2) Xor (a2 < a3) Xor (a1 < a3)
   
End Function

'说明，逆时针的三种情况如下，其余为顺时针