jsxygshh 发表于 2012-9-2 10:19:33

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

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

jsxygshh 发表于 2012-9-2 16:46:30

请大家不吝赐教

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

jsxygshh 发表于 2012-9-2 16:46 static/image/common/back.gif
请大家不吝赐教

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

jsxygshh 发表于 2012-9-11 15:44:52

sscylh 发表于 2012-9-10 20:58 static/image/common/back.gif


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

linpao00915 发表于 2012-9-12 09:23:58

这个在帮助文件里也有

markc0826 发表于 2012-9-12 10:02:17

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

jsxygshh 发表于 2012-9-12 10:21:09

markc0826 发表于 2012-9-12 10:02 static/image/common/back.gif
利用 GetDistance 方法会不会简单一点？？

能给出具体代码吗？谢谢

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

jsxygshh 发表于 2012-9-12 10:21 static/image/common/back.gif
能给出具体代码吗？谢谢

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

jsxygshh 发表于 2012-9-12 10:55:02

markc0826 发表于 2012-9-12 10:30 static/image/common/back.gif


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

markc0826 发表于 2012-9-12 11:00:48

本帖最后由 markc0826 于 2012-9-12 11:02 编辑

Sub GetDist()
    Dim PT1 As Variant
    Dim Dis As Double
    Dim YoN
    YoN = vbYes
    Do Until YoN = vbNo
      PT1 = ThisDrawing.Utility.getPoint(, "1st Point")
      Dis = ThisDrawing.Utility.GetDistance(PT1, "2nd Point")
      YoN = MsgBox("The Distance is :" & Dis & "，是否继续？", vbYesNo)
    Loop
End Sub
页: [1] 2 3
查看完整版本: 求一段测量两点距离的代码