You are here: > ESRI Forums > arcgis desktop discussion forums > Thread Replies

ArcGIS Desktop Discussion Forums

ArcGIS Desktop - ArcObjects Visual Basic for Application (VBA) forum

Separate segments as features   Iain Cowan May 19, 2003
Re: Separate segments as features   Kirk Kuykendall May 19, 2003
Re: Separate segments as features   Iain Cowan May 21, 2003
Re: Separate segments as features   Kirk Kuykendall May 21, 2003
Re: Separate segments as features   Kirk Kuykendall Mar 09, 2009
Report Inappropriate Content • Top • Print • This Forum is closed for replies.    
Subject Separate segments as features 
Author Iain Cowan 
Date May 19, 2003 
Message I need to create a circle divided in to eight with eight equal area circles within it, so that there are 64 sectors each of equal area. (see attached diagram). The code I have written so far seems to do two things oddly. Firstly it only appears to create features on every second ring (highlighted in diagram). Secondly it seems as though each large sector (circle split in to eight) is a feature, rather than the smaller segments.

Can anybody help me before I go mad. I thought that perhaps one way would be to create 8 segmentcollections and then combine them but I cannot find a command to combine the collections. Is this the right way or is there a more simple effective way.

c_iNumberofSector is set to 64

Please help.

Iain 
 
For i = 1 To c_iNumberOfSector
    Set pFeature = pFeatureClass.CreateFeature
    Set pFeature.Shape = CreateMultiplePiePart(pCentre, Radius, i, c_iNumberOfSector)
    pFeature.Store 'save the changes to the shapefile
Next i

