求一段测量两点距离的代码

jsxygshh

请诸位高手帮助写一代码：
VB读取cad中两点间的距离，并显示于VB窗体上

jsxygshh

请大家不吝赐教

sscylh

jsxygshh 发表于 2012-9-2 16:46
请大家不吝赐教

2. Sub aa()
   
3. Dim u As AcadUtility
   
4. Dim r1 As Variant
   
5. Dim r2 As Variant
   
6. Set u = ThisDrawing.Utility
   
7. r1 = u.GetPoint(, "Enter a point: ")
   
8. r2 = u.GetPoint(, "Enter a point: ")
   
9. d = Sqr((r1(0) - r2(0)) ^ 2 + (r1(1) - r2(1)) ^ 2)
   
10. MsgBox d
    
11. End Sub

Sub aa()<br /> Dim u As AcadUtility<br /> Dim r1 As Variant<br /> Dim r2 As Variant<br /> Set u = ThisDrawing.Utility<br /> r1 = u.GetPoint(, "Enter a point: ")<br /> r2 = u.GetPoint(, "Enter a point: ")<br /> d = Sqr((r1(0) - r2(0)) ^ 2 + (r1(1) - r2(1)) ^ 2)<br /> MsgBox d<br /> End Sub

jsxygshh

sscylh 发表于 2012-9-10 20:58

谢谢你的帮助，在你的帮助下已经调试成功，十分感谢！

linpao00915

这个在帮助文件里也有

markc0826

利用 GetDistance 方法会不会简单一点？？

jsxygshh

markc0826 发表于 2012-9-12 10:02
利用 GetDistance 方法会不会简单一点？？

能给出具体代码吗？谢谢

markc0826

jsxygshh 发表于 2012-9-12 10:21
能给出具体代码吗？谢谢

2. Sub GetDist()
   
3.     Dim PT1 As Variant
   
4.     Dim Dis As Double
   
5.     PT1 = ThisDrawing.Utility.getPoint(, "1st Point")
   
6.     Dis = ThisDrawing.Utility.GetDistance(PT1, "2nd Point")
   
7.     MsgBox "The Distance is :" & Dis
   
8. End Sub

Sub GetDist()<br />     Dim PT1 As Variant<br />     Dim Dis As Double<br />     PT1 = ThisDrawing.Utility.getPoint(, "1st Point")<br />     Dis = ThisDrawing.Utility.GetDistance(PT1, "2nd Point")<br />     MsgBox "The Distance is :" & Dis<br /> End Sub

jsxygshh

markc0826 发表于 2012-9-12 10:30

谢谢，十分感谢，这样确实很简单
另外再请教一个问题，如果我要测量多个距离，代码如何修改呢，请不吝赐教

markc0826

2. Sub GetDist()
   
3.     Dim PT1 As Variant
   
4.     Dim Dis As Double
   
5.     Dim YoN
   
6.     YoN = vbYes
   
7.     Do Until YoN = vbNo
   
8.         PT1 = ThisDrawing.Utility.getPoint(, "1st Point")
   
9.         Dis = ThisDrawing.Utility.GetDistance(PT1, "2nd Point")
   
10.         YoN = MsgBox("The Distance is :" & Dis & "，是否继续？", vbYesNo)
    
11.     Loop
    
12. End Sub

Sub GetDist()<br />     Dim PT1 As Variant<br />     Dim Dis As Double<br />     Dim YoN<br />     YoN = vbYes<br />     Do Until YoN = vbNo<br />         PT1 = ThisDrawing.Utility.getPoint(, "1st Point")<br />         Dis = ThisDrawing.Utility.GetDistance(PT1, "2nd Point")<br />         YoN = MsgBox("The Distance is :" & Dis & "，是否继续？", vbYesNo)<br />     Loop<br /> End Sub