Bild Katalog

Benutze dieses „Image Catalog Creator“ Programm für meine Bildkataloge,
habe es auf der http://arcscripts.esri.com/details.asp?dbid=13292 gefunden.
Hier mit werden aus allen Rasterdaten die sich in dem Ordner befinden ein Bildkatalog erstellt,
was ich möchte ist das ich die Rasterdaten aus dem Ordner selbst auswählen möchte,
und nur aus den Ausgewählten Daten ein Bildkatalog erstellt wird.
Bitte schaut euch das Programm mal an, hätte gerne Screenshot erstellt, leider weis ich nicht
wie man Bilder hier angezeigt bekommt.
In diesem Programm gibt es ein Form in dem ein FileListBox erstellt ist, müsste eine
Möglichkeit geben die Rasterdaten von dort aus zu markieren.

hier ein Auszug aus dem VB Code:

Private Sub DirListBox1_Change()
DirListBox1.Path = drvLetter
fileDirList.Path = DirListBox1.Path
End Sub

Private Sub fileDirList_Click()
End Sub

Private Sub cmdGo_Click()

Dim strName As String
Dim strLength As Integer
Dim featType As esriGeometryType
Dim pFeatureLayer As IFeatureLayer
Dim pMxDoc As IMxDocument
Dim pMap As IMap
Dim orglength As Integer
Dim curpos As Integer
Dim newlength As Integer
Dim pRasterCatalogtable As IRasterCatalogTable
Dim pRasterCatalogLayer As IRasterCatalogLayer
Dim vStrings
Dim i As Integer
Dim pRasterProps As IRasterProps
Dim pRasterSR As ISpatialReference

Set pMxDoc = g_pApp.Document
Set pMap = pMxDoc.FocusMap

If fileDirList.ListCount = 0 Then
MsgBox "No raster data in the file!", vbInformation, "Ok not acceptable"
Exit Sub
End If

vStrings = Split(txtCatalogPath.Text, "\")
strName = vStrings(UBound(vStrings))

'Create the dbf file to store values
Set Catalog_Table = createDBF(strName, PathName)

'dbase table
Get_Raster_Datasets (DirListBox1.Path)

Set pRasterCatalogtable = New RasterCatalogTable
Set pRasterCatalogtable.Table = Catalog_Table
pRasterCatalogtable.Update
Set pRasterCatalogLayer = New RasterCatalogLayer

pRasterCatalogLayer.Create pRasterCatalogtable
pMap.AddLayer pRasterCatalogLayer

pMxDoc.UpdateContents

Me.Visible = False

Set Catalog_Table = Nothing

pMxDoc.UpdateContents
pMxDoc.ActiveView.Refresh
Exit Sub


Public Sub Get_Raster_Datasets(sDir As String)

'get all the rasters from a directory
Dim pWsFact As IWorkspaceFactory
Dim pWs As IWorkspace
Dim pEnumDs As IEnumDataset
Dim sName As String
Dim vStrings

On Error GoTo error_h

'Get input workspace
Set pWsFact = New RasterWorkspaceFactory
Set pWs = pWsFact.OpenFromFile(sDir, 0)

'Get all the raster datasets of the input workspace
Set pEnumDs = pWs.Datasets(esriDTRasterDataset)

'Extract directory basename
vStrings = Split(sDir, "\")
sName = vStrings(UBound(vStrings))

Call Put_In_Values(pEnumDs)

frmBildkatalog.MousePointer = vbDefault

GoTo cleanup

error_h:
MsgBox Err.Description
cleanup:
Set pWsFact = Nothing
Set pWs = Nothing
Set pEnumDs = Nothing

End Sub


Jetzt schon mal Dank für eure Hilfe

gruß Susan