'refresh the view
pMxDocument.ActiveView.Refresh
End Function
Private Function CreateMultiplePiePart(pCenter As IPoint, dRadius As Double, iPartIndex As Integer, iTotalParts As Integer) As Polygon
Set CreateMultiplePiePart = Nothing
If iTotalParts < iPartIndex Or iTotalParts = 0 Then Exit Function
Dim pi As Double
pi = 4 * Atn(1)
'define segment collection
Dim pSegmentCollection As ISegmentCollection
'define types of arcs
Dim pConstructCircularArc1 As IConstructCircularArc
Dim pConstructCircularArc2 As IConstructCircularArc
Dim pConstructCircularArc3 As IConstructCircularArc
Dim pConstructCircularArc4 As IConstructCircularArc
Dim pConstructCircularArc5 As IConstructCircularArc
Dim pConstructCircularArc6 As IConstructCircularArc
Dim pConstructCircularArc7 As IConstructCircularArc
Dim pConstructCircularArc8 As IConstructCircularArc
Set pConstructCircularArc1 = New CircularArc
Set pConstructCircularArc2 = New CircularArc
Set pConstructCircularArc3 = New CircularArc
Set pConstructCircularArc4 = New CircularArc
Set pConstructCircularArc5 = New CircularArc
Set pConstructCircularArc6 = New CircularArc
Set pConstructCircularArc7 = New CircularArc
Set pConstructCircularArc8 = New CircularArc
'retrieve the from point
Dim pFromPoint1 As IPoint
Dim pFromPoint2 As IPoint
Dim pFromPoint3 As IPoint
Dim pFromPoint4 As IPoint
Dim pFromPoint5 As IPoint
Dim pFromPoint6 As IPoint
Dim pFromPoint7 As IPoint
Dim pFromPoint8 As IPoint
Set pFromPoint1 = New esriCore.Point
Set pFromPoint2 = New esriCore.Point
Set pFromPoint3 = New esriCore.Point
Set pFromPoint4 = New esriCore.Point
Set pFromPoint5 = New esriCore.Point
Set pFromPoint6 = New esriCore.Point
Set pFromPoint7 = New esriCore.Point
Set pFromPoint8 = New esriCore.Point
pFromPoint1.X = pCenter.X + (dRadius / 2.83) * Cos((2 * pi / 8) * (iPartIndex - 1))
pFromPoint1.Y = pCenter.Y + (dRadius / 2.83) * Sin((2 * pi / 8) * (iPartIndex - 1))
pFromPoint2.X = pCenter.X + (dRadius / 2) * Cos((2 * pi / 8) * (iPartIndex - 1))
pFromPoint2.Y = pCenter.Y + (dRadius / 2) * Sin((2 * pi / 8) * (iPartIndex - 1))
pFromPoint3.X = pCenter.X + (dRadius / 1.63) * Cos((2 * pi / 8) * (iPartIndex - 1))
pFromPoint3.Y = pCenter.Y + (dRadius / 1.63) * Sin((2 * pi / 8) * (iPartIndex - 1))
pFromPoint4.X = pCenter.X + (dRadius / 1.41) * Cos((2 * pi / 8) * (iPartIndex - 1))
pFromPoint4.Y = pCenter.Y + (dRadius / 1.41) * Sin((2 * pi / 8) * (iPartIndex - 1))
pFromPoint5.X = pCenter.X + (dRadius / 1.26) * Cos((2 * pi / 8) * (iPartIndex - 1))
pFromPoint5.Y = pCenter.Y + (dRadius / 1.26) * Sin((2 * pi / 8) * (iPartIndex - 1))
pFromPoint6.X = pCenter.X + (dRadius / 1.15) * Cos((2 * pi / 8) * (iPartIndex - 1))
pFromPoint6.Y = pCenter.Y + (dRadius / 1.15) * Sin((2 * pi / 8) * (iPartIndex - 1))
pFromPoint7.X = pCenter.X + (dRadius / 1.07) * Cos((2 * pi / 8) * (iPartIndex - 1))
pFromPoint7.Y = pCenter.Y + (dRadius / 1.07) * Sin((2 * pi / 8) * (iPartIndex - 1))
pFromPoint8.X = pCenter.X + (dRadius) * Cos((2 * pi / 8) * (iPartIndex - 1))
pFromPoint8.Y = pCenter.Y + (dRadius) * Sin((2 * pi / 8) * (iPartIndex - 1))
'construct the arc
Dim dArcDistance1 As Double
Dim dArcDistance2 As Double
Dim dArcDistance3 As Double
Dim dArcDistance4 As Double
Dim dArcDistance5 As Double
Dim dArcDistance6 As Double
Dim dArcDistance7 As Double
Dim dArcDistance8 As Double
dArcDistance1 = 2 * pi * (dRadius / 2.83) / 8
dArcDistance2 = 2 * pi * (dRadius / 2) / 8
dArcDistance3 = 2 * pi * (dRadius / 1.63) / 8
dArcDistance4 = 2 * pi * (dRadius / 1.41) / 8
dArcDistance5 = 2 * pi * (dRadius / 1.26) / 8
dArcDistance6 = 2 * pi * (dRadius / 1.15) / 8
dArcDistance7 = 2 * pi * (dRadius / 1.07) / 8
dArcDistance8 = 2 * pi * (dRadius) / 8
pConstructCircularArc1.ConstructArcDistance pCenter, pFromPoint1, True, dArcDistance1
pConstructCircularArc2.ConstructArcDistance pCenter, pFromPoint2, True, dArcDistance2
pConstructCircularArc3.ConstructArcDistance pCenter, pFromPoint3, True, dArcDistance3
pConstructCircularArc4.ConstructArcDistance pCenter, pFromPoint4, True, dArcDistance4
pConstructCircularArc5.ConstructArcDistance pCenter, pFromPoint5, True, dArcDistance5
pConstructCircularArc6.ConstructArcDistance pCenter, pFromPoint6, True, dArcDistance6
pConstructCircularArc7.ConstructArcDistance pCenter, pFromPoint7, True, dArcDistance7
pConstructCircularArc8.ConstructArcDistance pCenter, pFromPoint8, True, dArcDistance8
Dim pArcSegment1 As ISegment
Dim pArcSegment2 As ISegment
Dim pArcSegment3 As ISegment
Dim pArcSegment4 As ISegment
Dim pArcSegment5 As ISegment
Dim pArcSegment6 As ISegment
Dim pArcSegment7 As ISegment
Dim pArcSegment8 As ISegment
Set pArcSegment1 = pConstructCircularArc1
Set pArcSegment2 = pConstructCircularArc2
Set pArcSegment3 = pConstructCircularArc3
Set pArcSegment4 = pConstructCircularArc4
Set pArcSegment5 = pConstructCircularArc5
Set pArcSegment6 = pConstructCircularArc6
Set pArcSegment7 = pConstructCircularArc7
Set pArcSegment8 = pConstructCircularArc8

