[السيد الغالي]

اخواني اساتذتي الكرام السلام عليكم
كيف يمكن حساب المسافة بين نقطتين على سطح الارض وبدقة اعتمادا على خطوط الطول وخطوط العرض ؟ شاكرا لكم مقدما

[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

---

مع ملاحظة أن المسافة تقاس بشكل مستقيم بين النقطتين

[السيد الغالي]

(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كم ) مثلا هناك فرق كبير جدا . اكرر شكري لك وتقديري

[rnmr]

جرب هذا


لعل في البحث بجوجل يتم الحصول على كود أفضل وأدق من هذا

وأخشى أنك تقارن السير بالسيارة مثلا بنتيجة هذا الكود،
فبالطبع سيكون هناك فارق، لأن الكود يسحسب المسافة بخط مستقيم.

بالتوفيق

[السيد الغالي]

(22-10-18, 12:45 AM)rnmr كتب : جرب هذا


لعل في البحث بجوجل يتم الحصول على كود أفضل وأدق من هذا

وأخشى أنك تقارن السير بالسيارة مثلا بنتيجة هذا الكود،
فبالطبع سيكون هناك فارق، لأن الكود يسحسب المسافة بخط مستقيم.

بالتوفيق

شكرا لك اخي العزيز على متابعتك للموضوع . اخي العزيز المسألة ليست في الكود البرمجي المسألة تكمن في كيفية الحصول على المعادلة الرياضية الصحيحية . بالطبع اخي الكريم اعلم ان المسافة بخظ مستقيم لا تساوي المسافة المقطوعة بالسيارة الا اذا تحركت السيارة بخط مستقيم تماما وهذا نادر الحصول

[mero5000]

جرب من جوجل ماب حساب المسافات الطويلة على الخريطة نفسها
اذا ظبطت معاك على الخريطة ابحث عن 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
'وهو نصف قطر الارض بوحدة الميل(افترضياولا اعلم مدى دقته لكن عند وضعه بهذا القيمة اعطى نتائج دقيقة) وضعته متغيرا لوجود اختلاف فيه لان الارض ليست كرويه تماما

هذه المعادلة الدقيقة لحساب نقطتين على سطح الارض اضعها هنا للفائدة