AO相关代码---不错,以前就看到过

来源:互联网 发布:生肖 不合 知乎 编辑:程序博客网 时间:2024/04/29 23:29
向SHP文件插入一条记录'产生一个点对象
Dim pPoint As IPoint
pPoint = New Point
pPoint.PutCoords(100, 2)

'打开工作空间
Dim pWorkspaceFactory As IWorkspaceFactory
pWorkspaceFactory = New ShapefileWorkspaceFactory
Dim pFeatWorkspace As IFeatureWorkspace
pFeatWorkspace = pWorkspaceFactory.OpenFromFile("e:/us", 0)

Dim pWorkspaceEdit As IWorkspaceEdit
pWorkspaceEdit = pFeatWorkspace

'获取一个要素类
Dim pFeatureClass As IFeatureClass
pFeatureClass = pFeatWorkspace.OpenFeatureClass("points")

'得到要素类的字段结构
Dim pFields As IFields
pFields = pFeatureClass.Fields

'开始编辑过程
pWorkspaceEdit.StartEditing(True)
pWorkspaceEdit.StartEditOperation()

Dim pFeatCursor As IFeatureCursor
pFeatCursor = pFeatureClass.Insert(True)

Dim pFeatBuffer As IFeatureBuffer
pFeatBuffer = pFeatureClass.CreateFeatureBuffer
pFeatBuffer.Value(pFields.FindField("name")) = "point1"
pFeatBuffer.Value(pFields.FindField("shape")) = pPoint

'插入记录
pFeatCursor.InsertFeature(pFeatBuffer)
pFeatCursor.Flush()

pWorkspaceEdit.StartEditOperation()
pWorkspaceEdit.StopEditing(True)
-----------------------
代码经过实际测试,没有任何问题!

自己做要素的闪烁下面的方法需要传入四个参数,第一个是MapControl空间的ScreenDisplay对象,pGeometry是要被闪烁的要素图形,nTimer是闪烁的次数,而time是闪烁的时间。
这个方法只能用于闪烁Polygon类型要素。
Private Sub FlashPolygon(ByVal pDisplay As IScreenDisplay, ByVal pGeometry As IGeometry, ByVal nTimer As Integer, ByVal time As Integer)
Dim pFillSymbol As ISimpleFillSymbol
Dim pSymbol As ISymbol
Dim pRGBColor As IRgbColor

pRGBColor = New RgbColor
pRGBColor.Green = 128

pFillSymbol = New SimpleFillSymbol
pFillSymbol.Outline = Nothing
pFillSymbol.Color = pRGBColor
pSymbol = pFillSymbol
pSymbol.ROP2 = esriRasterOpCode.esriROPNotXOrPen

Dim i As Integer

pDisplay.StartDrawing(0, esriScreenCache.esriNoScreenCache)
pDisplay.SetSymbol(pFillSymbol)
For i = 0 To nTimer
pDisplay.DrawPolygon(pGeometry)
System.Threading.Thread.Sleep(time)
Next
End Sub
-------------------------------
这个方法需要对ScreenDisplay对象有深入的了解,不过并不复杂,在我的书稿中对这个对象有详细的介绍。
代码经过测试,可以完美使用。

 

要素动态跟踪的算法这个算法其实很简单,核心原理是在一个timer_tick事件中不断改变一个markerElement的geometry。而我们关注的目标也是这些符合条件的geometry如何得到。

1.polyline上的节点
我们我们要取一条polyline上的节点,这个方法是非常简单的,使用ipointcollection接口对象ppts,我们通过QI一条polyline,可以获取这些点集合。
dim ppts as ipointcollection
ppts=ppolyline
其中的点从ppts.point(i)中取得

2.获取均匀点
如果一条线很长,但是只有一个segment,那么点将很快移动完毕,这样肯定我们也不满意,我们希望能够不管线的长度是多少,一定要让点移动10次,我们就必须找出一条线上等距离的11个点的位置出来,算法如下:

