Feelyou
Newbie | Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Вот кто-то просил координаты номенклатурных листов по их названиям
Public Function GST2LL(nList As String) As String
' поиск координат углов снимка по номенклатурному квадрату
' nList в формате N-36-012 или N-36-144-Г для масштаба 50.000
Dim LatList As Long, LonList As Long, ListKm100 As Long, Km050 As String
Dim LonBeg As Double, LatBeg As Double, LonEnd As Double, LatEnd As Double
On Error GoTo Skip
' миллионный лист, левый верхний угол
LonList = (CLng(Mid(nList, 3, 2)) - 30 - 1) * 6
LatList = (Asc(Left(nList, 1)) - 64) * 4
ListKm100 = CLng(Mid(nList, 6, 3))
If ListKm100 > 144 Then GoTo Skip
Km050 = Mid(nList, 10, 1)
' километровый лист, левый верхний угол
LonBeg = LonList + (ListKm100 - (Int((ListKm100 - 1) / 12) * 12)) * 0.5 - 0.5
LatBeg = LatList - Int((ListKm100 - 1) / 12) * (1 / 3)
' правый нижний угол листа
If Not Right(nList, 1) Like "#" Then Km050 = Right(nList, 1)
If Km050 = "" Then
LonEnd = LonBeg + 0.5: LatEnd = LatBeg - (1 / 3)
ElseIf Km050 = "А" Or Km050 = "A" Then
LonEnd = LonBeg + 0.25: LatEnd = LatBeg - (1 / 6)
ElseIf Km050 = "Б" Or Km050 = "B" Then
LonBeg = LonBeg + 0.25: LonEnd = LonBeg + 0.25: LatEnd = LatBeg - (1 / 6)
ElseIf Km050 = "В" Or Km050 = "V" Then
LonEnd = LonBeg + 0.25: LatBeg = LatBeg - (1 / 6): LatEnd = LatBeg - (1 / 6)
ElseIf Km050 = "Г" Or Km050 = "G" Then
LonBeg = LonBeg + 0.25: LonEnd = LonBeg + 0.25
LatBeg = LatBeg - (1 / 6): LatEnd = LatBeg - (1 / 6)
End If
' приводим к текстовому выводу с разделителем запятой и 6-ю нулями
GST2LL = FFormat(CStr(LonBeg), 6, ",") & "/" & FFormat(CStr(LatBeg), 6, ",") & "-" & _
FFormat(CStr(LonEnd), 6, ",") & "/" & FFormat(CStr(LatEnd), 6, ",")
Skip:
End Function
сдвоенные листы не понимает, опять же - простите за VB
сюда же можно прикрутить поиск имени номенклатурного листа,
максимум названий можно найти на http://stern.vitagil.ru/maps/blank.html;
полного списка километровых листов я найти не смог... |
