привязка MapInfo to ArcView

0 голосов
спросил 27 Март, 06 от Гость (210,080 баллов) в категории Программные продукты Esri

Добрый, всем!

Народ а есть ли аналоги скриптов tab2tfw и tfw2tab для 8, 9  версии АркВью?

А то 3 АркВью Ставить нет возможности.

Спасибо

 

2 Ответы

0 голосов
ответил 03 Апр, 06 от Grigoriy (127,020 баллов)

Попробуйте создать вот такой макрос в ArcMap или ArcCatalog - замените входной и выходной каталоги и выполните. Когда-то он у меня работал:

Option Explicit

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
  &nb

0 голосов
ответил 05 Апр, 06 от Jazz (7,650 баллов)
а эти скрипты они арквьюшные? потому что у меня мэпинфовские модули только есть tab2tfw... если да, скиньте ссылку на них коль не жалко...
Добро пожаловать на сайт Вопросов и Ответов, где вы можете задавать вопросы по GIS тематике и получать ответы от других членов сообщества.
...