[VBA]AutoCAD VBA开发精彩实例教程的错误
最近看同事的《AutoCAD VBA开发精彩实例教程》，是你们网站张帆等编著的书。发现在53页，三点法画弧中所示例的程序代码是错误的！！！当用Set objArc=AddArcCSEP(ptCen,ptSt,ptEn)画弧时，所画的圆弧永远都是逆时针方向的。很可能不通过第二点！！请高手示例正确的代码以解我的疑惑！！！ <P>你在那里买的这书，有电子版吗？能把书中附带的东西发上来吗？</P> 估计斑竹不会同意的 圆弧只有一个方向，没有正反之分。<BR>需要你给出三个点的数据来证明这个程序有问题。注意：三个点的中间那个点不代表就是圆弧的中点，所以你用圆弧的中点来与中间那个点比较肯定是不同的。 <P>其实只要是顺时针方向画的三个点,画出来的圆弧都有问题!!!我编一个小函数来验证:</P><P>Sub ttest()<BR>Dim aPoint(2) As Double<BR>Dim bPoint(2) As Double<BR>Dim cPoint(2) As Double<BR>aPoint(0) = 1340<BR>aPoint(1) = 610<BR>bPoint(0) = 1434<BR>bPoint(1) = 505<BR>cPoint(0) = 1369<BR>cPoint(1) = 335<BR>Dim t As Variant<BR>'''创建三点所画的弧<BR>Set t = f_AddArc3Pt(aPoint, bPoint, cPoint)<BR>Dim lwPLine As AcadLWPolyline<BR>Dim pp(0 To 5) As Double<BR>pp(0) = 1340<BR>pp(1) = 610<BR>pp(2) = 1434<BR>pp(3) = 505<BR>pp(4) = 1369<BR>pp(5) = 335<BR>'''创建三点所画的直线<BR>Set lwPLine = ThisDrawing.ModelSpace.AddLightWeightPolyline(pp)<BR>End Sub<BR>比较弧和线就会发现问题!不通过的二点</P> <P>同时附上你们的程序代码:</P>
<P>Private Function GetCenOf3Pt(pt1 As Variant, pt2 As Variant, pt3 As Variant, ByRef radius As Double) As Variant<BR>''''根据三点计算出圆心和半径<BR>Dim xysm, xyse, xy As Double<BR>Dim ptCen(2) As Double<BR>xy = pt1(0) ^ 2 + pt1(1) ^ 2<BR>xyse = xy - pt3(0) ^ 2 - pt3(1) ^ 2<BR>xysm = xy - pt2(0) ^ 2 - pt2(1) ^ 2<BR>xy = (pt1(0) - pt2(0)) * (pt1(1) - pt3(1)) - (pt1(0) - pt3(0)) * (pt1(1) - pt2(1))<BR>'''判断参数有效性<BR>If Abs(xy) < 0.000001 Then<BR> MsgBox "所输入的参数无法创建圆形！"<BR> Exit Function<BR>End If<BR>'获得圆心和半径<BR>ptCen(0) = (xysm * (pt1(1) - pt3(1)) - xyse * (pt1(1) - pt2(1))) / (2 * xy)<BR>ptCen(1) = (xyse * (pt1(0) - pt2(0)) - xysm * (pt1(0) - pt3(0))) / (2 * xy)<BR>ptCen(2) = 0<BR>radius = Sqr((pt1(0) - ptCen(0)) * (pt1(0) - ptCen(0)) + (pt1(1) - ptCen(1)) * (pt1(1) - ptCen(1)))<BR>If radius < 0.000001 Then<BR> MsgBox "半径过小！"<BR> Exit Function<BR>End If<BR>''函数返回圆心的位置，而半径则在参数中通过引用方式返回<BR>GetCenOf3Pt = ptCen<BR>End Function<BR>Public Function AddArc3Pt(ByVal ptSt As Variant, ByVal ptSc As Variant, ByVal ptEn As Variant) As AcadArc<BR>''''三点法创建圆弧<BR>Dim objArc As AcadArc<BR>Dim ptCen As Variant<BR>Dim radius As Double<BR>ptCen = GetCenOf3Pt(ptSt, ptSc, ptEn, radius)<BR>Set objArc = AddArcCSEP(ptCen, ptSt, ptEn)</P>
<P>objArc.Update<BR>Set AddArc3Pt = objArc<BR>End Function<BR>Private Function AddArcCSEP(ByVal ptCen As Variant, ByVal ptSt As Variant, ByVal ptEn As Variant) As AcadArc<BR>Dim objArc As AcadArc<BR>Dim radius As Double<BR>Dim stAng, enAng As Double<BR>''计算半径<BR>radius = GetDistance(ptCen, ptSt)<BR>''计算起点角度和终点角度<BR>stAng = ThisDrawing.Utility.AngleFromXAxis(ptCen, ptSt)<BR>enAng = ThisDrawing.Utility.AngleFromXAxis(ptCen, ptEn)</P>
<P>Set objArc = ThisDrawing.ModelSpace.AddArc(ptCen, radius, stAng, enAng)<BR>objArc.Update<BR>Set AddArcCSEP = objArc<BR>End Function</P> 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) < 0 _
And ThisDrawing.Utility.AngleFromXAxis(ptSt, ptSc) - ThisDrawing.Utility.AngleFromXAxis(ptSc, ptEn) > -3.14159265) _
Then isClockWise = True
End Function <P>帅哥,你的算法还是有问题!!比如:</P>
<P>Sub ttest()<BR>Dim aPoint(2) As Double<BR>Dim bPoint(2) As Double<BR>Dim cPoint(2) As Double<BR>aPoint(0) = 19358<BR>aPoint(1) = -3402<BR>bPoint(0) = 20779<BR>bPoint(1) = -4141<BR>cPoint(0) = 22649<BR>cPoint(1) = -1360<BR>Dim t As Variant<BR>'''创建三点所画的弧<BR>Set t = f_AddArc3Pt(aPoint, bPoint, cPoint)<BR>Dim lwPLine As AcadLWPolyline<BR>Dim pp(0 To 5) As Double<BR>pp(0) = 19358<BR>pp(1) = -3402<BR>pp(2) = 20779<BR>pp(3) = -4141<BR>pp(4) = 22649<BR>pp(5) = -1360<BR>'''创建三点所画的直线<BR>Set lwPLine = ThisDrawing.ModelSpace.AddLightWeightPolyline(pp)<BR>End Sub<BR></P> '判断三点的方向(自己改了一下,供大家测试)<BR>Function isClockWise(ptSt, ptSc, ptEn) As Boolean<BR>'''顺时针为false，逆时针为true<BR>Dim y As Double<BR>If ptSc(0) > ptSt(0) Then '在右半边<BR> y = ((ptSc(1) - ptSt(1)) * ptEn(0) + ptSt(1) * ptSc(0) - ptSt(0) * ptSc(1)) / (ptSc(0) - ptSt(0))<BR> If y > ptEn(1) Then '如果在线下面<BR> isClockWise = false<BR> Else<BR> isClockWise = true<BR> End If<BR> Exit Function<BR>End If<BR>If ptSc(0) < ptSt(0) Then '在左半边<BR> y = ((ptSc(1) - ptSt(1)) * ptEn(0) + ptSt(1) * ptSc(0) - ptSt(0) * ptSc(1)) / (ptSc(0) - ptSt(0))<BR> If y > ptEn(1) Then '如果在线下面<BR> isClockWise =true<BR> Else<BR> isClockWise = false<BR> End If<BR> Exit Function<BR>End If<BR>If (ptSc(0) = ptSt(0)) And (ptSc(1) > ptSt(1)) Then '90度<BR> If ptEn(0) > ptSc(0) Then '右顺<BR> isClockWise = false<BR> Else<BR> isClockWise = true<BR> End If<BR> Exit Function<BR>End If<BR>If (ptSc(0) = ptSt(0)) And (ptSc(1) < ptSt(1)) Then '270度<BR> If ptEn(0) > ptSc(0) Then '左顺<BR> isClockWise =true<BR> Else<BR> isClockWise = false<BR> End If<BR> Exit Function<BR>End If<BR>End Function<BR> 本帖最后由 作者 于 2006-3-23 13:18:30 编辑 <br /><br /> <P>Public Function AddArc3Pt(ByVal ptSt As Variant, ByVal ptSc As Variant, ByVal ptEn As Variant) As AcadArc<BR>''''三点法创建圆弧<BR>Dim objArc As AcadArc<BR>Dim ptCen As Variant<BR>Dim radius As Double<BR>ptCen = GetCenOf3Pt(ptSt, ptSc, ptEn, radius)<BR>If isClockWise(ptCen, ptSt, ptSc, ptEn) Then<BR> Set objArc = AddArcCSEP(ptCen, ptSt, ptEn)<BR>Else<BR> Set objArc = AddArcCSEP(ptCen, ptEn, ptSt)<BR>End If<BR>objArc.Update<BR>Set AddArc3Pt = objArc<BR>End Function<BR></P>
<P>Private Function AddArcCSEP(ByVal ptCen As Variant, ByVal ptSt As Variant, ByVal ptEn As Variant) As AcadArc<BR>Dim objArc As AcadArc<BR>Dim radius As Double<BR>Dim stAng, enAng As Double<BR>''计算半径<BR>radius = GetDistance(ptCen, ptSt)<BR>''计算起点角度和终点角度<BR>stAng = ThisDrawing.Utility.AngleFromXAxis(ptCen, ptSt)<BR>enAng = ThisDrawing.Utility.AngleFromXAxis(ptCen, ptEn)</P>
<P>Set objArc = ThisDrawing.ModelSpace.AddArc(ptCen, radius, stAng, enAng)<BR>objArc.Update<BR>Set AddArcCSEP = objArc<BR>End Function</P>
<P>'判断三点的方向<BR>Function isClockWise(ptCen, ptSt, ptSc, ptEn) As Boolean<BR> a1 = ThisDrawing.Utility.AngleFromXAxis(ptCen, ptSt)<BR> a2 = ThisDrawing.Utility.AngleFromXAxis(ptCen, ptSc)<BR> a3 = ThisDrawing.Utility.AngleFromXAxis(ptCen, ptEn)<BR> <BR> isClockWise = (a1 < a2) Xor (a2 < a3) Xor (a1 < a3)<BR> <BR>End Function</P>
<P>'说明，逆时针的三种情况如下，其余为顺时针</P>
页:
[1]
2