Using VB ActiveX components to customize a new tool on ArcMap

1
Using VB Active-X components to customize a new
tool on ArcMap
2
(No Transcript)
3
Define the extent of the selected features which
will be the extent of the output layer and saving
the object IDs of the selected features in an
array (which will be used later).
extent

• Set pEnumFeat pMap.FeatureSelectionSet
  pFeatpol pEnumFeat.NextIf pFeatpol Is Nothing
  Then 'If there is no selected featuresMsgBox
  ("Please select at least one poygon
  feature")GoTo RlsMmExit FunctionEnd IfSet
  pfExtent pFeatpol.ExtentDim NumObj As
  IntegerNumObj 0'loop thru selected features
  and redefine the extent accordinglyWhile Not
  pFeatpol Is Nothing    With pFeatpol.Extent   
  If .XMax gt pfExtent.XMax Then pfExtent.XMax
  .XMax    If .XMin lt pfExtent.XMin Then
  pfExtent.XMin .XMin    If .YMax gt
  pfExtent.YMax Then pfExtent.YMax .YMax    If
  .YMin lt pfExtent.YMin Then pfExtent.YMin
  .YMin    End With    objID(NumObj)
  pFeatpol.OID    NumObj NumObj 1 'number of
  selected objects    Set pFeatpol
  pEnumFeat.NextWend

4
Reading the safe array of the original raster
layer on the final extent (with an option of
saving this block of the safe array.)

• 'Create a DblPnt to hold the PixelBlock sizeDim
  pSize As IPntSet pSize New DblPntDim
  CellSizeX, CellSizeY As DoubleCellSizeX
  pRasterProp.MeanCellSize.XCellSizeY
  pRasterProp.MeanCellSize.YDim m, n As Longm
  CLng((pfExtent.XMax - pfExtent.XMin 1) /
  CellSizeX)n CLng((pfExtent.YMax -
  pfExtent.YMin 1) / CellSizeY)pSize.SetCoords
  m, nDim pTopLeftCrn As IPntSet pTopLeftCrn
  New DblPntDim g, f As Longg (pfExtent.XMin -
  pRasterProp.Extent.XMin) / CellSizeXg
  Abs(CLng(g))f (pfExtent.YMax -
  pRasterProp.Extent.YMax) / CellSizeYf
  Abs(CLng(f))'Redefine the Extent to gurantee
  exact allignment with the original
  layerpfExtent.XMax CDbl(pRasterProp.Extent.XMin
  ) CDbl(g m) CellSizeXpfExtent.YMin
  CDbl(pRasterProp.Extent.YMax) - CDbl(f n)
  CellSizeYpfExtent.XMin CDbl(pRasterProp.Extent.
  XMin) CDbl(g) CellSizeXpfExtent.YMax
  CDbl(pRasterProp.Extent.YMax) - CDbl(f)
  CellSizeYpTopLeftCrn.SetCoords g, fDim pBlock
  As IPixelBlock'pRawPixel.Read pTopLeftCrn,
  pBlock'Set pBlock pRawPixel.CreatePixelBlock(pS
  ize)Set pBlock pRasterNew.CreatePixelBlock(pSiz
  e)Dim pRawPixel As IRawPixelsSet pRawPixel
  pBandpRawPixel.Read pTopLeftCrn,
  pBlock'pRasterNew.Read pTopLeftCrn, pBlockDim
  pOrigSafeArray As VariantpOrigSafeArray
  pBlock.SafeArray(0)

5
Transform the polygon feature layer into a raster
layer. pixel values in this raster layer will be
the same as the containing polygon object IDs

• Dim pEnv As IRasterAnalysisEnvironment, pConv As
  IConversionOpSet pEnv New RasterAnalysisSet
  pConv New RasterConversionOpSet pEnv
  pConvpEnv.SetCellSize esriRasterEnvValue,
  CDbl(pRasterProp.MeanCellSize.X)pEnv.SetExtent
  esriRasterEnvValue, pfExtentDim pTempDS As
  IGeoDataset, polRDS As IRasterDatasetSet pTempDS
  pFeatLyr.FeatureClassDim Set polRDS New
  RasterDatasetSet polRDS pConv.ToRasterDataset(p
  TempDS, "IMAGINE Image", pWS, "Tempcov.img")
• Dim pNewRaster As IRaster,pNewRasProps As
  IRasterPropsSet pNewRaster polRDS.CreateDefault
  RasterSet pNewRasProps pNewRaster' Get
  RasterBand from the rasterDim pNewBand As
  IRasterBand, pNewBands As IRasterBandCollectionSe
  t pNewBands pNewRasterSet pNewBand
  pNewBands.Item(0)' Create a DblPnt to hold the
  PixelBlock sizeDim pNewSize As IPntSet pNewSize
  New DblPntDim pOrigin As IPntSet pOrigin
  New DblPntpNewSize.SetCoords pNewRasProps.Width,
  pNewRasProps.HeightpOrigin.SetCoords 0, 0'QI
  RawPixel interfaceDim pRawPixel2 As
  IRawPixelsSet pRawPixel2 pNewBandDim pBlock2
  As IPixelBlockSet pBlock2 pNewRaster.CreatePixe
  lBlock(pNewSize)pRawPixel2.Read pOrigin,
  pBlock2Dim pNewArray As VariantpNewArray
  pBlock2.SafeArray(0)

