[求助]：请问如何用VBA画一个圆,再从圆外一点画圆的切线

麻雀

菜鸟问题：
请问如何用VBA画一个圆,再从圆外一点画这个圆的切线

ahlzl

2. Sub AAA()
   
3. 
   
4. '用VBA画一个圆。
   
5. Dim cen1(2) As Double
   
6. cen1(0) = 100: cen1(1) = 200: cen1(2) = 0
   
7. Dim R As Double
   
8. R = 300
   
9. Dim C As AcadCircle
   
10. Set C = ThisDrawing.ModelSpace.AddCircle(cen1, R)
    
11. 
    
12. '得到圆外一点。
    
13. Dim P As Variant
    
14. P = ThisDrawing.Utility.GetPoint(, "请在圆外取一点：")
    
15. 
    
16. '出错处理。
    
17. If dis(P, cen1) < R Then
    
18. MsgBox ("点不在圆外，请重新输入！")
    
19. Exit Sub
    
20. End If
    
21. 
    
22. '以圆外这点和上一个圆的圆心为直径的两端，画一个辅助圆。
    
23. Dim cen2(2) As Double
    
24. cen2(0) = 0.5 * (P(0) + cen1(0))
    
25. cen2(1) = 0.5 * (P(1) + cen1(1))
    
26. cen2(2) = 0.5 * (P(2) + cen1(2))
    
27. 
    
28. Dim cc As AcadCircle
    
29. Set cc = ThisDrawing.ModelSpace.AddCircle(cen2, 0.5 * dis(cen1, P))
    
30. 
    
31. '得到这两个圆的交点。
    
32. Dim p0 As Variant
    
33. p0 = C.IntersectWith(cc, acExtendBoth)
    
34. Dim p1(2) As Double, p2(2) As Double
    
35. p1(0) = p0(0): p1(1) = p0(1): p1(2) = p0(2)
    
36. p2(0) = p0(3): p2(1) = p0(4): p2(2) = p0(5)
    
37. 
    
38. '画出两条切线。
    
39. Dim L1 As AcadLine, L2 As AcadLine
    
40. Set L1 = ThisDrawing.ModelSpace.AddLine(p1, P)
    
41. Set L2 = ThisDrawing.ModelSpace.AddLine(p2, P)
    
42. 
    
43. '删除辅助圆。
    
44. cc.Delete
    
45. End Sub
    
46. 
    
47. Function dis(pa As Variant, pb As Variant) As Double
    
48. dis = ((pa(0) - pb(0)) ^ 2 + (pa(1) - pb(1)) ^ 2 + (pa(2) - pb(2)) ^ 2) ^ 0.5
    
49. End Function

Sub AAA()<br /> <br /> '用VBA画一个圆。<br /> Dim cen1(2) As Double<br /> cen1(0) = 100: cen1(1) = 200: cen1(2) = 0<br /> Dim R As Double<br /> R = 300<br /> Dim C As AcadCircle<br /> Set C = ThisDrawing.ModelSpace.AddCircle(cen1, R)<br /> <br /> '得到圆外一点。<br /> Dim P As Variant<br /> P = ThisDrawing.Utility.GetPoint(, "请在圆外取一点：")<br /> <br /> '出错处理。<br /> If dis(P, cen1) < R Then<br /> MsgBox ("点不在圆外，请重新输入！")<br /> Exit Sub<br /> End If<br /> <br /> '以圆外这点和上一个圆的圆心为直径的两端，画一个辅助圆。<br /> Dim cen2(2) As Double<br /> cen2(0) = 0.5 * (P(0) + cen1(0))<br /> cen2(1) = 0.5 * (P(1) + cen1(1))<br /> cen2(2) = 0.5 * (P(2) + cen1(2))<br /> <br /> Dim cc As AcadCircle<br /> Set cc = ThisDrawing.ModelSpace.AddCircle(cen2, 0.5 * dis(cen1, P))<br /> <br /> '得到这两个圆的交点。<br /> Dim p0 As Variant<br /> p0 = C.IntersectWith(cc, acExtendBoth)<br /> Dim p1(2) As Double, p2(2) As Double<br /> p1(0) = p0(0): p1(1) = p0(1): p1(2) = p0(2)<br /> p2(0) = p0(3): p2(1) = p0(4): p2(2) = p0(5)<br /> <br /> '画出两条切线。<br /> Dim L1 As AcadLine, L2 As AcadLine<br /> Set L1 = ThisDrawing.ModelSpace.AddLine(p1, P)<br /> Set L2 = ThisDrawing.ModelSpace.AddLine(p2, P)<br /> <br /> '删除辅助圆。<br /> cc.Delete<br /> End Sub<br /> <br /> Function dis(pa As Variant, pb As Variant) As Double<br /> dis = ((pa(0) - pb(0)) ^ 2 + (pa(1) - pb(1)) ^ 2 + (pa(2) - pb(2)) ^ 2) ^ 0.5<br /> End Function

