Le portail francophone de la géomatique

Ce script calcule les aires perimetre ou longeur

' Name: View.CalculateFeatureGeometry
'
' Title: Calculates feature geometry values
'
' Topics: GeoData
'
' Description: Calculates area and perimeter for polygon themes and length
' for line themes. If the View has been projected the calculations are in
' projected meters. Otherwise the calculations are in 'native' map units.
' Modify the script to provide calculation in the current report units of
' the View. The script processes the list of active themes to calculate
' area and perimeter, or length, depending on the theme type.
'
' The script will add the fields: Area and Perimeter to polygon themes, Length
' to line themes if they do not exist. If the fields exist their values will
' be recalculated. Rerun the script if you change the projection of the view.
'
' Requires: A View with at least one active theme. You must have write access
' to the active theme(s).
'
' Self:
'
' Returns:

'
' Get the view and it's projection if any.
'
theView = av.GetActiveDoc
thePrj = theView.GetProjection
if (thePrj.IsNull) then
hasPrj = false
else
hasPrj = true
end

'
' Get the list of active themes. if there aren't any, let the user know
' and exit.
'
theActivethemeList = theView.GetActivethemes
if (theActivethemeList.Count = 0) then
MsgBox.Error( No active themes. , )
Exit
end

'
' Loop through the list of active themes. if you can't edit the theme
' inform the user.
'
For Each thetheme in theActivethemeList
theFTab = thetheme.GetFTab
if (theFTab.CanEdit.Not) then
MsgBox.Info( Cannot edit table for theme: ++thetheme.AsString, )
Continue
end
'
' Make the FTAB editable, and find out which type of feature it is.
'
theFTab.SetEditable(TRUE)
theType = theFTab.FindField( shape ).GetType
if (theType = #FIELD_SHAPEPOLY) then
'
' if it's polygonal check for the existence of the fields Area and
' Perimeter. if they do not exist, create them.
'
if (theFTab.FindField( Area ) = nil) then
theAreaField = Field.Make( Area ,#FIELD_DOUBLE,16,3)
theFTab.AddFields({theAreaField})
else
ok = MsgBox.YesNo( Update Area? , Calculate , true)
if (ok.Not) then
continue
end

theAreaField = theFTab.FindField( Area )
end

if (theFTab.FindField( Perimeter ) = nil) then
thePerimeterField = Field.Make( Perimeter ,#FIELD_DOUBLE,16,3)
theFTab.AddFields({thePerimeterField})
else
ok = MsgBox.YesNo( Update Perimeter? , Calculate , true)
if (ok.Not) then
continue
end

thePerimeterField = theFTab.FindField( Perimeter )
end

'
' Loop through the FTAB and find the projected area and perimeter of each
' shape and set the field values appropriately.
'
theShape = theFTab.ReturnValue(theFTab.FindField( shape ),0)
For Each rec in theFTab
theFTab.QueryShape(rec,thePrj,theShape)

theArea = theShape.ReturnArea
thePerimeter = theShape.ReturnLength

theFTab.SetValue(theAreaField,rec,theArea)
theFTab.SetValue(thePerimeterField,rec,thePerimeter)
end

elseif (theType = #FIELD_SHAPELINE) then
'
' if the data source is linear, check for the existence of the
' field Length . if it doesn't exist, create it.
'
if (theFTab.FindField( Length ) = nil) then
theLengthField = Field.Make( Length ,#FIELD_DOUBLE,16,3)
theFTab.AddFields({theLengthField})

else
ok = MsgBox.YesNo( Update Length? , Calculate , true)
if (ok.Not) then
continue
end

theLengthField = theFTab.FindField( Length )
end

'
' Loop through the FTAB and find the projected length of each shape and set
' the field values appropriately.
'
theShape = theFTab.ReturnValue(theFTab.FindField( shape ),0)
For Each rec in theFTab
theFTab.QueryShape(rec,thePrj,theShape)

theLength = theShape.ReturnLength

theFTab.SetValue(theLengthField,rec,theLength)
end

end

theFTab.SetEditable(FALSE)
end