6
Creating a new raster dataset (which will be the
output) with the defined extent. the pixel values
in this raster will be the same as those in the
original raster if the correspondent pixel value
of the transformed layer (step 3) is equal to any
value in the object ID array (step 1) else the
pixel value of the output raster will be NoData
(transparent)
7

• Dim pRWS As IRasterWorkspace2Dim pWSF As
  IWorkspaceFactorySet pWSF New
  RasterWorkspaceFactorySet pRWS
  pWSF.OpenFromFile(sPath, 0)Dim OutPutRDS As
  IRasterDatasetDim ColCount, RCount As
  LongColCount mRCount nDim Spat As
  ISpatialReferenceSet Spat pNewRasProps.SpatialR
  eferencepNewRasProps.Extent pfExtentDim
  pOrigin2 As IPointSet pOrigin2 New
  PointpOrigin2.X pfExtent.XMinpOrigin2.Y
  pfExtent.YMinPB.Value 80Set OutPutRDS
  pRWS.CreateRasterDataset(sFileName3, "GRID",
  pOrigin2, ColCount, RCount, _CellSizeX,
  CellSizeY, 1, PT_LONG, Spat, True)PB.Value
  90' Create a default raster and QI raster
  properties interfaceDim pOutRaster As
  IRasterSet pOutRaster OutPutRDS.CreateDefaultRa
  sterDim pOutBandCol As IRasterBandCollectionSet
  pOutBandCol pOutRasterDim pOutBand As
  IRasterBandSet pOutBand pOutBandCol.Item(0)Dim
  pOutRasProps As IRasterPropsSet pOutRasProps
  pOutBand' QI RawPixel interfaceDim
  pOutRawPixel As IRawPixelsSet pOutRawPixel
  pOutBand' Create a DblPnt to hold the
  PixelBlock sizeDim pOutSize As IPntSet pOutSize
  New DblPntpOutSize.SetCoords
  pOutRasProps.Width, pOutRasProps.Height'pRasProps
  .NoDataValue 0' Create PixelBlock with defined
  sizeDim pOutBlock As IPixelBlockSet pOutBlock
  pOutRawPixel.CreatePixelBlock(pOutSize)

8

• Dim pOutSafeArray As VariantpOutSafeArray
  pOutBlock.SafeArray(0)'Setting the nodata value
  to some odd value  for display reasonspOutRasProp
  s.NoDataValue -9999Dim ii, j, k As LongFor
  ii 0 To pNewSize.X - 1 For j 0 To pNewSize.Y
  - 1 For k 0 To NumObj - 1 If B_(ii, j)
  CLng(objID(k)) Then pOutSafeArray(ii, j)
  CDbl(A_(ii, j)) GoTo sss End If Next
  k pOutSafeArray(ii, j) CDbl(pOutRasProps.NoData
  Value) sss Next jPB.Value 90 9 ii /
  (pNewSize.X - 1)Next ii
• 'pOutBlock.SafeArray(0) pOutSafeArraypOrigin.S
  etCoords 0, 0pOutRawPixel.Write pOrigin,
  pOutBlockDim pRasPyramid As IRasterPyramidSet
  pRasPyramid OutPutRDS' Create the pyramidIf
  Not pRasPyramid.Present ThenpRasPyramid.CreateEn
  d If'Recompute statistics and histogram in the
  band for display reasons too
• pOutBand.ComputeStatsAndHistpOutBand.Statis
  tics.Recalculate'Add the raster layerDim
  pOutputRasLy As IRasterLayerSet pOutputRasLy
  New RasterLayerpOutputRasLy.CreateFromDataset
  OutPutRDS'pOutputRasLy.Name "Clip"pMap.ClearSe
  lectionpMap.AddLayer pOutputRasLypMxDoc.ActiveVi
  ew.Refresh

9
(No Transcript)
10
What else can be done next?

• Code refining
• Better error handling
• trying the program with more variety of grids
  with different sizes and/or pixel-types.
• More careful dealing with data types.
• User-friendlier program with a nicer interface
• More features

11
To download the DLL file, go to http//ceefs.cee.u
su.edu/yasir/termproject/ClipRasterPol.dll

• To see an example of how the tool worksCheck
  this out
• http//ceefs.cee.usu.edu/yasir/gisproject/Example.
  htm
• For those who are interested, The source code
  will be posted on the web
• right after the presentation!

Done!