ahlzl

lzh741206斑竹写的更好！

2. 
   
3. Sub BBB()
   
4. '画圆
   
5. Dim cen1(2) As Double
   
6. Dim PD As Double, PL As Double, R As Double
   
7. Dim Angle As Double, pAngle As Double
   
8. Dim C As AcadCircle
   
9. Dim P, P1 As Variant
   
10. cen1(0) = 100: cen1(1) = 200: cen1(2) = 0
    
11. R = 300
    
12. Set C = ThisDrawing.ModelSpace.AddCircle(cen1, R)
    
13. 
    
14. '取点
    
15. P = ThisDrawing.Utility.GetPoint(, "请在圆外取一点：")
    
16. 
    
17. '出错处理
    
18. PD = dis(P, cen1)
    
19. Do While PD <= R
    
20. MsgBox ("点不在圆外，请重新输入！")
    
21. P = ThisDrawing.Utility.GetPoint(, "请在圆外取一点：")
    
22. PD = dis(P, cen1)
    
23. Loop
    
24. 
    
25. '画切线。
    
26. PL = Sqr(PD ^ 2 - R ^ 2)
    
27. pAngle = Atn(R / PL)
    
28. Angle = ThisDrawing.Utility.AngleFromXAxis(P, cen1)
    
29. P1 = ThisDrawing.Utility.PolarPoint(P, Angle + pAngle, PL)
    
30. ThisDrawing.ModelSpace.AddLine P1, P
    
31. P1 = ThisDrawing.Utility.PolarPoint(P, Angle - pAngle, PL)
    
32. ThisDrawing.ModelSpace.AddLine P1, P
    
33. End Sub
    
34. 
    
35. Function dis(pa As Variant, pb As Variant) As Double
    
36. dis = Sqr((pa(0) - pb(0)) ^ 2 + (pa(1) - pb(1)) ^ 2 + (pa(2) - pb(2)) ^ 2)
    
37. End Function

<br /> Sub BBB()<br /> '画圆<br /> Dim cen1(2) As Double<br /> Dim PD As Double, PL As Double, R As Double<br /> Dim Angle As Double, pAngle As Double<br /> Dim C As AcadCircle<br /> Dim P, P1 As Variant<br /> cen1(0) = 100: cen1(1) = 200: cen1(2) = 0<br /> R = 300<br /> Set C = ThisDrawing.ModelSpace.AddCircle(cen1, R)<br /> <br /> '取点<br /> P = ThisDrawing.Utility.GetPoint(, "请在圆外取一点：")<br /> <br /> '出错处理<br /> PD = dis(P, cen1)<br /> Do While PD <= R<br /> MsgBox ("点不在圆外，请重新输入！")<br /> P = ThisDrawing.Utility.GetPoint(, "请在圆外取一点：")<br /> PD = dis(P, cen1)<br /> Loop<br /> <br /> '画切线。<br /> PL = Sqr(PD ^ 2 - R ^ 2)<br /> pAngle = Atn(R / PL)<br /> Angle = ThisDrawing.Utility.AngleFromXAxis(P, cen1)<br /> P1 = ThisDrawing.Utility.PolarPoint(P, Angle + pAngle, PL)<br /> ThisDrawing.ModelSpace.AddLine P1, P<br /> P1 = ThisDrawing.Utility.PolarPoint(P, Angle - pAngle, PL)<br /> ThisDrawing.ModelSpace.AddLine P1, P<br /> End Sub<br /> <br /> Function dis(pa As Variant, pb As Variant) As Double<br /> dis = Sqr((pa(0) - pb(0)) ^ 2 + (pa(1) - pb(1)) ^ 2 + (pa(2) - pb(2)) ^ 2)<br /> End Function

麻雀

谢谢长不大版主。第一个程序用几何的方法，第i二个用数学的方法求解，两者各有千秋。