'build the polygon from segments
Set pSegmentCollection = New Polygon
With pSegmentCollection
    .AddSegment CreateLinearSegment(pCenter, pArcSegment1.FromPoint)
    .AddSegment pArcSegment1
    .AddSegment CreateLinearSegment(pArcSegment1.ToPoint, pCenter)
    .AddSegment CreateLinearSegment(pCenter, pArcSegment2.FromPoint)
    .AddSegment pArcSegment2
    .AddSegment CreateLinearSegment(pArcSegment2.ToPoint, pCenter)
    .AddSegment CreateLinearSegment(pCenter, pArcSegment3.FromPoint)
    .AddSegment pArcSegment3
    .AddSegment CreateLinearSegment(pArcSegment3.ToPoint, pCenter)
    .AddSegment CreateLinearSegment(pCenter, pArcSegment4.FromPoint)
    .AddSegment pArcSegment4
    .AddSegment CreateLinearSegment(pArcSegment4.ToPoint, pCenter)
    .AddSegment CreateLinearSegment(pCenter, pArcSegment5.FromPoint)
    .AddSegment pArcSegment5
    .AddSegment CreateLinearSegment(pArcSegment5.ToPoint, pCenter)
    .AddSegment CreateLinearSegment(pCenter, pArcSegment6.FromPoint)
    .AddSegment pArcSegment6
    .AddSegment CreateLinearSegment(pArcSegment6.ToPoint, pCenter)
    .AddSegment CreateLinearSegment(pCenter, pArcSegment7.FromPoint)
    .AddSegment pArcSegment7
    .AddSegment CreateLinearSegment(pArcSegment7.ToPoint, pCenter)
    .AddSegment CreateLinearSegment(pCenter, pArcSegment8.FromPoint)
    .AddSegment pArcSegment8
    .AddSegment CreateLinearSegment(pArcSegment8.ToPoint, pCenter)
End With
Dim pPolygon As IPolygon
Set pPolygon = pSegmentCollection
pPolygon.Close
Set CreateMultiplePiePart = pPolygon
End Function
 
  Sectors.jpg (opens in new window)
 
Report Inappropriate Content • Top • Print • This Forum is closed for replies.    
Subject Re: Separate segments as features 
Author Kirk Kuykendall 
Date May 19, 2003 
Message code below draws 64 polygons to the screen

kkeywords sector 
 
Option Explicit
Sub Test()
    Dim pMxDoc As IMxDocument
    Set pMxDoc = ThisDocument
    
    Dim pAV As IActiveView
    Set pAV = pMxDoc.FocusMap
    
    Dim dArea As Double
    dArea = (pAV.Extent.Width * pAV.Extent.Height) / 16
    
    Dim pPoint As IPoint
    Set pPoint = GetMidPoint(pAV.Extent)
    With pAV.ScreenDisplay
        .StartDrawing .hDC, esriNoScreenCache
        DrawThem pPoint, 8, 8, dArea, pAV.ScreenDisplay
        .FinishDrawing
    End With
End Sub

