|
搜集自gisforum
————————————————————————————
向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
|
