Jump to content

Add Raster to ArcMap in VBA


Putri Yasmin

Recommended Posts

Dear all,

 

I would like to add raster to ArcMap using the code below :

 

pGxDialog.DoModalOpen ThisDocument.Parent.hWnd, pGxObject
 
  If (pGxObject Is Nothing) Then Exit Sub
  pGxObject.Reset
  
Dim pGxDataset As IGxDataset
 Set pGxDataset = pGxObject.Next
Dim pRLayer As IRasterLayer
 Do Until (pGxDataset Is Nothing)
    Set pRLayer = New RasterLayer
    pRLayer.CreateFromDataset pGxDataset.Dataset
    pLayer.Name = pRLayer.RasterClass.AliasName
    pMxDoc.FocusMap.AddLayer pRLayer
    Set pGxDataset = pGxObject.Next
  Loop
   pMxDoc.ActiveView.PartialRefresh esriViewGeography, Nothing, Nothing
End Sub

 

 

but I got an error on  pLayer.Name = pRLayer.RasterClass.AliasName.
Is there anyone can help me to solve this problem?
 
Best Regard,
Edited by Putri Yasmin
Link to comment
Share on other sites

Thank you Mr. Bdsmolla,
 
 
I succeed add raster to the ArcMap.
Now, I'm confuse again how to record every single raster in the table of content to an aray so that I can call the array and process them.
In the past, I recorded every single feature in table of content used the code below:

Private Sub CommandButton2_Click()
 
 Set fs = CreateObject("Scripting.FileSystemObject")
    Set a = fs.CreateTextFile("\IPAL_BATIK\testfile.txt", True)
    a.WriteLine ("1")
 
 'file declaration for processing
    Dim pMap As IMap
    Dim pFc As IFeatureClass
    Dim pMxDocument As IMxDocument
    Dim pDataset As IDataset
    Dim pWorkspace As IWorkspace
    Dim pFeatureLayer As IFeatureLayer
    Dim pEnumLayer As IEnumLayer
    Dim gp As Object
 
    Dim filename() As String
 
    Dim pLayer As ILayer
    Dim pID As New UID
 
    Dim k As Integer
    Dim i As Integer
        Set gp = CreateObject("esriGeoprocessing.GpDispatch.1")
 
 
  Set pMxDocument = Application.Document
  Set pMap = pMxDocument.FocusMap
  pID = "{E156D7E5-22AF-11D3-9F99-00C04F6BC78E}"
  Set pEnumLayer = pMap.Layers(pID, True)
  pEnumLayer.Reset
  Set pLayer = pEnumLayer.Next
  i = 0
  k = 0
 
  ReDim filename(0 To pMap.LayerCount - 1)
  Do While Not pLayer Is Nothing
    If i = 17 Then
        Exit Do
    End If
 
    If TypeOf pMap.Layer(k) Is IGroupLayer Then
                    Set pGroupLayer = pMap.Layer(k)
                    pGroupLayer.Visible = False
    ElseIf TypeOf pMap.Layer(k) Is IFeatureLayer Then
                    Set pFeatureLayer = pMap.Layer(k)
                    Set pFc = pFeatureLayer.FeatureClass
                    Set pDataset = pFc
                    Set pWorkspace = pDataset.Workspace
                    filename(i) = pWorkspace.PathName + "\" + pFeatureLayer.Name + ".shp"
 
    End If
 
                     Select Case i
                     Case 0
                     gp.CopyFeatures_management filename(0), "\IPAL_BATIK\\PETA_DASAR.shp"
                     Case 1
                     gp.MultipartToSinglepart_management filename(1), "\IPAL_BATIK\DESA.shp"
                     Case 2
                     gp.CopyFeatures_management filename(2), "\IPAL_BATIK\JALAN.shp"
                     Case 3
                     gp.CopyFeatures_management filename(3), "\IPAL_BATIK\SUNGAI.shp"
                     Case 4
                     gp.CopyFeatures_management filename(4), "\IPAL_BATIK\DRAINASE.shp"
                     Case 5
                     gp.CopyFeatures_management filename(5), "\IPAL_BATIK\ELEVASI.shp"
                     Case 6
                     gp.CopyFeatures_management filename(6), "\IPAL_BATIK\BANJIR.shp"
                     Case 7
                     gp.CopyFeatures_management filename(7), "\IPAL_BATIK\LAHAN_TERBANGUN.shp"
                     Case 8
                     gp.CopyFeatures_management filename(8), "\IPAL_BATIK\KEMIRINGAN.shp"
                     Case 9
                     gp.MultipartToSinglepart_management filename(9), "\IPAL_BATIK\PERDAGANGAN.shp"
                     Case 10
                     gp.MultipartToSinglepart_management filename(10), "\IPAL_BATIK\KESEHATAN.shp"
                     Case 11
                     gp.MultipartToSinglepart_management filename(11), "\IPAL_BATIK\BEBAN_LINGKUNGAN.shp"
                     Case 12
                     gp.MultipartToSinglepart_management filename(12), "\IPAL_BATIK\PERIBADATAN.shp"
                     Case 13
                     gp.MultipartToSinglepart_management filename(13), "\IPAL_BATIK\pendidikan.shp"
                     Case 14
                     gp.MultipartToSinglepart_management filename(14), "\IPAL_BATIK\EKONOMI.shp"
                     Case 15
                     gp.MultipartToSinglepart_management filename(15), "\IPAL_BATIK\debit batik.shp"
                     Case 16
                     gp.MultipartToSinglepart_management filename(16), "\IPAL_BATIK\JUMLAH_PENDUDUK.shp"
 
 
                    End Select
    Set pLayer = pEnumLayer.Next
    k = k + 2
    i = i + 1
 
  Loop
 
