1 / 11

Using VB Active-X components to customize a new tool on ArcMap

Using VB Active-X components to customize a new tool on ArcMap. 26. 24. 27. 23. 25. 29. 28. extent. 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).

alaroche
Download Presentation

Using VB Active-X components to customize a new tool on ArcMap

An Image/Link below is provided (as is) to download presentation Download Policy: Content on the Website is provided to you AS IS for your information and personal use and may not be sold / licensed / shared on other websites without getting consent from its author. Content is provided to you AS IS for your information and personal use only. Download presentation by click this link. While downloading, if for some reason you are not able to download a presentation, the publisher may have deleted the file from their server. During download, if you can't get a presentation, the file might be deleted by the publisher.

E N D

Presentation Transcript

  1. Using VB Active-X components to customize a new tool on ArcMap

  2. 26 24 27 23 25 29 28 extent 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). 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 > pfExtent.XMax Then pfExtent.XMax = .XMax    If .XMin < pfExtent.XMin Then pfExtent.XMin = .XMin    If .YMax > pfExtent.YMax Then pfExtent.YMax = .YMax    If .YMin < pfExtent.YMin Then pfExtent.YMin = .YMin    End With    objID(NumObj) = pFeatpol.OID    NumObj = NumObj + 1 'number of selected objects    Set pFeatpol = pEnumFeat.NextWend

  3. 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(pSize)Set pBlock = pRasterNew.CreatePixelBlock(pSize)Dim pRawPixel As IRawPixelsSet pRawPixel = pBandpRawPixel.Read pTopLeftCrn, pBlock'pRasterNew.Read pTopLeftCrn, pBlockDim pOrigSafeArray As VariantpOrigSafeArray = pBlock.SafeArray(0)

  4. 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(pTempDS, "IMAGINE Image", pWS, "Tempcov.img") Dim pNewRaster As IRaster,pNewRasProps As IRasterPropsSet pNewRaster = polRDS.CreateDefaultRasterSet pNewRasProps = pNewRaster' Get RasterBand from the rasterDim pNewBand As IRasterBand, pNewBands As IRasterBandCollectionSet 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.CreatePixelBlock(pNewSize)pRawPixel2.Read pOrigin, pBlock2Dim pNewArray As VariantpNewArray = pBlock2.SafeArray(0)

  5. 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)

  6. 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.SpatialReferencepNewRasProps.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.CreateDefaultRasterDim 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)

  7. Dim pOutSafeArray As VariantpOutSafeArray = pOutBlock.SafeArray(0)'Setting the nodata value to some odd value  for display reasonspOutRasProps.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.NoDataValue) sss: Next jPB.Value = 90 + 9 * ii / (pNewSize.X - 1)Next ii 'pOutBlock.SafeArray(0) = pOutSafeArraypOrigin.SetCoords 0, 0pOutRawPixel.Write pOrigin, pOutBlockDim pRasPyramid As IRasterPyramidSet pRasPyramid = OutPutRDS' Create the pyramidIf Not pRasPyramid.Present ThenpRasPyramid.CreateEnd If'Recompute statistics and histogram in the band for display reasons too pOutBand.ComputeStatsAndHistpOutBand.Statistics.Recalculate'Add the raster layerDim pOutputRasLy As IRasterLayerSet pOutputRasLy = New RasterLayerpOutputRasLy.CreateFromDataset OutPutRDS'pOutputRasLy.Name = "Clip"pMap.ClearSelectionpMap.AddLayer pOutputRasLypMxDoc.ActiveView.Refresh

  8. 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

  9. To download the DLL file, go to http://ceefs.cee.usu.edu/yasir/termproject/ClipRasterPol.dll To see an example of how the tool works…Check 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!

More Related