[原创]vb + engine 用raster生成等值线源码

<P>最近再弄等值线问题，有点眉目了，我是用点shp文件生成IDW（范围比实际大），然后用边界shp文件来裁剪raster，最后用raster生成等值线，保存为shp，同时也在图层里显示，下面把源码显上来，大家一起学习进步！</P>
<P>Public Function CreateRasterFromPoint(pMap As IMap, sName As String, sFieldName As String, dCellSize As Double, strOutName As String)<BR>  <BR>  <BR>    CheckSpatialAnalystLicense<BR>    <BR>    Dim pFilt As IQueryFilter<BR>    Set pFilt = New QueryFilter<BR>    <BR>    Dim i As Integer<BR>    Dim nLayerIndex As Integer<BR>    <BR>    nLayerIndex = -1<BR>    <BR>    For i = 0 To pMap.LayerCount() - 1<BR>    <BR>      If pMap.Layer(i).Name = sName Then<BR>            nLayerIndex = i<BR>            Exit For<BR>       End If<BR>       <BR>    Next i<BR>    <BR>    If nLayerIndex = -1 Then<BR>     MsgBox "生成等值线的原始数据不存在！"<BR>     Exit Function<BR>    End If<BR>    <BR>    Dim pFeatureLayer As IFeatureLayer<BR>    Set pFeatureLayer = pMap.Layer(nLayerIndex)<BR>    <BR>    Dim pFClass As IFeatureClass<BR>    Set pFClass = pFeatureLayer.FeatureClass<BR>    </P>
<P>     ' Create FeatureClassDescriptor using a value field<BR>     Dim pFDescr As IFeatureClassDescriptor<BR>    Set pFDescr = New FeatureClassDescriptor<BR>    <BR>    <BR>    If Len(m_sWhereClause) > 0 Then<BR>       pFilt.whereClause = m_sWhereClause<BR>       pFDescr.Create pFClass, pFilt, sFieldName<BR>    Else<BR>       pFDescr.Create pFClass, Nothing, sFieldName<BR>    End If<BR>    <BR>    <BR>    <BR>     ' Create RasterInterpolationOp object<BR>     Dim pIntOp As IInterpolationOp<BR>     Set pIntOp = New RasterInterpolationOp</P>
<P>     ' Set cell size for output raster. The extent of the output raster is<BR>    ' defualted to as same as input. The output working directory uses default<BR>    <BR>    Dim pExtent As IEnvelope<BR>    Set pExtent = New Envelope<BR>    <BR>    Dim xmin As Double<BR>    Dim xmax As Double<BR>    Dim ymin As Double<BR>    Dim ymax As Double</P>
<P>    xmin = 20360000<BR>    xmax = 20550000<BR>    ymin = 4340000<BR>    ymax = 4557000<BR>    <BR>    pExtent.PutCoords xmin, ymin, xmax, ymax<BR>    <BR>      <BR>    Dim penv As IRasterAnalysisEnvironment<BR>    Set penv = pIntOp<BR>    penv.SetCellSize esriRasterEnvValue, dCellSize<BR>    penv.SetExtent esriRasterEnvValue, pExtent<BR>      <BR>     ' Create raster radius using variable distance<BR>     Dim pRadius As IRasterRadius<BR>    Set pRadius = New RasterRadius<BR>    pRadius.SetVariable 12</P>
<P>     ' Using FeatureClassDescriptor as an input to the IInterpolationOp and<BR>    ' Perform the interpolation<BR>     Dim pInRaster As IRaster<BR>    Set pInRaster = pIntOp.IDW(pFDescr, 2, pRadius)<BR>    <BR>       <BR>    Dim pRasterProp As IRasterProps<BR>    Set pRasterProp = pInRaster<BR>    <BR>    RULX = pRasterProp.Extent.xmin<BR>    RULY = pRasterProp.Extent.ymax<BR>    RLRX = pRasterProp.Extent.xmax<BR>    RLRY = pRasterProp.Extent.ymin<BR>    </P>
<P>    '判断strOutName是否存在，如果存在，删除先<BR>    Call DeleteIfExists(strOutName)</P>
<P>    Dim pGeo As IGeometry<BR>    Set pGeo = GetPolygon<BR>    </P>
<P>    '用边界裁剪raster<BR>    RasterExtraction pGeo, pInRaster<BR>    <BR>    Dim pOutDataset  As IDataset<BR>    Set pOutDataset = pOutBands.SaveAs(strOutName, Nothing, "GRID")<BR>   <BR>      <BR>    Set pFilt = Nothing<BR>    Set pFDescr = Nothing<BR>    Set pIntOp = Nothing<BR>    Set pExtent = Nothing<BR>    Set pFeatureLayer = Nothing<BR>    Set pFClass = Nothing<BR>    </P>
<P>    <BR>End Function<BR></P>

<P>我也做过类似的功能，做此类功能需要注意的是及时释放com对象，防止不必要的错误产生。</P>

请问UsingRasterClassifyColorRampRenderer子程序是根据颜色渲染，怎样根据值进行分类渲染？谢谢！

<P>太好了,我也要<STRONG>用engine 生成等值线</STRONG></P>

<P>退出时要set pObj=nothing,不然要占用内在</P>
<P>你的代码不错,有机会探讨一下,我的QQ:230998,</P>

创建了对象,在退出时就要set pObj=nothing,wq r

<P>对阿，最后生成的就是等值线，保存为shapfile，等值面是Raster，文件</P>

<P>很好！！</P>

<P>LZ，用的就是插值分析吧？</P>
<P>请问最后生成的是线状数据吗？</P><img src="images/post/smile/dvbbs/em06.gif" />

请问用engine能实现arcmap中的空间分析功能吗？

<P>请问你说的边界时什么意思，我原来生成的raster是矩形的，是被一个边界shapefile给裁成这样的</P>