' PointCon.ave

' Condenses overlapping points and creates an attribute table with a
' one-to-many relationship via a user-specified relate field.
' Not intended for use in projected Views.

theView = av.GetActiveDoc
theFTab = theView.GetActiveThemes.Get(0).GetFTab
theTitle = "PointCon"
if (theFTab.GetShapeClass.GetClassName <> "Point") then
   MsgBox.Error("Not point FTheme",theTitle)
   return nil
end
shpname = FileName.GetCWD.MakeTMP("Theme","shp")
shpname = FileDialog.Put(shpname,"*.shp","Output Shapefile")
if (shpname = nil) then
   return nil
end
tabname = shpname.ReturnDir.MakeTMP("Pat","dbf")
tabname = FileDialog.Put(tabname,"*.dbf","Output Attribute List")
if (tabname = nil) then
   return nil
end
idname = MsgBox.Input("Name of relate field to create",theTitle,"point_id")
if (idname = nil) then
   return nil
end
if (theFTab.FindField(idname) <> nil) then
   MsgBox.Error("Field Exists.",theTitle)
   return nil
end
deftol = (theView.GetDisplay.ReturnExtent.GetHeight / 1000).AsString
deftol = MsgBox.Input("Overlap tolerance",theTitle,deftol)
if (deftol = nil) then
   return nil
end
tol = deftol.AsNumber

'**** create and define table structures

PShape = FTab.MakeNew(shpname, Point)
idf = Field.Make(idname,#FIELD_DECIMAL,11,0)
PShape.AddFields({idf.Clone})
PTab = VTab.MakeNew(tabname,dbase)
PTab_flist = List.Make
PTab_flist.Add(idf.Clone)
for each f in theFTab.GetFields
   if (f.IsTypeShape.Not) then
      PTab_flist.Add(f.Clone)
   end
end
PTab.AddFields(PTab_flist)
sf = theFTab.FindField("shape")
psf = PShape.FindField("shape")
pif = PShape.FindField(idname)
tif = PTab.FindField(idname)

'**** condense points and add record(s) as appropriate

av.ShowMsg("Building records...")
av.ClearStatus
rec = 1
numrec = theFTab.GetNumRecords
bm1 = BitMap.Make(numrec)
bm1.SetAll
for each r1 in theFTab
   p1 = theFTab.ReturnValue(sf,r1)
   theFTab.SelectByPoint(p1,tol,#VTAB_SELTYPE_NEW)
   bm2 = theFTab.GetSelection
   bm2.And(bm1)
   if (bm2.Count > 0) then

      '**** add shape record

      newRec1 = PShape.AddRecord
      PShape.SetValue(psf,newRec1,p1)
      PShape.SetValue(pif,newRec1,rec)

      '**** add relate records

      for each r2 in bm2
         newRec2 = PTab.AddRecord
         for each ff in theFTab.GetFields
            if (ff.IsTypeShape.Not) then
               val = theFTab.ReturnValue(ff,r2)
               f = PTab.FindField(ff.GetName)
               PTab.SetValue(f,newRec2,val)
            end
         end
         PTab.SetValue(tif,newRec2,rec)
         bm1.Clear(r2)
      end
   end
   rec = rec + 1
   av.SetStatus(rec / numrec * 100)
end
av.SetStatus(100)
av.ClearMsg
av.ClearStatus

theBitmap = theFTab.GetSelection
theBitmap.ClearAll
theFTab.UpdateSelection
PShape.Flush
PTab.Flush

'**** ask if add to View

if (MsgBox.YesNo("Add shapefile as theme to the view?",
    theTitle,true)) then
   fthm = FTheme.Make(PShape)
   theView.AddTheme(fthm)
   theView.GetWin.Activate
end