تقييم الموضوع :
  • 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] كيف يمكن برمجة عدد السجلات واستعراض السجلات بشرط رقم الموظف ؟ Microformt 3 198 09-01-24, 01:05 AM
آخر رد: Taha Okla
Question [vb6.0] كيف يمكن استدعاء اسم البرنامج من النافدة هذه وضعة في textbox ؟ Microformt 1 161 02-01-24, 10:06 PM
آخر رد: Taha Okla
Question [vb6.0] كيف يمكن استدعاء هذه الدالة وضعها تحت زر الامر ؟ Microformt 1 169 31-12-23, 11:52 PM
آخر رد: Taha Okla
  [vb6.0] كيف يمكن إخفاء عمود رقم الصنف و إظهاره برمجياً نامل المساعدة في المثال التالي ؟ Microformt 2 387 19-11-23, 10:49 PM
آخر رد: Microformt
Question [vb6.0] هل هناك ادوات جديده يمكن استخدمها في تصميم برنامجي بدل ادوات فجوال البيسك ؟ Microformt 0 220 21-10-23, 07:34 PM
آخر رد: Microformt
  كيف يمكن تشغيل برنامجي على اكثر من جهاز بنفس الوقت princeofislam 1 291 14-10-23, 08:18 PM
آخر رد: princeofislam
Question [vb6.0] اريد إذا كان قيمة المحول صفر يظهر لي رسالة هل يمكن ذلك ؟ Microformt 0 371 20-03-23, 08:33 PM
آخر رد: Microformt
Question كيف يمكن تصفير الرسم البياني عند تشغيل البرنامج ؟؟ Microformt 0 702 06-08-22, 05:13 PM
آخر رد: Microformt
Question كيف يمكن فتح ملف exe من خلال برنامجي ؟؟ Microformt 2 872 02-05-22, 12:21 AM
آخر رد: Microformt
  [vb6.0] طلب : رسالة أن العنصر مكرر بالليست بوكس ولا يمكن إضافته مرة أخرى hamada salah90 2 1,264 05-12-21, 12:04 AM
آخر رد: hamada salah90

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


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