求助：请帮忙写一个VBA的程序，自动计算距离的，急！谢谢！

Trudy.c 发表于 2004-11-30 18:27:00

求助：请熟悉VBA程序的朋友帮忙写一个自动计算两点间距离的程序，谢谢，要求等见链接中的图片，急，再次感谢！

http://www.1sj2003.com/bbs/uploadImages/200411301802059905.jpg

chman 发表于 2004-11-30 19:54:00

如果求两点距离，可以用getpoint

或者求交点

不过你的图形，太复杂了。没有看出来这两个点是怎么取出的。

企盼中

myfreemind 发表于 2004-11-30 23:07:00

只是取两点距离？

Trudy.c 发表于 2004-12-1 09:17:00

谢谢两位朋友的回复！

非常感谢两位的回复！这个问题也是一个朋友问我的，因不怎么懂VBA，所以上网求助，具体要求我也不太知道了，应该只是求两点间的距离吧！如果可以能否写一个简单的程序呢？谢谢！

yucheng413 发表于 2004-12-1 09:40:00

问题的确是有点复杂化了,看不懂楼主的意思。

Trudy.c 发表于 2004-12-1 13:10:00

看来问题不太明确，这下真的复杂化了，不知哪位高手能看懂！拜托拜托！

臭要饭的 发表于 2012-7-4 12:39:39

Sub 计算距离()
On Error GoTo NoSelect
With ThisDrawing
Do
Dim a As Variant, b As Variant, charudian As Variant
a = .Utility.GetPoint(, "请选择点A"): b = .Utility.GetPoint(, "请选择点B"):
distance = Int(Abs(Sqr((a(0) - b(0)) ^ 2 + (a(1) - b(1)) ^ 2)) + 1)
charudian = .Utility.GetPoint(, "请选择插入点")
Set txt = .ModelSpace.AddText(distance, charudian, 1.5)
If Abs(a(0) - b(0)) < 1 Then
txt.Rotation = 1.57
ElseIf Abs(a(1) - b(1)) < 1 Then
txt.Rotation = 0
End If
txt.color = acWhite
Loop While err.Number = 0
End With
NoSelect:
err.Clear
End Sub
高手莫笑菜鸟编程

Real_King 发表于 2013-4-8 03:18:04

还用编程么……拉条线查属性不就得了……

页: [1]

明经CAD社区's Archiver

求助：请帮忙写一个VBA的程序，自动计算距离的，急！谢谢！

谢谢两位朋友的回复！