Форумы GIS-Lab.info

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

Sub build_sub
	'построить контур по введенным координатам
	Dim i As Integer
	Dim obj_region As Object
	Dim new_table_path,new_table_name As String
	new_table_name = "new_table"

	new_table_path = FileSaveAsDlg("",new_table_name,"TAB","Сохранить координаты нового участка как...")
	'если пользователь не нажал "отмена"
	If new_table_path Then
		'создать таблицу с контуром (полигон)
		Create Table new_table_name
		(	y_coord Float,
			x_coord Float)
			File new_table_path
			Type NATIVE
			Version 300
		'произвести настройки таблицы
		Create Map For new_table_name CoordSys Nonearth Units "m" Bounds (0,0)(25000,25000)
		
		'создать пустой объект типа "region"
		Create Region Into Variable obj_region 0

		Alter Object obj_region Node Add (12000,14000)
		Alter Object obj_region Node Add (13000,14000)
		Alter Object obj_region Node Add (13000,15000)
		Alter Object obj_region Node Add (12000,15000)
		
		'поместить область с вершинами в таблицу
		Insert Into new_table_name (Object) Values (obj_region)
	End If
End Sub

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

      Set coordsys table new_table_name

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

      Set Distance Units "m"

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

Commit Table new_table_name 

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

Sub build_sub

	'построить контур по введенным координатам
	Dim win_id,i,i_len,pos,l_pos As Integer
	Dim obj_region As Object
	Dim str,s_x,s_y,new_table_path,new_table_name As String
	new_table_name = "new_table"
    'получить идентификатор активного окна
	win_id = FrontWindow()
	'запросить путь размещения и имя новой таблицы
	new_table_path = FileSaveAsDlg("",new_table_name,"TAB","Сохранить координаты нового участка как...")
	
	'если пользователь не нажал "отмена"
	If new_table_path Then
	
		'получить имя таблицы
		pos = 1
		l_pos = 1
		While pos > 0
			pos = InStr(l_pos + 1,new_table_path,"\")
			If pos > 0 Then
				l_pos = pos
			End If
		Wend
		i_len = Len(new_table_path)
		new_table_name = Mid$(new_table_path,l_pos+1,i_len - l_pos - 4)
		
		'установить систему координат сеанса
		Set CoordSys NonEarth Units "m" Bounds (0,0)(25000,25000)
		Set Distance Units "m"
		'создать таблицу с координатами точек и контуром (полигон)
		Create Table new_table_name
		(	y_coord Float,
			x_coord Float)
			File new_table_path
			Type NATIVE
			Version 300
		'произвести настройки таблицы, включить возможность добавления графических объектов 
		Create Map For new_table_name CoordSys Nonearth Units "m" Bounds (0,0)(25000,25000)
		'установить настройки таблицы
		Set CoordSys table new_table_name
		
		'создать пустой объект типа "область"
		Create Region Into Variable obj_region 0
			Pen (3,2,255) 'задать тип границы
			Brush (1,0,0) 'задать тип заливки

		'запись координат точек в новую таблицу
		'цикл по точкам
		For i = 1 to i_itemCount Step 1
			str = s_pointsArray(i) 'массив строк, содержащий координаты точек с разделителем, указанным в след. строке кода
			pos = InStr(1,str,"   ")
			i_len = Len(str)
			s_x = Mid$(str,1,pos-1)
			s_y = Mid$(str,pos+3,i_len-pos-2)
			Insert Into new_table_name (y_coord,x_coord) Values (s_x,s_y)
			Alter Object obj_region Node Add (Val(s_x),Val(s_y))
		Next
		
		'поместить область с вершинами в таблицу
		Insert Into new_table_name (Object) Values (obj_region)
		'сохранить изменения
		Commit Table new_table_name 'As new_table_path Type NATIVE CoordSys Nonearth Units "m" Bounds (0,0)(25000,25000) Version 300
		'добавить таблицу к активной карте или создать новую карту, если нет активной карты
		If win_id Then
			Add Map Layer new_table_name
		Else
			Map from new_table_name
		End If
	End If
End Sub

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

Set CoordSys table new_table_name