‘打開工作空間
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)
－－－－－－－－－－－－－－－－－－－－－－－
代碼經過實際測試，沒有任何問題！
自己做要素的閃爍下面的方法需要傳入四個參數(shù)，第一個是MapControl空間的ScreenDisplay對象，pGeometry是要被閃爍的要素圖形，nTimer是閃爍的次數(shù)，而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對象有深入的了解，不過并不復雜，在我的書稿中對這個對象有詳細的介紹。
代碼經過測試，可以完美使用。
要素動態(tài)跟蹤的算法這個算法其實很簡單，核心原理是在一個timer_tick事件中不斷改變一個markerElement的geometry。而我們關注的目標也是這些符合條件的geometry如何得到。
1.polyline上的節(jié)點
我們我們要取一條polyline上的節(jié)點，這個方法是非常簡單的，使用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
這個函數(shù)可取出符合要求的點集出來。
向要素類中插入一條要素的方法本例使用ifeatureclass::insertFeature和featurebuffer等命令構成。
Option Explicit
Dim pFeatClass As IFeatureClass
‘-----看看沒有繪制前要素類里面的要素數(shù)目
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到文檔對象，另一種是基于要素的某個屬性進行標注，它需要載入數(shù)據(jù)支持。第一種方法在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() 必須執(zhí)行這個語句，否則里面會默認有一個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數(shù)據(jù)回溯的基本思路以前看過一個GIS工程，里面有個很有特色的功能，就是數(shù)據(jù)回溯，這個功能可以依據(jù)時間點來現(xiàn)實當時的數(shù)據(jù)，當時我始終將這個功能和version混淆，不知道它是如何實現(xiàn)的，后來做工程的人指點了一下，經驗不敢獨享，貼出來給大家分享：
1.在設計要素類的時侯，特別設置兩個字段，一個是starttime，一個是endtime。其中starttime去要素建立時侯的當前時間，而endtime取99999999。
2.當要素修改或者刪除的時侯，只是將它的endtime取為當前時間。這樣要素的刪除就是假的，只是調整了一個結束時間而已。
3.某天打開一個要素類的時侯，僅僅需要取出這個類中endtime小于當前時間的要素。那些沒有修改的要素的endtime都是99999999，當然會顯示了。
因此，在進行數(shù)據(jù)回溯的時侯，不過是做一個判斷而已，很簡單吧。
‘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
