Mapbasic ile yazmış olduğum bu uygulama mevcut yollar üzerinden seçilen bir yolu inceleyerek kullanıcının istediği uzunlukta yeni bir yol oluşturuyor. Proje dosyalarını buradan indirebilirsiniz.

Önizlemeler

Program Kodları

include "mapbasic.def"
include "icons.def"

declare sub main
declare sub yolCiz
declare sub kozmetikTemizle
declare function yolSec(yollar() as string) as integer
declare function kkno(ByVal no as integer, ByVal tur as integer) as string

sub main
	create buttonpad "YolPad" as
		toolbutton calling yolCiz icon MI_ICON_ADD_NODE cursor MI_CURSOR_CROSS
End Sub

sub yolCiz

	'Pencere kontrol
	if WindowInfo(frontwindow(), win_info_type) <> win_mapper then
		note "Bu fonksiyon sadece harita penceresinde çalışır!"
		exit sub
	End If

	'Kordinat sistemini ayarla
	set CoordSys window FrontWindow()

	'Tıkladığı noktayı tespit et
	dim x, y as integer

	x = CommandInfo(CMD_INFO_X)
	y = CommandInfo(CMD_INFO_Y)

	'Bufer oluştur ve kozmetik katmanı temizle
	dim alan as object
	dim genislik as integer

	call kozmetikTemizle
	insert into kozmetik (obj) values (createpoint(x, y))

	'Zoom a göre buferı büyüt
	genislik = Int(MapperInfo(FrontWindow(), MAPPER_INFO_DISPLAY_ZOOM))
	genislik = genislik * 20

	if genislik = 0 then
		genislik = 50
	End If

	create object as buffer from kozmetik into variable alan width genislik units "m" resolution 25
	call kozmetikTemizle

	'Buferın deydiği yolları tespit et
	select * from koyyolu where obj intersects alan into tablo

	'Yol yoksa bitir
	if TableInfo(tablo, TAB_INFO_NROWS) = 0 then
		note "Seçtiğiniz noktada yol bulunamadı. Yola daha yakın tıklatınız."
		exit sub
	End If

	'Düzenlemek istediği yolu tespit et (buferın deydiği yollar listesinden)
	dim secim as integer

	if TableInfo(tablo, TAB_INFO_NROWS) = 1 then'Tek yol varsa onu seç
		secim = 1
	else

		'Listeyi diziye ata ve fonksiyona gönder
		fetch first from tablo

		dim liste(1), no as string
		redim liste(TableInfo(tablo, TAB_INFO_NROWS))

		dim i as integer
		for i=1 to TableInfo(tablo, TAB_INFO_NROWS)

			liste(i) = kkno(tablo.kkno, tablo.tur) + " - " + tablo.tanim
			fetch next from tablo
		Next

		'Listeyi fonksiyona gönder
		secim = yolSec(liste)

		'0 geldi ise iptal etmiştir
		if secim = 0 then
			exit sub
		End If

	end if

	dim basla, bitir, parcaListeStr(1) as string
	dim parca, pNo, parcaListe(1), j, x1, y1, x2, y2, rId as integer
	dim yol, bNokta as object
	dim uzunluk as float

	'Seçilen kayda git
	fetch rec secim from tablo

	yol = ConvertToPline(tablo.obj)

	'Haritada da kullanıcının istediği yolu seç
	rId = tablo.id
	select * from koyyolu where id = rId

	'Kullanıcıyı bilgilendirmek için yolların başına başlangıç burasıdır diye nokta at
	parca = ObjectInfo(yol, OBJ_INFO_NPOLYGONS)

	redim parcaListe(parca)
	redim parcaListeStr(parca)

	call kozmetikTemizle

	for i=1 to parca

		parcaListe(i) = ObjectInfo(yol, OBJ_INFO_NPOLYGONS+i)

		uzunluk = 0

		for j = 1 to parcaListe(i)-1

		x1 = ObjectNodeX(yol, i, j)
		x2 = ObjectNodeX(yol, i, j+1)
		y1 = ObjectNodeY(yol, i, j)
		y2 = ObjectNodeY(yol, i, j+1)

		if j = 1 then

			bNokta = CreatePoint(x1, y1)
			alter object bNokta Info OBJ_INFO_SYMBOL, MakeSymbol(67, RGB(0,48,255), 40)
			insert into kozmetik (obj, aciklama) values (bNokta, i + ". parça başlangıcı")
			Set Map Window windowId(FrontWindow()) Layer kozmetik Label Auto On

		End If

		uzunluk = uzunluk + SphericalDistance(x1, y1, x2, y2, "km")

		next

		parcaListeStr(i) = i + ". parca - " + uzunluk + "km"

	Next

	'Hangi parçanın ne kadar kısmı düzenlenecek onu tespit et
	dialog title "Yeni yatırım ekle"
		control statictext title kkno(tablo.kkno, tablo.tur) + " - " + tablo.tanim position 5, 5 width 220
		control statictext title "Toplam " + str$(SphericalObjectLen(tablo.obj, "km")) + " km" position 5, 15 width 220
		control statictext title "Başlangıç noktası (km)" position 5, 35 width 80
		control edittext value "0.0" into basla position 90,33 width 80
		control statictext title "Bitiş noktası (km)" position 5, 55 width 80
		control edittext value "1.0" into bitir position 90,53 width 80
		control statictext title "Parçalar " position 5, 75 width 220
		control listbox title from variable parcaListeStr into pNo position 5, 90 width 220 value 1
		control okbutton
		control cancelbutton

	'İptale bastı ise bitir
	if commandInfo(cmd_info_dlg_ok) = 0 then
		call kozmetikTemizle
		exit sub
	End If

	dim d1, d2 as float
	dim n1, n2 as integer

	d1 = Val(basla)
	d2 = Val(bitir)
	uzunluk = 0

	'Yol bilgilerini yazdır
	print chr$(12)
	print "Başlıyor..."
	print "Parça sayısı: " + parca

	if parca > 1 then
		for i=1 to parca
			print i + ". parça nod sayısı: " + parcaListe(i)
		Next
	End If

	print "Toplam node Sayısı: " + ObjectInfo(yol, OBJ_INFO_NPNTS)

	'Başlangıç nodunu bul
	n1 = 1

	do while uzunluk < d1

		x1 = ObjectNodeX(yol, pNo, n1)
		x2 = ObjectNodeX(yol, pNo, n1+1)
		y1 = ObjectNodeY(yol, pNo, n1)
		y2 = ObjectNodeY(yol, pNo, n1+1)

		uzunluk = uzunluk + SphericalDistance(x1, y1, x2, y2, "km")

		n1 = n1 + 1

	Loop

	'Bitiş nodunu bul
	n2 = n1

	do while uzunluk < d2

		x1 = ObjectNodeX(yol, pNo, n2)
		x2 = ObjectNodeX(yol, pNo, n2+1)
		y1 = ObjectNodeY(yol, pNo, n2)
		y2 = ObjectNodeY(yol, pNo, n2+1)

		uzunluk = uzunluk + SphericalDistance(x1, y1, x2, y2, "km")

		n2 = n2 + 1

	Loop

	print "Başlangıç nodu: " + n1
	print "Bitiş nodu: " + n2

	'İstenilen uzunlukta yolu oluştur
	yol = ExtractNodes(yol, 1, n1, n2, FALSE)

	'Çizgi sitilini belirginleştir
	alter object yol Info  OBJ_INFO_PEN, makepen(4,2,RED)

	'İstenilen özellikteki yolu katmana ekle
	'istenilirse sözel verilerle beraber başka bir tabloyada eklenebilir.
	call kozmetikTemizle
	insert into kozmetik (obj) values (yol)

	print "Başarılı!"

End Sub

sub kozmetikTemizle
	delete from kozmetik
End Sub

function yolSec(yollar() as string) as integer

	dim secilen as integer

	dialog title "Yol seç"
		control statictext title "Seçilen alandaki noktalar:" position 5, 5 id 1 width 200
		control listbox position 5, 15 title from variable yollar into secilen id 2 width 200
		control okbutton
		control cancelbutton

	if CommandInfo(CMD_INFO_DLG_OK) then
		yolSec = secilen
	else
		yolSec = 0
	End If

End Function

function kkno(ByVal no as integer, ByVal tur as integer) as string

	'integer kontrol kesim numarasını ###-# formatına dönüştür

	dim strNo as string
	strNo = Str$(no)

	if no < 10 then
		strNo = "00" + strNo
	end if

	if no < 100 and no > 9 then
		strNo = "0" + strNo
	End If

	if tur = 3 then
		strNo = strNo + "-2"
	End If

	kkno = strNo

End Function