| |
Option Explicit
'MAKE SURE YOU HAVE EXCLUSIVE LOCK TO THE DATA YOU ARE CLEANING, OTHERWISE YOU GET DBASE LOCK ERROR
Public Sub EllipDetect()
Dim pMxDoc As IMxDocument
Dim pMap As IMap
Dim pFLayer As IFeatureLayer
Dim pFClass As IFeatureClass
Dim pFCursor As IFeatureCursor
Dim pFeature As IFeature
Set pMxDoc = Application.Document
Set pMap = pMxDoc.FocusMap
Set pFLayer = pMap.Layer(0)
Set pFClass = pFLayer.FeatureClass
Dim logObject As Object
Set logObject = CreateObject("Scripting.FileSystemObject")
Dim txtStream As Object
Set txtStream = logObject.CreateTextFile("C:\Documents and Settings\TLI\Desktop\elliplog.txt")
'write gui for this part, use dlg
Dim txtString As String
Dim pGeom As IGeometry
Dim pSegColl As ISegmentCollection
Dim pSegCounter As Long
Dim pSegment As ISegment
Dim pToPoint As IPoint
Dim pFromPoint As IPoint
Dim pArcCenter As IPoint
Dim pISCCW As Boolean
Dim pEllipArc As IEllipticArc
Dim pCArc As ICircularArc
Dim SemiMajor As Double
Dim SemiMinor As Double
Dim MajMinRatio As Double
Dim pGeoColl As IGeometryCollection
' IMPORTANT, When updating a feature, you need to get ref to WorkSpace and Workspace edit below
' Otherwise you will get automation error, and start operation or you get edit oeration is required error
Dim pDataSet As IDataset
Set pDataSet = pFClass
Dim pWorkSpace As IWorkspace
Set pWorkSpace = pDataSet.Workspace
Dim pWorkSpaceEdit As IWorkspaceEdit
Set pWorkSpaceEdit = pWorkSpace
pWorkSpaceEdit.StartEditing True
pWorkSpaceEdit.StartEditOperation
Set pFCursor = pFClass.Update(Nothing, False)
Set pFeature = pFCursor.NextFeature
Do Until pFeature Is Nothing
Set pSegColl = pFeature.ShapeCopy
For pSegCounter = 0 To (pSegColl.SegmentCount - 1)
Set pSegment = pSegColl.Segment(pSegCounter)
If pSegment.GeometryType = esriGeometryEllipticArc Then
Set pEllipArc = pSegment 'QI
pEllipArc.GetAxes SemiMajor, SemiMinor, MajMinRatio
If MajMinRatio < 0.9 Then 'This is tolerance
txtString = pFeature.OID & " ## " & Str(pSegCounter) & "_Fix_by_Hand_"
txtStream.WriteLine txtString
Else
Set pArcCenter = pEllipArc.CenterPoint
Set pFromPoint = pEllipArc.FromPoint
Set pToPoint = pEllipArc.ToPoint
pISCCW = pEllipArc.IsCounterClockwise
Set pCArc = New CircularArc
pCArc.PutCoords pArcCenter, pFromPoint, pToPoint, pISCCW
pSegColl.RemoveSegments pSegCounter, 1, False
pSegColl.AddSegment pCArc
pSegColl.SegmentsChanged
Set pGeoColl = New Polyline
pGeoColl.AddGeometryCollection pSegColl
Set pFeature.Shape = pGeoColl
Debug.Print pSegColl.SegmentCount & " ## " & pFeature.OID
End If
End If
Next pSegCounter
pFCursor.UpdateFeature pFeature
pFeature.Store
Set pFeature = pFCursor.NextFeature
Loop
txtStream.Close
pWorkSpaceEdit.StopEditOperation
pWorkSpaceEdit.StopEditing True
MsgBox "Operation Completed"
End Sub |
