HOW TO
When true curves are created in a geodatabase at a very large scale, they often come across as triangular shapes once converted to shapefile format.Instructions provide code for converting polygon geodatabase features containing true curves to shapefile features using a method that helps maintain the shape of the true curve.
Note:
Code in the Project's ThisDocument code module will only run in the current map document. If you want to store the code in all your map documents open the Normal.mxt ThisDocument code module instead.
Code:
Sub ExportTrueArcs2Shapefile()
Dim pDoc As IMxDocument
Dim pFlayerGDB As IFeatureLayer
Dim pFCursor As IFeatureCursor
Dim pFeature As IFeature
Dim pFlayerShape As IFeatureLayer
Dim pFlayerShapeFC As IFeatureClass
Dim pPolycurve As IPolycurve2
Dim dPi As Double
Dim dMaxSeg As Double
Dim pGeometry As IGeometry
Dim dXyUnit As Double
Dim dXfalse As Double
Dim dyFalse As Double
Dim pSPRef As ISpatialReference
Dim pSegCol As ISegmentCollection
Dim bNonLinear As Boolean
Dim pCurve As ICurve
Set pDoc = ThisDocument
Set pFlayerGDB = pDoc.FocusMap.Layer(0)
Set pFCursor = pFlayerGDB.FeatureClass.Search(Nothing, False)
Set pFeature = pFCursor.NextFeature
If pFlayerGDB.FeatureClass.ShapeType <> esriGeometryPolygon _
Then Exit Sub
Set pFlayerShape = pDoc.FocusMap.Layer(1)
Set pFlayerShapeFC = pFlayerShape.FeatureClass
'Get the angle in radians
dPi = Atn(1) * 4
Set pGeometry = pFeature.ShapeCopy
Set pSPRef = pGeometry.SpatialReference
pSPRef.GetFalseOriginAndUnits dXfalse, dyFalse, dXyUnit
dMaxSeg = (1 / dXyUnit) * 100000
While Not pFeature Is Nothing
Set pCurve = pFeature.Shape
Set pPolycurve = pCurve
Set pSegCol = pPolycurve
pSegCol.HasNonLinearSegments bNonLinear
If bNonLinear Then
pPolycurve.DensifyByAngle dMaxSeg, dPi / 180
End If
storeFeature pPolycurve, pFlayerShapeFC
Set pFeature = pFCursor.NextFeature
Wend
End Sub
Private Sub storeFeature(pGeo As IGeometry, pFClass As _
IFeatureClass)
On Error GoTo errHand
Dim pNewFCursor As IFeatureCursor
Dim pFeatureBuffer As IFeatureBuffer
Set pNewFCursor = pFClass.Insert(True)
Set pFeatureBuffer = pFClass.CreateFeatureBuffer
Set pFeatureBuffer.Shape = pGeo
pNewFCursor.InsertFeature pFeatureBuffer
pNewFCursor.Flush
Exit Sub
errHand:
Debug.Print Err.Description
End Sub
Article ID:000006287
Get help from ArcGIS experts
Download the Esri Support App