社区 › VB › [VBA]AutoCAD VBA开发精彩实例教程的错误

gogogo168 发表于 2005-9-16 15:31:00

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

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

MJTD_7777 发表于 2005-9-16 15:36:00

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

gogogo168 发表于 2005-9-17 10:01:00

估计斑竹不会同意的

mccad 发表于 2005-9-18 07:51:00

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

gogogo168 发表于 2005-9-18 16:17:00

其实只要是顺时针方向画的三个点,画出来的圆弧都有问题!!!我编一个小函数来验证:
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 发表于 2005-9-18 16:19:00

同时附上你们的程序代码:
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

mccad 发表于 2005-9-18 17:59:00

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

gogogo168 发表于 2005-9-19 14:20:00

帅哥,你的算法还是有问题!!比如:
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 发表于 2005-9-19 22:20:00

'判断三点的方向(自己改了一下,供大家测试)
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

雪山飞狐_lzh 发表于 2005-9-19 23:27:00

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
'说明，逆时针的三种情况如下，其余为顺时针

查看完整版本: [VBA]AutoCAD VBA开发精彩实例教程的错误