Le portail francophone de la géomatique

' 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 its 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