zoukankan      html  css  js  c++  java
  • arcmap vba 生成3维侧棱 以及 createfeature与createfeaturebuffer的区别

    Sub huaxian()
    Dim pMxDoc As IMxDocument
    Set pMxDoc = Application.Document

    Dim pMap As IMap
    Set pMap = pMxDoc.FocusMap

    Dim pActiveView As IActiveView
    Set pActiveView = pMxDoc.FocusMap

    Dim pFeatureClassOne As IFeatureClass
    Dim pFLayerOne As IFeatureLayer

    Dim pFeatureClassTwo As IFeatureClass
    Dim pFLayerTwo As IFeatureLayer

    Dim pFeatureClassNew As IFeatureClass
    Dim pFLayerNew As IFeatureLayer

    Set pFLayerOne = pMap.Layer(0)
    Set pFLayerTwo = pMap.Layer(1)
    Set pFLayerNew = pMap.Layer(2)

    Set pFeatureClassOne = pFLayerOne.FeatureClass
    Set pFeatureClassTwo = pFLayerTwo.FeatureClass
    Set pFeatureClassNew = pFLayerNew.FeatureClass

    Dim pFeatureCursorOne As IFeatureCursor
    Dim pFeatureCursorTwo As IFeatureCursor

    Set pFeatureCursorOne = pFeatureClassOne.Search(Nothing, True)
    Set pFeatureCursorTwo = pFeatureClassTwo.Search(Nothing, True)

    Dim pFeatureOne As IFeature
    Dim pFeatureTwo As IFeature

    Set pFeatureOne = pFeatureCursorOne.NextFeature
    Set pFeatureTwo = pFeatureCursorTwo.NextFeature


    Dim pPolygonOne As IPolygon
    Dim pPolygonTwo As IPolygon
    Dim pOnePoints As IPointCollection
    Dim pTwoPoints As IPointCollection
    Dim i As Integer

    Dim pFromPoint As IPoint
    Dim pToPoint As IPoint
    Dim pPolyline As IPolyline
    Dim polylinePoints As IPointCollection
    Dim pFeatureNew As IFeature

     'create a feature cursor and feature buffer interface
     Dim pFeatCur As IFeatureCursor
     Dim pFeatBuf As IFeatureBuffer
     
     'open the feature cursor and feature buffer
     Set pFeatCur = pFeatureClassNew.Insert(True)
     Set pFeatBuf = pFeatureClassNew.CreateFeatureBuffer

     Dim q As Long

     
    While Not pFeatureOne Is Nothing And Not pFeatureTwo Is Nothing
       Set pPolygonOne = pFeatureOne.Shape
       Set pPolygonTwo = pFeatureTwo.Shape
       Set pOnePoints = pPolygonOne
       Set pTwoPoints = pPolygonTwo
     
     For i = 0 To pOnePoints.PointCount - 1
      
       Set pFromPoint = pOnePoints.Point(i)
       Set pToPoint = pTwoPoints.Point(i)
       Set pPolyline = New Polyline
       Set polylinePoints = pPolyline
      
       polylinePoints.AddPoint pFromPoint
       polylinePoints.AddPoint pToPoint
      
       Set pFeatureNew = pFeatBuf
       Set pFeatureNew.Shape = pPolyline
     


       q = pFeatCur.InsertFeature(pFeatBuf)
      
       Next i
      
       Set pFeatureOne = pFeatureCursorOne.NextFeature
       Set pFeatureTwo = pFeatureCursorTwo.NextFeature
    Wend

    MsgBox "done!"
    End Sub

    ——————————————————————————————————————————————————————————————————————

    Sub huaxian()

    Dim pMxDoc As IMxDocument
    Set pMxDoc = Application.Document

    Dim pMap As IMap
    Set pMap = pMxDoc.FocusMap

    Dim pActiveView As IActiveView
    Set pActiveView = pMxDoc.FocusMap

    Dim pFeatureClassOne As IFeatureClass
    Dim pFLayerOne As IFeatureLayer

    Dim pFeatureClassTwo As IFeatureClass
    Dim pFLayerTwo As IFeatureLayer

    Dim pFeatureClassNew As IFeatureClass
    Dim pFLayerNew As IFeatureLayer

    Set pFLayerOne = pMap.Layer(0)
    Set pFLayerTwo = pMap.Layer(1)
    Set pFLayerNew = pMap.Layer(2)

    Set pFeatureClassOne = pFLayerOne.FeatureClass
    Set pFeatureClassTwo = pFLayerTwo.FeatureClass
    Set pFeatureClassNew = pFLayerNew.FeatureClass

    Dim pFeatureCursorOne As IFeatureCursor
    Dim pFeatureCursorTwo As IFeatureCursor

    Set pFeatureCursorOne = pFeatureClassOne.Search(Nothing, True)
    Set pFeatureCursorTwo = pFeatureClassTwo.Search(Nothing, True)

    Dim pFeatureOne As IFeature
    Dim pFeatureTwo As IFeature

    Set pFeatureOne = pFeatureCursorOne.NextFeature
    Set pFeatureTwo = pFeatureCursorTwo.NextFeature


    Dim pPolygonOne As IPolygon
    Dim pPolygonTwo As IPolygon
    Dim pOnePoints As IPointCollection
    Dim pTwoPoints As IPointCollection
    Dim i As Integer

    Dim pFromPoint As IPoint
    Dim pToPoint As IPoint
    Dim pPolyline As IPolyline
    Dim polylinePoints As IPointCollection
    Dim pFeatureNew As IFeature


     
    While Not pFeatureOne Is Nothing and Not pFeatureTwo Is Nothing
       Set pPolygonOne = pFeatureOne.Shape
       Set pPolygonTwo = pFeatureTwo.Shape
       Set pOnePoints = pPolygonOne
       Set pTwoPoints = pPolygonTwo
     
     For i = 0 To pOnePoints.PointCount - 1
      
       Set pFromPoint = pOnePoints.Point(i)
       Set pToPoint = pTwoPoints.Point(i)
       Set pPolyline = New Polyline
       Set polylinePoints = pPolyline
      
       polylinePoints.AddPoint pFromPoint
       polylinePoints.AddPoint pToPoint
      
       Set pFeatureNew = pFeatureClassNew.CreateFeature
       Set pFeatureNew.Shape = pPolyline
       pFeatureNew.Store
      
      
      
      
       Next i
      
       Set pFeatureOne = pFeatureCursorOne.NextFeature
       Set pFeatureTwo = pFeatureCursorTwo.NextFeature
    Wend

    MsgBox "done!"


    End Sub


     

  • 相关阅读:
    Java中JNI的使用详解第四篇:C/C++中创建Java对象和String字符串对象及对字符串的操作方法 分类: Java 2013-12-27 12:39 2024人阅读 评论(0) 收藏
    Android中运行的错误:java.lang.UnsatisfiedLinkError: Couldn't load locSDK3: findLibrary returned null. 分类: Android 2013-12-26 15:29 21858人阅读 评论(10) 收藏
    使用VC6.0编译C++代码的时候报错:fatal error C1071: unexpected end of file found in comment(Mark ZZ) 2013-12-24 13:12 737人阅读 评论(0) 收藏
    Android中onTouch方法的执行过程以及和onClick执行发生冲突的解决办法 2013-12-23 16:35 14333人阅读 评论(6) 收藏
    Java中JNI的使用详解第三篇:JNIEnv类型中方法的使用 2013-12-21 15:40 2565人阅读 评论(0) 收藏
    UIView常用的一些方法小记之setNeedsDisplay和setNeedsLayout
    IOS UIImage类方法总结
    iOS 如何选择delegate、notification、KVO
    ios 中 KVO
    IOS 设置Launch image停留时间
  • 原文地址:https://www.cnblogs.com/zhangjun1130/p/1771510.html
Copyright © 2011-2022 走看看