Sub DrawThem(pPoint As IPoint, lSectors As Long, lRings As Long, _
             dArea As Double, pDisp As IDisplay)
    
    Dim l As Long, PI As Double
    PI = Atn(1#) * 4
    Dim dAng As Double
    dAng = (2 * PI) / lSectors
        
    For l = 0 To lSectors - 1
        Dim k As Long
        Dim R0 As Double, R1 As Double, R2 As Double
        For k = 0 To lRings - 1
            If k = 0 Then
                R0 = 0#
                R1 = 0#
                R2 = (dArea / PI) ^ 0.5
            Else
                R0 = R1
                R1 = R2
                R2 = ((2 * (R1 ^ 2)) - (R0 ^ 2)) ^ 0.5
            End If
            Dim pPolygon As IPolygon
            Set pPolygon = _
            MakeSector(pPoint, l * dAng, (l + 1) * dAng, _
                               R1, R2)
            pDisp.SetSymbol MakeSFS(-1)
            pDisp.DrawPolygon pPolygon
        Next k
    Next l
End Sub

Function MakeSFS(lRGB As Long) As ISimpleFillSymbol
    Set MakeSFS = New SimpleFillSymbol
    MakeSFS.Color = MakeColor(lRGB)
End Function

Function MakeColor(lRGB As Long) As IRgbColor
    Set MakeColor = New RgbColor
    If lRGB < 0 Then
        MakeColor.Red = Rnd * 255
        MakeColor.Green = Rnd * 255
        MakeColor.Blue = Rnd * 255
    Else
        MakeColor.RGB = lRGB
    End If
End Function

Function GetMidPoint(pEnv As IEnvelope) As IPoint
    Set GetMidPoint = New Point
    GetMidPoint.PutCoords (pEnv.LowerLeft.X + pEnv.UpperRight.X) / 2#, _
                          (pEnv.LowerLeft.Y + pEnv.UpperRight.Y) / 2#
End Function

Function MakeSector(pOrigin As IPoint, dFromAngle As Double, dToAngle As Double, _
                    dRadius1 As Double, dRadius2 As Double) As IPolygon

    Dim pArcSeg1 As ISegment
    If dRadius1 > 0 Then
        Set pArcSeg1 = MakeArcSeg(pOrigin, dRadius1, True, dFromAngle, dToAngle)
    End If
    
    Dim pArcSeg2 As ISegment
    Set pArcSeg2 = MakeArcSeg(pOrigin, dRadius2, False, dToAngle, dFromAngle)

    Dim pLineSeg1 As ISegment
    If Not pArcSeg1 Is Nothing Then
        Set pLineSeg1 = MakeLineSeg(pArcSeg1.ToPoint, pArcSeg2.FromPoint)
    Else
        Set pLineSeg1 = MakeLineSeg(pOrigin, pArcSeg2.FromPoint)
    End If
    Dim pSegColl As ISegmentCollection
    Set pSegColl = New Ring
    If Not pArcSeg1 Is Nothing Then
        pSegColl.AddSegment pArcSeg1
    End If
    pSegColl.AddSegment pLineSeg1
    pSegColl.AddSegment pArcSeg2
        
    Dim pRing As IRing
    Set pRing = pSegColl
    pRing.Close
    
    Dim pGeomColl As IGeometryCollection
    Set pGeomColl = New Polygon
    pGeomColl.AddGeometry pSegColl
    Set MakeSector = pGeomColl
End Function

Function MakeLineSeg(pPoint1 As IPoint, pPoint2 As IPoint) As esriCore.ILine
    Set MakeLineSeg = New esriCore.Line
    MakeLineSeg.PutCoords pPoint1, pPoint2
End Function

Function MakeArcSeg(pOrigin As IPoint, dRadius As Double, bCCW As Boolean, _
                 dFromAngle As Double, dToAngle As Double) As ISegment
    Dim pCCA As IConstructCircularArc
    Set pCCA = New CircularArc
    pCCA.ConstructArcDistance pOrigin, _
                              MakePoint(pOrigin, dFromAngle, dRadius), _
                              bCCW, (dToAngle - dFromAngle) * dRadius
    Set MakeArcSeg = pCCA
End Function

Function MakePoint(pOrigin As IPoint, dAngle As Double, _
                   dRadius As Double) As IPoint
    Dim pCP As IConstructPoint
    Set pCP = New Point
    pCP.ConstructAngleDistance pOrigin, dAngle, dRadius
    Set MakePoint = pCP
End Function


 
  Kirk Kuykendall
AmberGIS Programming Services & Sales
http://www.ambergis.com
Now Answering questions at:
http://gis.stackexchange.com/


 
   
Report Inappropriate Content • Top • Print • This Forum is closed for replies.    
Subject Re: Separate segments as features 
Author Iain Cowan 
Date May 21, 2003 
Message Thanks for your reply, I tried to get your code working with mine, but I not only need them drawn but they need to be features in a predefined shapefile. Then the individual features are added to a raster background and given individual values.

I have managed to work around the problem, in the with segments bit, I have only used the line from the outside of the circle for each sector, and listed the outside sectors first working my way in to the middle of the circle. In this way, the smaller sectors are on top of the larger ones, then I can subtract one value from another to give a unique value.

Once again many thanks for all your help.

Iain 
   
Report Inappropriate Content • Top • Print • This Forum is closed for replies.    
Subject Re: Separate segments as features 
Author Kirk Kuykendall 
Date May 21, 2003 
Message code below adds polygons to current edit layer

kkeywords sectors 
 
Option Explicit
Sub Test()
    Dim pEditor As IEditor
    Set pEditor = Application.FindExtensionByName("ESRI Object Editor")
    If pEditor.EditState <> esriStateEditing Then
        Debug.Print "not editing"
        Exit Sub
    End If
    Dim pEL As IEditLayers
    Set pEL = pEditor
    If pEL.CurrentLayer.FeatureClass.ShapeType <> esriGeometryPolygon Then
        Debug.Print "target layer is not polygons"
        Exit Sub
    End If
    Dim pAV As IActiveView
    Set pAV = pEditor.Map
    Dim dArea As Double
    dArea = (pAV.Extent.Width * pAV.Extent.Height) / 16
    
    Dim pPoint As IPoint
    Set pPoint = GetMidPoint(pAV.Extent)
    
    pEditor.StartOperation
    AddSectors pPoint, 8, 8, dArea, _
                       pEL.CurrentLayer.FeatureClass
    pEditor.StopOperation "add sectors"
    pAV.Refresh
End Sub

Sub AddSectors(pPoint As IPoint, lSectors As Long, lRings As Long, _
               dArea As Double, pFC As IFeatureClass)
    
    Dim l As Long, PI As Double
    PI = Atn(1#) * 4
    Dim dAng As Double
    dAng = (2 * PI) / lSectors
        
    For l = 0 To lSectors - 1
        Dim k As Long
        Dim R0 As Double, R1 As Double, R2 As Double
        For k = 0 To lRings - 1
            If k = 0 Then
                R0 = 0#
                R1 = 0#
                R2 = (dArea / PI) ^ 0.5
            Else
                R0 = R1
                R1 = R2
                R2 = ((2 * (R1 ^ 2)) - (R0 ^ 2)) ^ 0.5
            End If
            Dim pPolygon As IPolygon
            Set pPolygon = _
            MakeSector(pPoint, l * dAng, (l + 1) * dAng, _
                               R1, R2)
            Dim pFeat As IFeature
            Set pFeat = pFC.CreateFeature
            Set pFeat.Shape = pPolygon
            pFeat.Store
        Next k
    Next l
End Sub

Function GetMidPoint(pEnv As IEnvelope) As IPoint
    Set GetMidPoint = New Point
    GetMidPoint.PutCoords (pEnv.LowerLeft.X + pEnv.UpperRight.X) / 2#, _
                          (pEnv.LowerLeft.Y + pEnv.UpperRight.Y) / 2#
End Function

Function MakeSector(pOrigin As IPoint, dFromAngle As Double, dToAngle As Double, _
                    dRadius1 As Double, dRadius2 As Double) As IPolygon

    Dim pArcSeg1 As ISegment
    If dRadius1 > 0 Then
        Set pArcSeg1 = MakeArcSeg(pOrigin, dRadius1, True, dFromAngle, dToAngle)
    End If
    
    Dim pArcSeg2 As ISegment
    Set pArcSeg2 = MakeArcSeg(pOrigin, dRadius2, False, dToAngle, dFromAngle)

    Dim pLineSeg1 As ISegment
    If Not pArcSeg1 Is Nothing Then
        Set pLineSeg1 = MakeLineSeg(pArcSeg1.ToPoint, pArcSeg2.FromPoint)
    Else
        Set pLineSeg1 = MakeLineSeg(pOrigin, pArcSeg2.FromPoint)
    End If
    Dim pSegColl As ISegmentCollection
    Set pSegColl = New Ring
    If Not pArcSeg1 Is Nothing Then
        pSegColl.AddSegment pArcSeg1
    End If
    pSegColl.AddSegment pLineSeg1
    pSegColl.AddSegment pArcSeg2
        
    Dim pRing As IRing
    Set pRing = pSegColl
    pRing.Close
    
    Dim pGeomColl As IGeometryCollection
    Set pGeomColl = New Polygon
    pGeomColl.AddGeometry pSegColl
    Set MakeSector = pGeomColl
End Function

Function MakeLineSeg(pPoint1 As IPoint, pPoint2 As IPoint) As esriCore.ILine
    Set MakeLineSeg = New esriCore.Line
    MakeLineSeg.PutCoords pPoint1, pPoint2
End Function

Function MakeArcSeg(pOrigin As IPoint, dRadius As Double, bCCW As Boolean, _
                 dFromAngle As Double, dToAngle As Double) As ISegment
    Dim pCCA As IConstructCircularArc
    Set pCCA = New CircularArc
    pCCA.ConstructArcDistance pOrigin, _
                              MakePoint(pOrigin, dFromAngle, dRadius), _
                              bCCW, (dToAngle - dFromAngle) * dRadius
    Set MakeArcSeg = pCCA
End Function

Function MakePoint(pOrigin As IPoint, dAngle As Double, _
                   dRadius As Double) As IPoint
    Dim pCP As IConstructPoint
    Set pCP = New Point
    pCP.ConstructAngleDistance pOrigin, dAngle, dRadius
    Set MakePoint = pCP
End Function


 
  Kirk Kuykendall
AmberGIS Programming Services & Sales
http://www.ambergis.com
Now Answering questions at:
http://gis.stackexchange.com/


 
   
Report Inappropriate Content • Top • Print • This Forum is closed for replies.    
Subject Re: Separate segments as features 
Author Kirk Kuykendall 
Date Mar 09, 2009 
Message updated to just show simple pie shaped sector 
 
Option Explicit
Sub Test()
    Dim pMxDoc As IMxDocument
    Set pMxDoc = ThisDocument
    Dim pAV As IActiveView
    Set pAV = pMxDoc.FocusMap
    Dim pArea As IArea
    Set pArea = pAV.Extent
    
    Dim pPoint As IPoint
    Set pPoint = pArea.Centroid
    
    
    Dim radiusNM As Double
    radiusNM = 10#
    
    Dim radiusFeet As Double
    radiusFeet = radiusNM * 6076.1155
    
    Dim pSector As IPolygon
    Set pSector = MakeSector(pPoint, 45, 140, radiusFeet, True)
    
    Dim pElement As IElement
    Set pElement = New PolygonElement
    pElement.Geometry = pSector
    Dim pGC As IGraphicsContainer
    Set pGC = pAV
    pGC.AddElement pElement, 0
    pAV.Refresh
End Sub


Function Azi2Cart(dAzimuth As Double) As Double
    Dim dDegCart As Double
    dDegCart = 90# - dAzimuth
    
    Azi2Cart = dDegCart
End Function

Function Deg2Rad(dDeg As Double) As Double
    Dim PI As Double
    PI = Atn(1#) * 4#
    Deg2Rad = (dDeg / 180#) * PI
End Function

Function MakeSector(pOrigin As IPoint, _
                    dFromAzimuth As Double, _
                    dToAzimuth As Double, _
                    dRadius As Double, _
                    bCW As Boolean) As IPolygon

    Dim dFromCart As Double
    dFromCart = Azi2Cart(dFromAzimuth)
    
    Dim dToCart As Double
    dToCart = Azi2Cart(dToAzimuth)
    
    Dim pArcSeg1 As ISegment
    Set pArcSeg1 = MakeArcSeg(pOrigin, dRadius, bCW, _
        Deg2Rad(dFromCart), _
        Deg2Rad(dToCart))
        
    Dim pSegColl As ISegmentCollection
    Set pSegColl = New Ring
    pSegColl.AddSegment pArcSeg1
    pSegColl.AddSegment MakeLineSeg(pArcSeg1.ToPoint, pOrigin)
    pSegColl.AddSegment MakeLineSeg(pOrigin, pArcSeg1.FromPoint)
    
    Dim pRing As IRing
    Set pRing = pSegColl
    pRing.Close
    
    Dim pGeomColl As IGeometryCollection
    Set pGeomColl = New Polygon
    pGeomColl.AddGeometry pSegColl
    Set MakeSector = pGeomColl
End Function

Function MakeLineSeg(pPoint1 As IPoint, pPoint2 As IPoint) As esriGeometry.ILine
    Set MakeLineSeg = New esriGeometry.Line
    MakeLineSeg.PutCoords pPoint1, pPoint2
End Function

Function MakeArcSeg(pOrigin As IPoint, dRadius As Double, bCW As Boolean, _
                 dFromAngle As Double, dToAngle As Double) As ISegment
    Dim pCCA As IConstructCircularArc
    Set pCCA = New CircularArc
    Dim pFromPoint As IPoint
    Set pFromPoint = MakePoint(pOrigin, dFromAngle, dRadius)
    Dim pToPoint As IPoint
    Set pToPoint = MakePoint(pOrigin, dToAngle, dRadius)
    
    Dim PI As Double
    PI = Atn(1#) * 4#
    
    Dim bCCW As Boolean
    bCCW = Not bCW
    pCCA.ConstructEndPointsRadius pFromPoint, pToPoint, _
                                  bCCW, dRadius, bCW
    Set MakeArcSeg = pCCA
End Function

Function MakePoint(pOrigin As IPoint, dAngle As Double, _
                   dRadius As Double) As IPoint
    Dim pCP As IConstructPoint
    Set pCP = New Point
    pCP.ConstructAngleDistance pOrigin, dAngle, dRadius
    Set MakePoint = pCP
End Function

 
  Kirk Kuykendall
AmberGIS Programming Services & Sales
http://www.ambergis.com
Now Answering questions at:
http://gis.stackexchange.com/