How to write a script that will automatically draw lines from one point to multiple destination points? (ArcMap 9.3)

Question

I need to create lines from an airport to numerous destination locations. The destinations change often, so drawing them manually becomes tedious. I want to create a script that will draw them automatically. Does anyone know how to do this?

I've written a number of scripts for ArcGIS 10 using arcpy, but nothing for 9.3. If you could point me in the right direction that would be great.

Answer 1

In Arc, they call these "Desire Lines" or "Spider Diagrams". There are a number of ArcGIS Toolbox tools that have already been created to to just this task:

Take a look at the ArcGIS Resource center for Geoprocessing under Model and Script Tool Gallery:

• Spider Diagram Tool for ArcGIS 10.0
• Spider Function For ArcGIS Desktop 10
• Spider

Or ArcScripts:

• Spider Diagram Tools for ArcGIS 9.2 (New and Improved)
• Create Spider Graph from Shapefiles

Or if you have the Business Analyst Extension:

• Create spider diagram (desire lines)

Or SoCalGIS python script:

• Spider Diagrams

Outside of the Arc platform, you can also:

• Create Spider Lines in PostGIS

Answer 2

It's not python but how is this? Select a point layer in the table of contents (TOC) then on that layer select the origin point feature. The script will draw a lines on another (Target) feature class from the selected point to all other points in the same feature class.

Public Sub Distances

    Dim i As Long

    Dim pFeature As IFeature
    Dim pNewFeature As IFeature
    Dim pMxDoc As IMxDocument
    Dim pPoint As IPoint
    Dim pFeatureClass As IFeatureClass
    Dim pLayer As ILayer
    Dim pFeatureLayer As IFeatureLayer
    Dim pFeatureCursor As IFeatureCursor
    Dim pFeatureSelection As IFeatureSelection
    Dim pMap As IMap
    Dim pEnumFeature As IEnumFeature
    Dim pEnumFeatureSetup As IEnumFeatureSetup
    Dim OriginFeature As IFeature
    Dim OriginPoint As IPoint
    Dim pPolyline As IPolyline5
    Dim pSelectionSet As ISelectionSet
    Dim pSp As ISpatialReference

    Dim x As Integer, d As Long

    Set pMxDoc = ThisDocument

    Set pLayer = pMxDoc.SelectedLayer
    If pLayer Is Nothing Then
        MsgBox "Select a layer in the TOC!": exit sub
    End If

    Set pFeatureLayer = pLayer
    Set pFeatureClass = pFeatureLayer.FeatureClass

    If pFeatureLayer.FeatureClass.ShapeType <> esriGeometryPoint Then
        MsgBox "Target layer must be a point geometry feature class."
        GoTo ep
    End If

    Set pMap = pMxDoc.FocusMap
    If pMap.SelectionCount = 0 Then
        MsgBox "You must select a point feature for origin."
        GoTo ep
    End If

    If pMap.SelectionCount > 1 Then
        MsgBox "Select only one feature for origin" & Chr(13) & "Currently " & pMap.SelectionCount & " feature(s) are selected."
        GoTo ep
    End If

    Set pEnumFeature = pMap.FeatureSelection
    Set pEnumFeatureSetup = pEnumFeature 
    pEnumFeatureSetup.AllFields = True

    Set OriginFeature = pEnumFeature.Next

    If OriginFeature.Shape.GeometryType <> esriGeometryPoint Then
        MsgBox "Selected origin must be a point geomtry feature."
        GoTo ep
    End If

    Set OriginPoint = OriginFeature.ShapeCopy 


    Dim originCS As String, targetCS As String

    originCS = Trim$(OriginFeature.Shape.SpatialReference.Name)

    GetSpatialReference pFeatureLayer, pSp   
    targetCS = Trim$(pSp.Name)

    If originCS <> targetCS Then
        MsgBox "Origin must have the same coordinate system as target." & Chr(13) & _
            "Origin CS: " & originCS & Chr(13) & "Target CS: " & targetCS, vbInformation
        GoTo ep
    End If

    If Trim$(Mid(targetCS, 1, 12)) <> "NAD_1983_UTM" Then
        If MsgBox("The coordinate system is not NAD 83 UTM!" & Chr(13) & _
            "Distances may not be accurate. Continue Anyway?", vbQuestion + vbYesNo) = vbNo Then
            GoTo ep
        End If
    End If

    x = pFeatureClass.FindField("DISTANCE")
    If x = -1 Then
        MsgBox "DISTANCE field does not exist!": exit sub
    End If


    Set pFeatureSelection = pFeatureLayer

    Set pSelectionSet = pFeatureSelection.SelectionSet
    d = pSelectionSet.count
    'retreive selection into a cursor
    If d > 0 Then
        pSelectionSet.Search Nothing, False, pFeatureCursor  
    Else
        d = pFeatureLayer.FeatureClass.FeatureCount(Nothing)
        Set pFeatureCursor = pFeatureClass.Update(Nothing, False) 
    End If


    Set pFeature = pFeatureCursor.NextFeature

    Do While Not pFeature Is Nothing

        Application.StatusBar.message(0) = Str(i) & " of " & Str(d) & " completed"
        i = i + 1
        Set pPoint = pFeature.Shape
        Set pPolyline = New Polyline
        pPolyline.FromPoint = OriginPoint
        pPolyline.ToPoint = pPoint

        If x <> -1 Then pFeature.Value(x) = pPolyline.Length

        'UPDATE FEATURE
        If d > 0 Then
            pFeature.Store 
        Else
            pFeatureCursor.UpdateFeature pFeature 
        End If

        Set pFeature = pFeatureCursor.NextFeature
    Loop

    MsgBox "Done!"

End Sub

Private Sub GetSpatialReference(pFeatureLayer As IFeatureLayer, pSR As ISpatialReference)

       Dim pGeoLayer As IGeoDataset

       Set pGeoLayer = pFeatureLayer
       Set pSR = pGeoLayer.SpatialReference

End Sub