تقييم الموضوع :
  • 0 أصوات - بمعدل 0
  • 1
  • 2
  • 3
  • 4
  • 5
[سؤال] كيف يمكن حساب المسافة بدقة على سطح الارض
#1
اخواني اساتذتي الكرام السلام عليكم
كيف يمكن حساب المسافة بين نقطتين على سطح الارض وبدقة اعتمادا على خطوط الطول وخطوط العرض ؟ شاكرا لكم مقدما
   تحيــــــــــــــــــــــــــــاتي لكـــــــــــــــــــم    
الرد
تم الشكر بواسطة:
#2
جرب هذا

هذا الموقع يحتوي المعادلة بلغة 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

مع ملاحظة أن المسافة تقاس بشكل مستقيم بين النقطتين
الرد
تم الشكر بواسطة: السيد الغالي
#3
(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كم ) مثلا هناك فرق كبير جدا . اكرر شكري لك وتقديري
   تحيــــــــــــــــــــــــــــاتي لكـــــــــــــــــــم    
الرد
تم الشكر بواسطة:
#4
جرب هذا


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

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

بالتوفيق
الرد
تم الشكر بواسطة: السيد الغالي
#5
(22-10-18, 12:45 AM)rnmr كتب : جرب هذا


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

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

بالتوفيق

شكرا لك اخي العزيز على متابعتك للموضوع . اخي العزيز المسألة ليست في الكود البرمجي المسألة تكمن في كيفية الحصول على المعادلة الرياضية الصحيحية . بالطبع اخي الكريم اعلم ان المسافة بخظ مستقيم لا تساوي المسافة المقطوعة بالسيارة الا اذا تحركت السيارة بخط مستقيم تماما وهذا نادر الحصول
   تحيــــــــــــــــــــــــــــاتي لكـــــــــــــــــــم    
الرد
تم الشكر بواسطة: rnmr
#6
جرب من جوجل ماب حساب المسافات الطويلة على الخريطة نفسها
اذا ظبطت معاك على الخريطة ابحث عن api googel map
الرد
تم الشكر بواسطة: السيد الغالي
#7
شكرا لك استاذنا الكريم
بحمد الله تم ايجاد المعادلة الصحيحة  وسأضعها في المنتدى قريبا للفائدة
   تحيــــــــــــــــــــــــــــاتي لكـــــــــــــــــــم    
الرد
تم الشكر بواسطة:
#8
كود :
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
'وهو نصف قطر الارض بوحدة الميل(افترضياولا اعلم مدى دقته لكن عند وضعه بهذا القيمة اعطى نتائج دقيقة) وضعته متغيرا لوجود اختلاف فيه لان الارض ليست كرويه تماما
هذه المعادلة الدقيقة لحساب نقطتين على سطح الارض اضعها هنا للفائدة
   تحيــــــــــــــــــــــــــــاتي لكـــــــــــــــــــم    
الرد
تم الشكر بواسطة: rnmr , rnmr , elgokr , elgokr


المواضيع المحتمل أن تكون متشابهة .
الموضوع : الكاتب الردود : المشاهدات : آخر رد
Question [vb6.0] هل يمكن توزيع التاريخ بحث يكون السنة في Text والشهر في Text اخر واليوم في text ؟؟ Microformt 1 73 03-10-18, 07:29 PM
آخر رد: جاسم عبد
  [سؤال] [تم الحل] مشكلة برنامج حساب نسب الموظفين awidan76 29 1,724 08-08-18, 08:51 PM
آخر رد: awidan76
Question [vb6.0] هل يمكن استخدم كاميرة الحاسب في تصور الموظفين وحفظ الصورة بقاعدة بيانات برنامجي ؟؟ Microformt 3 241 27-07-18, 10:47 AM
آخر رد: Ahmed_Mansoor
  هل يمكن جمع أيام الغياب بإذن وبدون إذن مصمم هاوي 4 228 18-07-18, 02:37 PM
آخر رد: awidan76
  كيف يمكن ان استخدم جملة orderby princeofislam 5 229 20-06-18, 11:19 PM
آخر رد: elgokr
Question [vb6.0] هل يمكن نقل موشر الكتابة الى Label مثل زر الامر الذي في الصورة المرفقة؟؟ Microformt 1 163 07-06-18, 10:32 PM
آخر رد: Amir_alzubidy
Question [vb6.0] هل يمكن عمل تقرير من خلال اكتف ريبورت لطابعه التالية ؟ Mysystem32 1 198 08-05-18, 06:14 PM
آخر رد: sendbad100
Question [vb6.0] هل يمكن تشفير قاعدة البيانات اكسس بحث لا يمكن فتحها من خلال برنامج Microsoft Access Microformt 0 231 05-05-18, 02:40 PM
آخر رد: Microformt
  احبابى في الله هل يمكن اضافة زر بالكود ام لا mhareek 2 203 11-04-18, 01:30 AM
آخر رد: Top GreaT
  تعديل كشف حساب للعميل w123eg 1 329 29-03-18, 10:19 AM
آخر رد: nourmandour

التنقل السريع :


يقوم بقرائة الموضوع: بالاضافة الى ( 1 ) ضيف كريم