您的位置:网站首页 > CAD新闻

CAD 两点距离及X轴增量

时间:2011-01-28 11:44:17 来源:未知

如题:

图示:


源码:

Private Sub huatu()
Dim p1 As Variant
Dim p2 As Variant
On Error GoTo 10000
        p1 = ThisDrawing.Utility.GetPoint(, "指定第一点:")
        p2 = ThisDrawing.Utility.GetPoint(p1, vbCr & "指定第二点:")
cd = GetDistance(p1, p2)
ce = GetPointhengkuandu(p1, p2)
ThisDrawing.Utility.GetReal ("距离=" & cd & Chr(13) & "X轴增量=" & ce )
Exit Sub
10000: 'MsgBox Error()
End Sub
'计算两点之间距离
Public Function GetDistance(ptSt As Variant, ptEn As Variant) As Double
    Dim x As Double
    Dim y As Double
    Dim z As Double
   
    x = ptSt(0) - ptEn(0)
    y = ptSt(1) - ptEn(1)
    z = ptSt(2) - ptEn(2)
   
    GetDistance = Sqr((Sqr((x ^ 2) + (y ^ 2)) ^ 2) + (z ^ 2))
End Function
Public Function GetPointhengkuandu(pts1 As Variant, pts2 As Variant) As Double
GetPointhengkuandu = pts2(0) - pts1(0)
End Function