Код: Выделить всё
ScaleBar<-function(barlength, # Длина шкалы масштаба в м
map, # Карта, на которую ее нужно поместить (растр или "OpenStreetMap" объект)
inset=c(1/50,1/50,1.2), # Сдвиг вверх и влево по отношению к правому нижнему углу (1 - по x, 2 - по y, 3 - по x для учета длины масштабной линейки)
col="black", # Цвет подписей
label=c(0,barlength/2/1000,barlength/1000), # Подписи на масштабной линейке (по умолчанию в км)
unit="км", # Подпись единиц на масштабной линейке
divs=4, # Число подразделений на масштабной линейке
cex=1, # Размер подписей
box=T, # Прямоугольник вокруг масштабной линейки
bcol="white", # Цвет прямоугольника
blwd=1, # Толщина линий прямоугольника
blty=1, # Тип линий прямоугольника
badj=0.025, # Коэффициент для размера прямоугольника
...) {
require(raster)
require(OpenStreetMap)
require(sp)
if (class(map)=="OpenStreetMap") {proj<-osm()
obb<-unlist(map$bbox)} else {proj<-crs(map)
obb<-c(extent(map))} # Координаты углов карты
# Вычисляем нужную длину линейки в единицах карты
rp<-SpatialPoints(data.frame(x=obb[3],y=obb[4]),
proj4string = proj) # Нижний правый угол карты
rp<-spTransform(rp,CRS("+proj=utm +zone=37 +ellps=WGS84 +datum=WGS84 +units=m +no_defs")) # Перевод в проекцию UTM
rp1<-SpatialPoints(data.frame(x=rp@coords[1]-barlength,y=rp@coords[2]),proj4string = crs(rp)) # Вторая точка для отрезка, задающего нужную длину масштабной линейки
rp<-spTransform(rp,proj)
rp1<-spTransform(rp1,proj) # Возвращаем координаты в исходную проекцию
rd<-rp@coords[1]-rp1@coords[1] # Находим длину линейки в единицах исходной проекции
rco<-c(obb[3]-(obb[3]-obb[1])*inset[1]-rd*inset[3],obb[4]+(obb[2]-obb[4])*inset[2]) # Правый верхний угол области масштабной линейки, с учетом сдвига
lu<-paste(label,c(rep("",length(label)-1),unit),sep=" ") # Подписи для линейки с единицей измерения
if (box) { # Нарисовать прямоугольник вокруг масштабной линейки
sh<-c((obb[2]-obb[4])*badj,(obb[3]-obb[1])*badj*1.4)
wb<-matrix(c(rco+sh*c(-1,1),
rp@coords[1],rco[2]+sh[2],
rp@coords,
rco[1]-sh[1],rp@coords[2],
rco+sh*c(-1,1)),ncol=2,byrow=T)
wb<-Polygon(wb)
wb<-Polygons(list(wb),ID=1)
wb<-SpatialPolygons(list(wb),as.integer(1),proj)
plot(wb,add=T,col=bcol,lwd=blwd,lty=blty)
}
scalebar(rd,type = "bar",divs = divs,xy = rco,label = lu, col=col, cex=cex, ...) # Рисуем масштабную линейку
}
