اخواني اساتذتي الكرام السلام عليكم
كيف يمكن حساب المسافة بين نقطتين على سطح الارض وبدقة اعتمادا على خطوط الطول وخطوط العرض ؟ شاكرا لكم مقدما
جرب هذا
هذا الموقع يحتوي المعادلة بلغة VB.NET
This routine calculates the distance between two points
قمت بتحويله إلى VB6
كود :
Private Sub Command1_Click()
Dim dist As Double
' Point1 = 11.111111, 22.222222
' Point2 = 77.777777, 88.888888
' Unit = "K" ~ kilometers
dist = distance(11.111111, 22.222222, 77.777777, 88.888888, "K") ' K = km
MsgBox FormatNumber(dist) & " KM"
End Sub
':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
'::: :::
'::: This routine calculates the distance between two points (given the :::
'::: latitude/longitude of those points). It is being used to calculate :::
'::: the distance between two locations using GeoDataSource (TM) prodducts :::
'::: :::
'::: Definitions: :::
'::: South latitudes are negative, east longitudes are positive :::
'::: :::
'::: Passed to function: :::
'::: lat1, lon1 = Latitude and Longitude of point 1 (in decimal degrees) :::
'::: lat2, lon2 = Latitude and Longitude of point 2 (in decimal degrees) :::
'::: unit = the unit you desire for results :::
'::: where: 'M' is statute miles (default) :::
'::: 'K' is kilometers :::
'::: 'N' is nautical miles :::
'::: :::
'::: Worldwide cities and other features databases with latitude longitude :::
'::: are available at https://www.geodatasource.com :::
'::: :::
'::: For enquiries, please contact sales@geodatasource.com :::
'::: :::
'::: Official Web site: https://www.geodatasource.com :::
'::: :::
'::: GeoDataSource.com (C) All Rights Reserved 2017 :::
'::: :::
':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
Public Function distance(ByVal lat1 As Double, ByVal lon1 As Double, ByVal lat2 As Double, ByVal lon2 As Double, ByVal unit As String) As Double
Dim theta As Double
theta = lon1 - lon2
Dim dist As Double
dist = Sin(deg2rad(lat1)) * Sin(deg2rad(lat2)) + Cos(deg2rad(lat1)) * Cos(deg2rad(lat2)) * Cos(deg2rad(theta))
dist = ArcCos(dist)
dist = rad2deg(dist)
dist = dist * 60 * 1.1515
If unit = "K" Then
dist = dist * 1.609344
ElseIf unit = "N" Then
dist = dist * 0.8684
End If
distance = dist
End Function
Public Function ArcCos(ByVal x As Double) As Double
ArcCos = Atn(-x / Sqr(-x * x + 1)) + 2 * Atn(1)
End Function
Public Function ArcSin(ByVal x As Double) As Double
ArcSin = Atn(x / Sqr(-x * x + 1))
End Function
Public Function Pi() As Double
Pi = 4 * Atn(1#)
End Function
Private Function deg2rad(ByVal deg As Double) As Double
deg2rad = (deg * Pi / 180#)
End Function
Private Function rad2deg(ByVal rad As Double) As Double
rad2deg = rad / Pi * 180#
End Function
مع ملاحظة أن المسافة تقاس بشكل مستقيم بين النقطتين
(21-10-18, 11:43 PM)rnmr كتب : [ -> ]جرب هذا
هذا الموقع يحتوي المعادلة بلغة VB.NET
This routine calculates the distance between two points
قمت بتحويله إلى VB6
كود :
Private Sub Command1_Click()
Dim dist As Double
' Point1 = 11.111111, 22.222222
' Point2 = 77.777777, 88.888888
' Unit = "K" ~ kilometers
dist = distance(11.111111, 22.222222, 77.777777, 88.888888, "K") ' K = km
MsgBox FormatNumber(dist) & " KM"
End Sub
':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
'::: :::
'::: This routine calculates the distance between two points (given the :::
'::: latitude/longitude of those points). It is being used to calculate :::
'::: the distance between two locations using GeoDataSource (TM) prodducts :::
'::: :::
'::: Definitions: :::
'::: South latitudes are negative, east longitudes are positive :::
'::: :::
'::: Passed to function: :::
'::: lat1, lon1 = Latitude and Longitude of point 1 (in decimal degrees) :::
'::: lat2, lon2 = Latitude and Longitude of point 2 (in decimal degrees) :::
'::: unit = the unit you desire for results :::
'::: where: 'M' is statute miles (default) :::
'::: 'K' is kilometers :::
'::: 'N' is nautical miles :::
'::: :::
'::: Worldwide cities and other features databases with latitude longitude :::
'::: are available at https://www.geodatasource.com :::
'::: :::
'::: For enquiries, please contact sales@geodatasource.com :::
'::: :::
'::: Official Web site: https://www.geodatasource.com :::
'::: :::
'::: GeoDataSource.com (C) All Rights Reserved 2017 :::
'::: :::
':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
Public Function distance(ByVal lat1 As Double, ByVal lon1 As Double, ByVal lat2 As Double, ByVal lon2 As Double, ByVal unit As String) As Double
Dim theta As Double
theta = lon1 - lon2
Dim dist As Double
dist = Sin(deg2rad(lat1)) * Sin(deg2rad(lat2)) + Cos(deg2rad(lat1)) * Cos(deg2rad(lat2)) * Cos(deg2rad(theta))
dist = ArcCos(dist)
dist = rad2deg(dist)
dist = dist * 60 * 1.1515
If unit = "K" Then
dist = dist * 1.609344
ElseIf unit = "N" Then
dist = dist * 0.8684
End If
distance = dist
End Function
Public Function ArcCos(ByVal x As Double) As Double
ArcCos = Atn(-x / Sqr(-x * x + 1)) + 2 * Atn(1)
End Function
Public Function ArcSin(ByVal x As Double) As Double
ArcSin = Atn(x / Sqr(-x * x + 1))
End Function
Public Function Pi() As Double
Pi = 4 * Atn(1#)
End Function
Private Function deg2rad(ByVal deg As Double) As Double
deg2rad = (deg * Pi / 180#)
End Function
Private Function rad2deg(ByVal rad As Double) As Double
rad2deg = rad / Pi * 180#
End Function
مع ملاحظة أن المسافة تقاس بشكل مستقيم بين النقطتين
كل الشكر والتقدير لك اخي العزيز . لكن تبقى مشكلة الدقة . في السافات البعيدة تكون الدقة مقبولة نوعا ما اما في المسافات القصيرة(اقل من 1كم ) مثلا هناك فرق كبير جدا . اكرر شكري لك وتقديري
جرب هذا
لعل في البحث بجوجل يتم الحصول على كود أفضل وأدق من هذا
وأخشى أنك تقارن السير بالسيارة مثلا بنتيجة هذا الكود،
فبالطبع سيكون هناك فارق، لأن الكود يسحسب المسافة بخط مستقيم.
بالتوفيق
(22-10-18, 12:45 AM)rnmr كتب : [ -> ]جرب هذا
لعل في البحث بجوجل يتم الحصول على كود أفضل وأدق من هذا
وأخشى أنك تقارن السير بالسيارة مثلا بنتيجة هذا الكود،
فبالطبع سيكون هناك فارق، لأن الكود يسحسب المسافة بخط مستقيم.
بالتوفيق
شكرا لك اخي العزيز على متابعتك للموضوع . اخي العزيز المسألة ليست في الكود البرمجي المسألة تكمن في كيفية الحصول على المعادلة الرياضية الصحيحية . بالطبع اخي الكريم اعلم ان المسافة بخظ مستقيم لا تساوي المسافة المقطوعة بالسيارة الا اذا تحركت السيارة بخط مستقيم تماما وهذا نادر الحصول
جرب من جوجل ماب حساب المسافات الطويلة على الخريطة نفسها
اذا ظبطت معاك على الخريطة ابحث عن api googel map
شكرا لك استاذنا الكريم
بحمد الله تم ايجاد المعادلة الصحيحة وسأضعها في المنتدى قريبا للفائدة
كود :
Dim x As Double
Dim y As Double
x = 0
y = 0
----------------
'احداثيات النقطة الاولى
' خط العرض شمالا Text1
' خط الطول شرقا Text3
--------------------
'احداثيات النقطة الثانية
' خط العرض شمالا Text2
' خط الطول شرقا Text4
--------------------'
'المعادلة
x = 69.1 * (Val(Text2) - Val(Text1))
y = ((69.1 * (Val(Text4) - Val(Text3))) * Cos(Val(Text1)) / (Val(Text6)))
Text5 = (1.61 * ((Sqr(x ^ 2) + (y ^ 2))) - Val(Text7))
'-------------------------
'Text7=6.6
'وهو نصف قطر الارض بوحدة الميل(افترضياولا اعلم مدى دقته لكن عند وضعه بهذا القيمة اعطى نتائج دقيقة) وضعته متغيرا لوجود اختلاف فيه لان الارض ليست كرويه تماما
هذه المعادلة الدقيقة لحساب نقطتين على سطح الارض اضعها هنا للفائدة