Seçilen-Noktayı-Parsel-Sorguda-Aç.nvb

'Netcad üzerinde tıklanan herhangi bir noktayı parselsorgulama sistemi üzerinden sorgular ve ilgili ada/parseli açar
'30.03.2020 "Covid-19 Zamanları"
'Salih Görkem TABAK - Jeodezi ve Fotogrametri Mühendisi
'gorkemtabak@gmail.com
'https://gorkemtabak.blogspot.com
'https://github.com/grkm

Sub Main

Dim cr
dim dom6,x6,y6,dom3,x3,y3
dim a,b,k0,f,f1,e,eisq,ei,kc1,kc2,kc3,kc4,sin1
dim yayuzunlugu,mu,phi,c1,t1,n1,r1,d
dim fact1,fact2,fact3,fact4,lofact1,lofact2,lofact3,deltalong,zoneDOM,rawEnlem
dim enlem,boylam,enlemderece,enlemdakika,enlemsaniye,boylamderece,boylamdakika,boylamsaniye
dim pi
dim objShell,url
dim x,y
dim secim

with Netcad

'Kullanıcıdan koordinat sistemi ve DOM bilgisini alır
'DOM 27 - 30 - 33 - 36 - 39 - 42 - 45
'Koordinat ITRF96 - ED50
'Dilim 3 Derece - 6 Derece
set secim = Netcad.NewBDialog("Parsel Sorgulama Sayfasında Ara")
secim.Getcombo "dilim","Dilim : ","3",0
secim.Getcombo "koordinat","Koordinat Sistemi : ","ITRF96",0
secim.Getcombo "dilimorta","Dilim Orta Meridyeni : ","27|30|33|36|39|42|45",3
if secim.showmodal then

set cr = .newc(0,0,0)
while .SelectPoint("Herhangi Bir Nokta Seç",cr,-1)
'Değişmeyen Sabit
pi=3.141592654 'Yaklaşık en doğru sonuca bu şekilde ulaştım

'dom ayarlaması
if secim.ValueByName("dilimorta")=0 then
dom3=27
ElseIf secim.ValueByName("dilimorta")=1 then
dom3=30
ElseIf secim.ValueByName("dilimorta")=2 then
dom3=33
ElseIf secim.ValueByName("dilimorta")=3 then 
dom3=36
ElseIf secim.ValueByName("dilimorta")=4 then 
dom3=39
ElseIf secim.ValueByName("dilimorta")=5 then 
dom3=42
ElseIf secim.ValueByName("dilimorta")=6 then 
dom3=45
end if

x3=CDbl(cr.x)
y3=CDbl(cr.y)

'Sabit Değerler ITRF96(GRS80)-ED50(HAYFORD) için
if secim.ValueByName("koordinat")=0 then
'ITRF96 GRS80 Dönüşüm Parametreleri
a=6378137
b=6356752.31410
else
'ED50 HAYFORD Dönüşüm Parametreleri
a=6378388
b=6356911.9
end if

'Seçilen Dilime Göre k0 ayarlanır
if secim.ValueByName("dilim")=0 then
k0=0.9996 '3 Derece için
'3 Derecelik sistemdeki koordinatlar 6 Derecelik sisteme çevrilir
dom6=(((dom3+3)/6)+30)
y6=(y3-500000)*k0+500000
x6=(x3*k0)
else
k0=1 '6 Derece için
dom6=dom3
y6=y3
x6=x3
end if

'Hesaplama kısmı
'Bu kısımda ufak tefek hatalarım olmuş olabilir.
'Açıkçası işimi görecek kadar doğruluk yeterli olduğu için görmezden geliyorum şimdilik. 
'36 için sonuçlar gayet iyi diğer domlar için test etme şansım olmadı o kısımlar size ait.
f=(a-b)/a
f1=1/f
e=sqr(1-(b/a)*(b/a))
eisq=e*e/(1-(e*e))
ei=(1-sqr(1-e*e))/(1+sqr(1-e*e))
sin1=21*ei^2/16-55*ei^4/32
kc1=3*ei/2-27*ei^3/32
kc2=21*ei^2/16-55*ei^4/32
kc3=151*ei^3/96
kc4=1097*ei^4/512
x=500000-(y6)
y=x6
yayuzunlugu=x6/k0
mu=yayuzunlugu/(a*(1-(e^2/4)-3*(e^4/64)-5*(e^6/256)))
phi=mu+kc1*Sin(2*mu)+kc2*Sin(4*mu)+kc3*Sin(6*mu)+kc4*Sin(8*mu)
c1=eisq*(Cos(phi)^2)
t1=Tan(phi)^2
n1=a/((1-(e*Sin(phi))^2)^(1/2))
r1=a*(1-e*e)/(1-(e*Sin(phi))^2)^(3/2)
d=x/(n1*k0)
fact1=n1*Tan(phi)/r1
fact2=((d*d)/2)
fact3=(5+(3*t1)+(10*c1)-(4*c1*c1)-(9*eisq))*(d^4/24)
fact4=(61+90*t1+298*c1+45*t1*t1-252*eisq-3*c1*c1)*d^6/720
lofact1=d
lofact2=(1+(2*t1)+c1)*(d^3/6)
lofact3=(5-2*c1+28*t1-3*c1*c1+8*eisq+24*t1*t1)*d^5/120
deltalong=(lofact1-lofact2+lofact3)/(Cos(phi))
zoneDOM=6*dom6-183
rawEnlem=180*(phi-fact1*(fact2+fact3+fact4))/pi

'Tüm hesaplamalara göre enlem ve boylam hesaplanır
enlem=rawEnlem
boylam=zoneDOM-((deltalong*180)/pi)

'Bilgisayarda tanımlı internet tarayıcısında sonuçlar açılır    
url="https://parselsorgu.tkgm.gov.tr/#ara/cografi/"&Cstr(enlem)&"/"&Cstr(boylam)
set objShell = CreateObject("WScript.Shell")
objShell.run(url)  		  
	   
wend
set cr = nothing

set secim = Nothing
end if

end with
end sub