Function MakeMultiPoint(ByVal pGeometry As IGeometry, ByVal nPoints As Integer) As IGeometryCollection
         Dim pGeometryCollection As IGeometryCollection
         If TypeOf pGeometry Is IPolyline Then
             ' return a multipoint containing nPoints equally
             ' distributed on the Polyline
             Dim pConstructGeometryCollection As IConstructGeometryCollection
             pConstructGeometryCollection = New GeometryBag
             pConstructGeometryCollection.ConstructDivideEqual(pGeometry, nPoints - 1, esriConstructDivideEnum.esriDivideIntoPolylines)
             Dim pEnumGeometry As IEnumGeometry
             pEnumGeometry = pConstructGeometryCollection
             pGeometryCollection = New Multipoint
             Dim pPolyline As IPolyline
             pPolyline = pEnumGeometry.Next
             pGeometryCollection.AddGeometry(pPolyline.FromPoint)
             Do While Not pPolyline Is Nothing
                 pGeometryCollection.AddGeometry(pPolyline.ToPoint)
                 pPolyline = pEnumGeometry.Next
             Loop
         End If
         MakeMultiPoint = pGeometryCollection
         pGeometryCollection = Nothing
     End Function
这个函数可取出符合要求的点集出来。

 


向要素类中插入一条要素的方法本例使用ifeatureclass::insertFeature和featurebuffer等命令构成。
Option Explicit

Dim pFeatClass As IFeatureClass
'-----看看没有绘制前要素类里面的要素数目
Private Sub Command1_Click()
Dim pLayer As IFeatureLayer
Set pLayer = MapControl1.Map.Layer(0)
Set pFeatClass = pLayer.FeatureClass
Label1.Caption = pFeatClass.FeatureCount(Nothing)
End Sub
'----插入要素的方法
Public Sub insertFeat(ByVal pGeo As IGeometry, ByVal pFeatClass As IFeatureClass)
Dim pFeatCursor As IFeatureCursor
Dim pFeatBuffer As IFeatureBuffer
Set pFeatCursor = pFeatClass.Insert(True)
Set pFeatBuffer = pFeatClass.CreateFeatureBuffer()

Dim pFlds As IFields
Dim pFld As IField
Dim i As Long
Dim pPolygon As IPolygon

Set pPolygon = pGeo

Set pFlds = pFeatClass.Fields
For i = 1 To pFlds.FieldCount - 1
Set pFld = pFlds.Field(i)

If (pFld.Type = esriFieldTypeGeometry) Then
Dim pGeom As IGeometry
Set pGeom = pPolygon
pFeatBuffer.Value(i) = pGeom

Else
If pFld.Type = esriFieldTypeInteger Then
pFeatBuffer.Value(i) = CLng(0)
ElseIf pFld.Type = esriFieldTypeDouble Then
pFeatBuffer.Value(i) = CDbl(0)
ElseIf pFld.Type = esriFieldTypeSmallInteger Then
pFeatBuffer.Value(i) = CInt(0)
ElseIf pFld.Type = esriFieldTypeString Then
pFeatBuffer.Value(i) = ""
Else
MsgBox "Need to handle this field type"
End If
End If
Next i

pFeatCursor.InsertFeature pFeatBuffer
End Sub
'------map控件上拖曳绘制
Private Sub MapControl1_OnMouseDown(ByVal button As Long, ByVal shift As Long, ByVal x As Long, ByVal y As Long, ByVal mapX As Double, ByVal mapY As Double)
Dim pGeo As IGeometry
Set pGeo = MapControl1.TrackPolygon
'----使用方法
insertFeat pGeo, pFeatClass
Label1.Caption = pFeatClass.FeatureCount(Nothing)
End Sub

 

要素的标注标注有两种方法,一个是添加TextElement到文档对象,另一种是基于要素的某个属性进行标注,它需要载入数据支持。第一种方法在P8中可以看到。下面介绍后一种方法:
Public sub Anno(byval pGeoFeatLyr as iGeofeaturelayer,byval field as string)
    Dim pGeoFeatLayer As IGeoFeatureLayer
