Форумы GIS-Lab.info

Код: Выделить всё

Include "mapbasic.def"

Define DEFRAD 1000 ' радиус в метрах по умолчанию

Declare Sub Main
Declare Sub ExitApp
Declare Sub MkCirc

Sub Main
  Create Menu "Круги" As
    "Создать круги" Calling MkCirc,
    "(-",
    "Выйти" Calling ExitApp
  Alter Menu ID 4 Add "Круги" As "Круги"
End Sub

Sub ExitApp
  End Program
End Sub

Sub MkCirc
  Dim sel, tbl, fname As String
  Dim sel_col1, sel_cobj As Alias
  Dim sel_obj As Object
  Dim r As Float

  If SelectionInfo(SEL_INFO_NROWS) = 0 Then
    Note "Выберите объект(ы) в окне ""Карта"""
    Exit Sub
  End If
  If WindowInfo(FrontWindow(), WIN_INFO_TYPE) <> WIN_MAPPER Then
    Note "Выберите объект(ы) в окне ""Карта"""
    Exit Sub
  End If
  Set CoordSys Window FrontWindow()
  ' Set Map Distance Units "m" / Странно, но не работает. Придётся переводить метры в статутные мили.
  fname = FileSaveAsDlg(GetFolderPath$(FOLDER_MYDOCS) + "\", "", "tab", "Создать таблицу")
  If fname = "" Then
    Exit Sub
  End If
  tbl = PathToTableName$(fname)
  sel = SelectionInfo(SEL_INFO_SELNAME)
  sel_col1 = sel + ".Col1"
  sel_cobj = sel + ".Obj"
  Create Table tbl ("Radius" Float)
  Create Map For tbl CoordSys Window FrontWindow()
  Fetch First From sel
  Do Until EOT(sel)
    sel_obj = sel_cobj
    Do Case ColumnInfo(sel, "COL1", COL_INFO_TYPE)
      Case COL_TYPE_DECIMAL, COL_TYPE_INTEGER, COL_TYPE_SMALLINT, COL_TYPE_FLOAT
        r = sel_col1
      Case Else
        r = DEFRAD
    End Case
    Insert Into tbl (Radius, Obj) Values (r, CreateCircle(CentroidX(sel_obj), CentroidY(sel_obj), r / 1609.344))
    Fetch Next From sel
  Loop
  Close Table sel
  Commit Table tbl
  Add Map Layer tbl
End Sub