Написать скрипт примерно такой (заранее говорю - писался для 8.3 и ограниченного набора растров - так что для себя исправляйте сами):
Private Sub MapInfoRasters2ArcGis()
Dim sdir As String
Dim soutdir As String
sdir = "C:\Test"
soutdir = "C:\Test\out"
' Эта процедура читает все файлы формата TIFF, привязанные в MapInfo во входном каталоге
' и сохраняет их в выходном каталоге, в формате понятном для ArcGis.
' входные файлы должны иметь расширение tif и должны иметь файлы привязки с расширением tab.
' Файл tab должен выглядеть так:
' !table
' !version 300
' !charset WindowsCyrillic
' Definition Table
' File "1046.tif"
' Type "RASTER"
' (4362037.5999999996,5585892.5999999996) (30,25) Label "Pnt 1",
' (4370900,5586004.5) (4215,38) Label "Pnt 2",
' (4371024.7999999998,5576734.7999999998) (4210,4420) Label "Pnt 3",
' (4362146.9000000004,5576622.7000000002) (18,4404) Label "Pnt 4"
' CoordSys NonEarth Units "m"
' Units "m"
On Error GoTo er
Dim pWsFact As IWorkspaceFactory
Dim pWs As IWorkspace
Dim pEnumRasters As IEnumDataset
Dim pRasterDs As IRasterDataset
Dim pRasterProp As IRasterProps
'Dim xmin As Double, ymin As Double
Dim pGeometryProc As IRasterGeometryProc
Dim dX As Double, dY As Double
', dx0 As Double, dy0 As Double
'Dim lScale As Double
Dim pBandc As IRasterBandCollection
Dim pRaster As IRaster
Dim pSourcePoints As IPointCollection
Dim pTargetPoints As IPointCollection
'Dim pPoint As IPoint
Dim TabFileName As String
Dim OutFileName As String
Dim TabFileOk As Boolean
' Get enumrasterdatasets in the directory
Set pWsFact = New RasterWorkspaceFactory
Set pWs = pWsFact.OpenFromFile(sdir, 0)
Set pEnumRasters = pWs.Datasets(esriDTRasterDataset)
Set pSourcePoints = New Multipoint
Set pTargetPoints = New Multipoint
' Loop through all rasterdatasets and resample
Set pGeometryProc = New RasterGeometryProc
Set pRasterDs = pEnumRasters.Next
Do While Not pRasterDs Is Nothing
' get rasterprops
Set pRaster = pRasterDs.CreateDefaultRaster
Set pBandc = pRaster
Set pRasterProp = pBandc.Item(0)
' collections of source and target points for two point transform
TabFileName = Replace(pRasterDs.CompleteName, ".tif", ".tab")
dX = pRasterProp.Width / pRasterProp.Extent.Width
dY = pRasterProp.Height / pRasterProp.Extent.Height
TabFileOk = TabRead(TabFileName, pSourcePoints, pTargetPoints, dX, dY)
If TabFileOk Then
pGeometryProc.Warp pSourcePoints, pTargetPoints, 1, pRaster
OutFileName = Replace(pRasterDs.CompleteName, sdir, soutdir)
pGeometryProc.Rectify OutFileName, "TIFF", pRaster
pSourcePoints.RemovePoints 0, pSourcePoints.PointCount
pTargetPoints.RemovePoints 0, pTargetPoints.PointCount
End If
' get next one
Set pRasterDs = pEnumRasters.Next
Loop
' cleanup
Set pWsFact = Nothing
Set pWs = Nothing
Set pEnumRasters = Nothing
Set pRasterDs = Nothing
Set pRasterProp = Nothing
Set pBandc = Nothing
Set pGeometryProc = Nothing
Set pRaster = Nothing
Set pSourcePoints = Nothing
Set pTargetPoints = Nothing
Exit Sub
er:
MsgBox Err.Description
End Sub
Private Function TabRead(TabFileName As String, ptincoll As IPointCollection, _
ptoutcoll As IPointCollection, dX As Double, dY As Double)
Dim InString As String
Dim SearchStr As String
Dim InPntStr As String
Dim OutPntStr As String
Dim pPoint As IPoint
Dim X As Double
Dim Y As Double
Dim A As Variant
Dim fs As New FileSystemObject
Dim anTabFile As TextStream
Set fs = CreateObject("Scripting.FileSystemObject")
If Not fs.FileExists(TabFileName) Then
Set fs = Nothing
TabRead = False
Exit Function
End If
Set anTabFile = fs.OpenTextFile(TabFileName, ForReading, False)
Do While anTabFile.AtEndOfStream <> True ' Loop until end of file.
InString = Trim(anTabFile.ReadLine)
If InStr(1, InString, "Label", 1) > 0 Then
A = Split(InString, " ", -1, vbTextCompare)
OutPntStr = Mid(A(0), 2, Len(A(0)) - 2)
InPntStr = Mid(A(1), 2, Len(A(1)) - 2)
A = Split(OutPntStr, ",", -1, vbTextCompare)
X = CDbl(A(0))
Y = CDbl(A(1))
Set pPoint = New Point
pPoint.X = X
pPoint.Y = Y
ptoutcoll.AddPoint pPoint
Set pPoint = Nothing
A = Split(InPntStr, ",", -1, vbTextCompare)
X = CDbl(A(0))
Y = CDbl(A(1))
Set pPoint = New Point
pPoint.X = X / dX
pPoint.Y = -Y / dY
ptincoll.AddPoint pPoint
Set pPoint = Nothing
End If
Loop
anTabFile.Close
Set pPoint = Nothing
Set fs = Nothing
Set anTabFile = Nothing
Set A = Nothing
TabRead = True
End Function