pGeoFeatLayer = pGeoFeatLyr
         Dim pAnnoProps As IannotateLayerPropertiesCollection              
         pAnnoProps = pGeoFeatLyr.AnnotationProperties
         pAnnoProps.Clear()               必须执行这个语句,否则里面会默认有一个pAnnoLayerProps
         Dim pAnnoLayerProps As IAnnotateLayerProperties
         Dim pPosition As ILineLabelPosition
         Dim pPlacement As ILineLabelPlacementPriorities
         Dim pBasic As IBasicOverposterLayerProperties
         Dim pLabelEngine As ILabelEngineLayerProperties
         Dim pTextSyl As ItextSymbol         标注的文字格式,注意
         pTextSyl = New TextSymbol
         Dim pFont As stdole.StdFont
         pFont = New stdole.StdFont
         pFont.Name = "verdana"
         pFont.Size = 5
         pTextSyl.Font = pFont
         pTextSyl.Color = HSVColor(250, 160, 200)
         pPosition = New LineLabelPosition
         pPosition.Parallel = False
         pPosition.Perpendicular = True
         pPlacement = New LineLabelPlacementPriorities
         pBasic = New BasicOverposterLayerProperties
         pBasic.FeatureType = esriBasicOverposterFeatureType.esriOverposterPolyline
         pBasic.LineLabelPlacementPriorities = pPlacement
         pBasic.LineLabelPosition = pPosition
         pLabelEngine = New LabelEngineLayerProperties
         pLabelEngine.Symbol = pTextSyl
         pLabelEngine.BasicOverposterLayerProperties = pBasic
         pLabelEngine.Expression = field          field必须是这个样子——"[STATE_NAME]"
         pAnnoLayerProps = pLabelEngine
         pAnnoProps.Add(pAnnoLayerProps)
         pGeoFeatLyr.DisplayAnnotation = True
     AxMapControl.CtlRefresh(esriViewDrawPhase.esriViewBackground)
End sub
消除标注的方法也很简单,由于pGeoFeatLyr是一个全局变量,我们只要设置如下代码即可:
         pGeoFeatLyr.DisplayAnnotation = False
      AxMapControl.CtlRefresh(esriViewDrawPhase.esriViewBackground)

 

GIS数据回溯的基本思路以前看过一个GIS工程,里面有个很有特色的功能,就是数据回溯,这个功能可以依据时间点来现实当时的数据,当时我始终将这个功能和version混淆,不知道它是如何实现的,后来做工程的人指点了一下,经验不敢独享,贴出来给大家分享:
1.在设计要素类的时侯,特别设置两个字段,一个是starttime,一个是endtime。其中starttime去要素建立时侯的当前时间,而endtime取99999999。
2.当要素修改或者删除的时侯,只是将它的endtime取为当前时间。这样要素的删除就是假的,只是调整了一个结束时间而已。
3.某天打开一个要素类的时侯,仅仅需要取出这个类中endtime小于当前时间的要素。那些没有修改的要素的endtime都是99999999,当然会显示了。
因此,在进行数据回溯的时侯,不过是做一个判断而已,很简单吧。


   'Create a new AoInitialize object
   Set m_pAoInitialize = New AoInitialize
   If m_pAoInitialize Is Nothing Then
     MsgBox "Unable to initialize. This application cannot run!"
     Unload LabelEdit
     Exit Sub
   End If
   'Determine if the product is available
   If m_pAoInitialize.IsProductCodeAvailable(esriLicenseProductCodeEngine) = esriLicenseAvailable Then
     If m_pAoInitialize.Initialize(esriLicenseProductCodeEngine) <> esriLicenseCheckedOut Then
       MsgBox "The initialization failed. This application cannot run!"
       Unload LabelEdit
       Exit Sub
     End If
   Else
     MsgBox "The ArcGIS Engine product is unavailable. This application cannot run!"
     Unload LabelEdit
     Exit Sub
   End If

 
原创粉丝点击