End Sub

 

 

 
But, when I want to use the similar code analogy for raster data such the code below,
 
Private Sub Copy_Click()
 
 Set fs = CreateObject("Scripting.FileSystemObject")
    Set a = fs.CreateTextFile("\Sediment Trap\testfile.txt", True)
    a.WriteLine ("1")
 
 Dim pMap As IMap
    Dim pFc As IRasterClass
    Dim pMxDocument As IMxDocument
    Dim pDataset As IDataset
    Dim pWorkspace As IWorkspace
    Dim pRasterLayer As IRasterLayer
    Dim pEnumLayer As IEnumLayer
    Dim gp As Object
 
    Dim filename() As String
 
    Dim pLayer As ILayer
    Dim pId As New UID
 
    Dim k As Integer
    Dim i As Integer
        Set gp = CreateObject("esriGeoprocessing.GpDispatch.1")
 
 
  Set pMxDocument = Application.Document
  Set pMap = pMxDocument.FocusMap
  pId = "{D02371C7-35F7-11D2-B1F2-00C04F8EDEFF}"
  Set pEnumLayer = pMap.Layers(pId, True)
  pEnumLayer.Reset
  Set pLayer = pEnumLayer.Next
  i = 0
  k = 0
 
  ReDim filename(0 To pMap.LayerCount - 1)
  Do While Not pLayer Is Nothing
    If i = 10 Then
        Exit Do
    End If
 
    If TypeOf pMap.Layer(k) Is IGroupLayer Then
                    Set pGroupLayer = pMap.Layer(k)
                    pGroupLayer.Visible = False
    ElseIf TypeOf pMap.Layer(k) Is IRasterLayer Then
                    Set pRasterLayer = pMap.Layer(k)
                    Set pFc = pRasterLayer.RasterClass
                    Set pDataset = pFc
                    Set pWorkspace = pDataset.Workspace
                    filename(i) = pWorkspace.PathName + "\" + pRasterLayer.Name + ".img"
 
    End If
  
 
                     Select Case i
                     Case 0
                     gp.CopyRaster_management filename(0), "\Sediment Trap\SourceDEM.img", "", "", "", "OneBitTo8Bit", "NONE", "64_BIT"
                     Case 1
                     gp.CopyRaster_management filename(0), "\Sediment Trap\Mask.img", "", "", "", "OneBitTo8Bit", "NONE", "64_BIT"
                     Case 2
                     gp.CopyRaster_management filename(0), "\Sediment Trap\Watershed.img", "", "", "", "OneBitTo8Bit", "NONE", "64_BIT"
 
                    End Select
    Set pLayer = pEnumLayer.Next
    k = k + 2
    i = i + 1
 
  Loop

End Sub

 

 

The code get error in :

 

Dim pFc As IRasterClass
Set pFc = pRasterLayer.RasterClass
 
Could you help me, Please?
 
Best Regards,
Yasmin
  • Like 1
Link to comment
Share on other sites

Hi Yasmin

Frankly I do not want to practice VBA on top of ArcMap again. In case of doing the same thing in python (ArcPy) may be can give good advise.

However, in your code, i think you defined workspace (which is default for vector data) for raster you need to use RasterWorkspaceFactory/NewRasterWorkspace etc. 

  • Like 2
Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...

Important Information

By using this site, you agree to our Terms of Use.

Disable-Adblock.png

 

If you enjoy our contents, support us by Disable ads Blocker or add GIS-area to your ads blocker whitelist