I'm running ArcView 9.2 and trying to populate an existing Personal Geodatabase with new feature classes for Points, Polylines and Polygons. I took an existing VBA code sample which came with my Arc installation and added Domain and Aware code for M and Z so I can create and store features with X,Y,Z,M data.
The following code is stripped down to just polyline features, in hope of at least getting Polylines to work. The command button PopulateEmptyGeoDatabase creates the TestPolylines class in the PGDB, then calls CreatePolylineFeatures to start creation of test data with random values. But when this reaches Set pFeature.Shape = pPointCollection, I get the error "The geometry has no Z values".
I did notice that for my TestPolylines class, the GDB_GeomColumns table contains values for ExtentLeft,Bottom,Right,Top and ZLow,ZHigh,MLow,MHigh and SRID which are different in another PGDB which has been successfully populated with polyline data with Z,M values.
Where have I gone wrong?
My code:
[start of code]
Private Sub cmdPopulateEmptyGeoDatabase_Click()
' Create the GeoDatabase using the name specified by the user
UserForm2.MousePointer = fmMousePointerHourGlass
DoEvents
Dim pWorkspace As IFeatureWorkspace
If (lblSelectedInputFile = "") Then
MsgBox "You must enter an input text file name.", vbExclamation + vbOKOnly, "No Name Entered"
GoTo CleanExit
End If
If (strSelectedGeoDatabase = "") Then
MsgBox "You must enter a database name.", vbExclamation + vbOKOnly, "No Name Entered"
GoTo CleanExit
End If
Dim pWorkspaceFactory As IWorkspaceFactory
Set pWorkspaceFactory = New AccessWorkspaceFactory
Dim pProperty As IPropertySet
Set pProperty = New PropertySet
Dim pWorkspaceName As IName
On Error GoTo ErrorPrint
Set pWorkspace = pWorkspaceFactory.OpenFromFile(strSelectedGeoDatabase, 0)
If (pWorkspace Is Nothing) Then GoTo CleanExit
' Start Editing the Database
Dim pWorkspaceEdit As IWorkspaceEdit
Set pWorkspaceEdit = pWorkspace
pWorkspaceEdit.StartEditing False
' Now create appropriate Feature Classes
Dim pPolylineClass As IFeatureClass
CreateFeatureClass pWorkspace, "TestPolylines", esriGeometryPolyline, pPolylineClass
' Now Create the point, line and polygon features
CreatePolylineFeatures pPolylineClass, 50
' Stop Editing
CleanExit:
UserForm2.MousePointer = fmMousePointerArrow
If (Not pWorkspace Is Nothing) Then
If (pWorkspaceEdit.IsBeingEdited) Then pWorkspaceEdit.StopEditing True
Set pWorkspaceEdit = Nothing
End If
If (Not pWorkspace Is Nothing) Then Set pWorkspace = Nothing
Exit Sub ' after exiting from this procedure, database lockfile disappears
ErrorPrint:
MsgBox Err.Description, vbExclamation + vbOKOnly, "Error Found"
Err.Clear
GoTo CleanExit
End Sub
Private Sub CreateFeatureClass(pFeatureWorkspace As IFeatureWorkspace, className As String, GeomType As esriGeometryType, pFeatureClass As IFeatureClass)
' Add the Fields to the class the OID and Shape are compulsory
Dim pFieldsEdit As IFieldsEdit
Set pFieldsEdit = New Fields
pFieldsEdit.FieldCount = 2
Dim pFieldEdit As IFieldEdit
Set pFieldEdit = New Field
With pFieldEdit
.name = "OID"
.Type = esriFieldTypeOID
.AliasName = "Object ID"
.IsNullable = False
End With
Set pFieldsEdit.Field(0) = pFieldEdit
Dim numPoints As Long
numPoints = 1
Select Case GeomType
Case esriGeometryPoint
numPoints = 1
Case esriGeometryPolyline
numPoints = 2
Case esriGeometryPolygon
numPoints = 4
End Select
' Assign the Spatial Reference
Dim pSR As ISpatialReference
Set pSR = New UnknownCoordinateSystem
pSR.SetDomain -450359962737.05, 450359962737.05, -450359962737.05, 450359962737.05
pSR.SetMDomain 0#, 10000000#
pSR.SetZDomain -100000, 100000
Dim pGeomDef As IGeometryDefEdit
Set pGeomDef = New GeometryDef
With pGeomDef
.AvgNumPoints = numPoints
.GeometryType = GeomType
.GridCount = 1
.GridSize(0) = 1000
.HasM = True
.HasZ = True
Set .SpatialReference = pSR
End With
Set pFieldEdit = New Field
With pFieldEdit
.name = "Shape"
.Type = esriFieldTypeGeometry
.IsNullable = True
.Editable = True
.AliasName = "Shape"
Set .GeometryDef = pGeomDef
End With
Set pFieldsEdit.Field(1) = pFieldEdit
Dim pUID As IUID
Set pUID = New UID
pUID.Value = "esriGeoDatabase.Feature"
Set pFeatureClass = pFeatureWorkspace.CreateFeatureClass(className, pFieldsEdit, pUID, Nothing, esriFTSimple, "Shape", "")
End Sub
Private Sub CreatePolylineFeatures(pFeatureClass As IFeatureClass, numberToCreate As Long)
If (numberToCreate = 0) Then Exit Sub
Dim i As Long
Dim pFeature As IFeature
Dim pPoint As IPoint
Dim pPointCollection As IPointCollection
Dim j As Long
Dim pMA As IMAware
Dim pZA As IZAware
For i = 1 To numberToCreate
Set pFeature = pFeatureClass.CreateFeature
Set pPointCollection = New Polyline
For j = 1 To Int(11 * Rnd)
Set pPoint = New Point
Set pMA = pPoint
Set pZA = pPoint
pMA.MAware = True
pZA.ZAware = True
pPoint.X = 1001 * Rnd
pPoint.Y = 1002 * Rnd
pPoint.Z = 5 * Rnd
pPoint.M = 6 * Rnd
pPointCollection.AddPoint pPoint
Next j
Set pFeature.Shape = pPointCollection
pFeature.Store
Next i
End Sub
[end of code]
Thanks,
Rob P