arenna

create polyline shapefile

Discussion created by arenna on Apr 12, 2011
Latest reply on Apr 12, 2011 by Hornbydd
hi,
i am trying to create a polyline shapefile in ArcMap using VBA. there is something wrong with my code, but i couldn't figure out how to solve it. when I try to run it, there is error says invalid pointer on the line that I've bold. hope someone can tell me what the real problem is.thank you.


Public Function CreatePolylineShapefile() As Boolean

        Dim pFeatureClass As IFeatureClass
        Dim pWorkspace As IWorkspace
        Dim pFeatureWorkSpace As IFeatureWorkspace
        Dim pWorkSpaceFactory As IWorkspaceFactory
        Dim MxDocument As IMxDocument
        Dim spatialReference As ISpatialReference
        Dim uid1 As New uid
        Const strShapeFieldName = "Shape"
       
        Set pWorkSpaceFactory = New ShapefileWorkspaceFactory
        Set pFeatureWorkSpace = pWorkSpaceFactory.OpenFromFile(savepath, 0)
   
       
        'create a new fields collection
        Dim pField As IField
        Dim pFields As IFields
        Dim pfieldEdit As IFieldEdit
        Dim pfieldsEdit As IFieldsEdit
        Set pFields = New Fields
        Set pfieldsEdit = pFields
       
       
        'create the map's spatial reference
        Set MxDocument = ThisDocument
       
        'need to modify this to BNG
        Set spatialReference = MxDocument.FocusMap.spatialReference
       
        'create a Z-aware geometry definition.
        'use the map's spatial reference
        Dim pGeomDef As IGeometryDef
        Dim pGeometryDefEdit As IGeometryDefEdit
        Set pGeomDef = New GeometryDef
        Set pGeometryDefEdit = pGeomDef
        'Set pfieldEdit.GeometryDef = pGeomDef

        Set pGeometryDefEdit = New GeometryDef
        With pGeometryDefEdit
            Set .spatialReference = spatialReference
            .GeometryType = esriGeometryPolyline
            .GridCount = 1
            .GridSize(0) = 100
            .HasZ = False
        End With
       
        'create geometry field
        Set pField = New Field
        Set pfieldEdit = pField
        pfieldEdit.Name = strShapeFieldName
        pfieldEdit.Type = esriFieldTypeGeometry
       
        'add geometry field to fields collection
        pfieldsEdit.AddField pField
       
        'create an integer field
        'shapefile require at least one attribute field
        Set pField = New Field
        Set pfieldEdit = pField
        pfieldEdit.Name = "Id"
        pfieldEdit.Type = esriFieldTypeInteger
       
        'add attribute field to field collection
        pfieldsEdit.AddField pField
       
        'add another miscellaneous text field
        Set pField = New Field
        Set pfieldEdit = pField
        With pfieldEdit
            .Length = 25
            .Name = "SomeID"
            .Type = esriFieldTypeString
        End With
       
        'add text field to fields collection
        pfieldsEdit.AddField pField
       
        'create the new shapefile
        'assumes there isnt' already a shapefile with this name in this location
        uid1.Value = "esriGeodatabase.Feature"

        Set pFeatureClass = pFeatureWorkSpace.CreateFeatureClass(savefile, pFields, uid1, Nothing, esriFTSimple, strShapeFieldName, "")
       
        MsgBox "shapefile created"
       
        Dim pPointCollection() As IPointCollection
        Dim pPoint As IPoint
        Dim pPolyline As IPolyline
        Dim pFeature As IFeature
       
        Set pFeature = pFeatureClass.CreateFeature
       
        Dim i As Integer
        Dim s() As String
        For i = 0 To UBound(s)
            Dim s2() As String
            s2 = Split(s(i), " ")
            x(i) = Val(s2(0))
            y(i) = Val(s2(1))
           Set pPoint = New Point
           pPoint.PutCoords x(i), y(i)
           Set pPointCollection(i) = pPoint
           Set pPointCollection(i) = New Polyline

           Set pPolyline = pPointCollection(i)
          
          
        Set pFeature.shape = pPolyline
        pFeature.Store
       
        Next
        MsgBox ("shapefile created")
       
        'display the shapefile in arcmap
        Dim pMxDocument As IMxDocument
        Dim pFeatureLayer As IFeatureLayer
        Dim pMap As IMap
       
        'create a new ShapefileWorkspaceFactory object and open a shapefile folder
        'create a new FeatureLayer and assign a shapefile to it
        Set pFeatureLayer = New FeatureLayer
        Set pFeatureLayer.featureClass = pFeatureClass
        pFeatureLayer.Name = pFeatureLayer.featureClass.AliasName
       
        'add the FeatureLayer to the focus map
        Set pMxDocument = Application.Document
        Set pMap = pMxDocument.FocusMap
        pMap.AddLayer pFeatureLayer
       
        pMap.MoveLayer pFeatureLayer, (pMxDocument.FocusMap.LayerCount)
        MsgBox ("done")
        UserForm1.Hide
       
       
errorhandler:
If Err.Number <> 5 Then
    MsgBox Err.Description
Else
    Resume Next

Outcomes