Le portail francophone de la géomatique

'This script will select the first layer in the TOC, if it is a polyline and has at least
'one line/record selected, it will add two fields called AriAngle (Arithmetic Rotation aka Polar)
'and GeoAngle (Geographic Rotation aka North Azimuth) and populate the fields with angles for each
'selected line/record based upon its from to direction.

'CREATED BY:  James Zazula, GIS Analyst, City of Barrie, Barrie, Ontario, Canada
'CREATED BY:  James Zazula, GIS Consultant, GIS North, Barrie, Ontario, Canada
'Assistance provided by Kirsten Lowerey, Planning Technician, City of Barrie, Ontario, Canada
'If you would like to make improvements to the script, feel free to do so and send me the new script :)
'Created in ArcGIS 8.3, not tested in 9.x

'Portion of script based upon ESRI ILINE Example
'Portion of script based upon DOUGLAS R. GUESS - LANCASTER COUNTY ASSESSOR/REGISTER OF DEEDS OFFICE

'NOTES:
'A least one polyline must be selected
'The script will only work if the polyline layer is the first layer on the TOC
'To calculate the value of PI = 4 * Atn(1)
'To convert Angles to Radians (Radians = Angle in Degrees * (PI/180))
'To convert Radians to Angles (Angles in Degrees = Radians * (180/PI))

'      Calculated Angle          Arithmetic Angle         Geographic Angle
'             90                       90                       0
'             |                         |                       |
'             |                         |                       |
'    180      |                         |                       |
'   -180 ----------- 0          180 ---------- 0       270 ----------- 90
'             |                         |                       |
'             |                         |                       |
'             |                         |                       |
'            -90                       270                     180

'This script will choose the first layer in the TOC and makes sure that it is a polyline
'This script will make sure at least on polyline/record is selected
'You do not have to be in edit mode for this script to work, just run the macro FindPolylineAngle

Public Sub FindAngle()

Dim pMxDoc As IMxDocument
Set pMxDoc = ThisDocument
Dim pMap As IMap
Set pMap = pMxDoc.FocusMap
If pMxDoc.FocusMap.LayerCount = 0 Then
    MsgBox "Must have at least one layer.", vbExclamation
    Exit Sub
End If
Dim pFeatSelection As IFeatureSelection
Set pFeatSelection = pMxDoc.FocusMap.Layer(0)
Dim lCache As Long
lCache = pMxDoc.ActiveView.ScreenCacheID(esriViewGeoSelection, Nothing)
Dim FromPt1 As IPoint, ToPt1 As IPoint
Dim pGeometry1 As IGeometry
Dim pPolyline1 As IPolyline
Dim pFeatureLayer As IFeatureLayer
Set pFeatureLayer = pFeatSelection
Dim pFeatClass As IFeatureClass
Set pFeatClass = pFeatureLayer.FeatureClass
Dim pFeat1 As IFeature
Set pFLayer = pMxDoc.SelectedLayer

If pFeatClass.ShapeType <> esriGeometryPolyline Then
MsgBox "You must have a polyline layer as the first item on the TOC."
    Exit Sub
End If
       
Dim pEnumIDS As IEnumIDs
Set pEnumIDS = pFeatSelection.SelectionSet.IDs
Dim lOID1 As Variant
Dim pLine As ILine
Dim getRadian As Double
Dim getAngle As Integer, iAriAngle As Integer, iGeoAngle As Integer 'Could be changed to double
Dim PI As Double
PI = 4 * Atn(1)
Dim lCount As Long
Dim indexA As Long
Dim indexG As Long
Dim nTotal As Long
nTotal = pFeatSelection.SelectionSet.Count
Dim sTotal As String
Dim pPointFrom As IPoint, pPointTo As IPoint
Set pPointFrom = New Point
Set pPointTo = New Point
Set pLine = New Line


If nTotal = 0 Then
    MsgBox "Please select at least one line"
Else
'Add a new field called AriAngle (Arithmetic Angle)
  indexA = pFeatClass.FindField("ARIANGLE")
  If indexA < 0 Then
    Dim pFieldAri As IFieldEdit
    Set pFieldAri = New Field
    With pFieldAri
      .Type = esriFieldTypeInteger
      .Name = "ARIANGLE"
    End With
    pFeatClass.AddField pFieldAri
  End If
  indexA = pFeatClass.FindField("ARIANGLE")
'Add a new field called GeoAngle (Geographic Angle)
  indexG = pFeatClass.FindField("GEOANGLE")
  If indexG < 0 Then
    Dim pFieldGeo As IFieldEdit
    Set pFieldGeo = New Field
    With pFieldGeo
      .Type = esriFieldTypeInteger
      .Name = "GEOANGLE"
    End With
    pFeatClass.AddField pFieldGeo
  End If
  indexG = pFeatClass.FindField("GEOANGLE")
End If

Do While Not pFeatureLayer Is Nothing
    lOID1 = pEnumIDS.Next
    lCount = lCount + 1
    If lCount > nTotal Then
        sTotal = Str(nTotal)
        If nTotal <> 0 Then
            MsgBox "Script complete" & vbNewLine & Trim(sTotal) & " lines now have angles"
        End If
        Exit Sub
    End If

    Set pFeat1 = pFeatClass.GetFeature(lOID1)
    Set FromPt1 = New Point
    Set ToPt1 = New Point
    Set pGeometry1 = pFeat1.Shape
    Set pPolyline1 = pGeometry1
    pPolyline1.QueryFromPoint FromPt1
    pPolyline1.QueryToPoint ToPt1
    pPointFrom.PutCoords FromPt1.x, FromPt1.y
    pPointTo.PutCoords ToPt1.x, ToPt1.y
    pLine.PutCoords pPointFrom, pPointTo
    getRadian = pLine.Angle
 
'This section will change the polyline to an Arithmetic Rotational Angle (aka Polar)
    If getRadian < 0 Then
        iAriAngle = 360 - (((getRadian * 360) * -1) / (2 * PI))
    Else
        iAriAngle = (getRadian * 360) / (2 * PI)
    End If
    pFeat1.Value(indexA) = iAriAngle
    pFeat1.Store

'This section with change the polyline to a Geographic Rotational Angle (aka North Azimuth)
    getAngle = 45 - (iAriAngle - 45)
    If getAngle < 0 Then
        iGeoAngle = getAngle + 360
    Else
        iGeoAngle = getAngle
    End If
    pFeat1.Value(indexG) = iGeoAngle
    pFeat1.Store
Loop

Errorhandler:
MsgBox Err.Number & "..." & Err.Description
Exit Sub

End Sub