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
Levent
21 Mayıs 2012 — 08:23
Merhaba Ömerim,
Googlede “MAPPER_INFO_DISPLAY_ZOOM” araması yaptığımda senin sayfan zirvede çıktı 🙂 Bende integrated map’ e başladım. Yeni projelerde görüşmek dileğiyle 🙂
Levent
Ömer SAVAŞ
22 Mayıs 2012 — 09:04
Ben bu programdan sonra hiç bakmadım farklı işler çıktı :/ Aynı projede çalışmaktan şeref duyarım 🙂
Nily
15 Kasım 2012 — 16:24
Merhabalar bir sorunum var ama umarım yardımcı olabilirsiniz. Benim bir projeye 3 çeşit yol eklemem gerekiyor; bulvar, cadde, sokak gibi. Fakat ekleyeceğim yol hangisiyse ona göre şekilinde farklılaşması gerekiyor. Örneğin bulvar eklenecekse üç çizgili bir yol gözükecek. Fakat bu şekilleri nasıl yollarla ilişkilendireceğimi bilemedim. Yardımcı olabilirseniz sevinirim.
Ömer SAVAŞ
11 Mart 2013 — 07:51
Mail ile cevap verdim.