Sub SetMapScale(MapDisp As MapObjects2.map, NewScale As Long)
'------------------------ Ul.MK ------------------- 03.11.2005 17:18:38
Const INCH2FEET = 12
Const INCH2METERS = 39.37
Const INCH2DEGREES = 4322893.46
Dim mapExtentWidth As Double
Dim convFactor As Double, rect As MapObjects2.Rectangle, k As Double
If MapDisp.Layers.Count = 0 Then Exit Sub
convFactor = INCH2METERS
mapExtentWidth = (NewScale * MapDisp.Width) / (convFactor * 1440)
Set rect = MapDisp.Extent
k = mapExtentWidth / rect.Width
rect.ScaleRectangle k
MapDisp.Extent = rect
Map1.Refresh
End Sub