/3.2 (Extension.1 Name: "Africover extension" FirstRootClassName: "Script" Roots: 2 Roots: 3 Roots: 4 Roots: 5 Roots: 6 Roots: 7 Roots: 8 Roots: 9 Roots: 10 Roots: 11 Roots: 12 Roots: 13 Roots: 14 Roots: 15 Roots: 16 Roots: 17 Roots: 18 Roots: 19 Roots: 20 Roots: 21 Version: 32 About: "Africover extension:\nemail: info@africover.org\nArcview tools used at Africover" InstallScript: 22 UninstallScript: 23 ExtVersion: 1 ) (Script.2 Name: "ScanCode.Addxy" SourceCode: "'this script will add XY coordinates to point and polygon ArcView shapefiles, and point, polygon, and labelpoint themes of ARC/INFO coverages\n'with respect to ARC/INFO coverages, its effects should be identical to the ARC/INFO command \"ADDXY\", except that it will not work with node themes because of a bug in ArcView\n\ntheProject = av.GetProject\ntheView = av.GetActiveDoc\ntheThemes = theView.GetActiveThemes\n\nif (theThemes.count = 0) then\n Msgbox.info (\"Please select a theme first.\",\"Warning\")\nEnd\n\n\nfor each t heTheme in theThemes\n 'new fields will be double precision by default unless the theme is a single precision coverage\n doublePres = TRUE\n 'only FThemes have FTabs that may be altered\n if(theTheme.Is(FTheme).NOT) then\n MsgBox.Info(\"This theme is not an ARC/INFO coverage or an ArcView shapefile.\",\"Theme:\"++theTheme.GetName)\n continue\n end\n 'check to see if FTheme is editable\n if((theTheme.GetFTab.CanEdit).NOT) then\n MsgBox.Info(\"This theme cannot be edited.\",\"Theme:\"++theTheme.GetName)\n c ontinue\n end\n 'get the FTheme's FTab and check to see what type of ShapeClass it contains\n theFTab = theTheme.GetFTab\n theShapeClass = theFTab.GetShapeClass\n 'is it a coverage?\n if(Coverage.Exists(theTheme.GetSrcName.AsString)) then\n 'if so, find out if it's a point or polygon coverage, the only two we can work with\n theSubName = theTheme.GetSrcName.GetSubName\n if(((theSubName = \"point\") OR (theSubName = \"polygon\") OR (theSubName = \"labelpoint\") OR (theSubName = \"node\")).NOT) then\n' if(((t heSubName = \"point\") OR (theSubName = \"polygon\") OR (theSubName = \"labelpoint\")).NOT) then\n MsgBox.Info(\"This operation only works on points, polygons, labelpoints, and nodes.\",\"Theme:\"++theTheme.GetName)\n' MsgBox.Info(\"This operation only works on points, polygons, and labelpoints.\",\"Theme:\"++theTheme.GetName)\n continue\n else\n 'now that we know we have a coverage, see if it is single or double precision\n if(Coverage.IsDouble(theTheme.GetSrcName.AsString).NOT) then\n double Pres = FALSE\n else\n doublePres = TRUE\n end\n end\n 'find out whether it's a polygon coverage, so we can warn the user about the results\n if(theSubName = \"polygon\") then\n if(MsgBox.YesNo(\"Note, this will add the XY coordinates of the polygon's centroid, not its labelpoint. Do you wish to continue?\",\"Theme:\"++theTheme.GetName,TRUE).NOT) then\n continue\n end\n end\n if(theSubName = \"labelpoint\") then\n if(MsgBox.YesNo(\"Note, this will add the XY coordinates of t he polygon's labelpoint, not its centroid. Do you wish to continue?\",\"Theme:\"++theTheme.GetName,TRUE).NOT) then\n continue\n end\n end\n end\n \n 'capture the shape field for reference\n shapeField = theFTab.FindField(\"Shape\")\n 'create two new fields to the specifications of the ARC/INFO \"ADDXY\" command\n if(doublePres = TRUE) then\n xfield = Field.Make(\"X-coord\",#FIELD_FLOAT,18,5)\n yfield = Field.Make(\"Y-coord\",#FIELD_FLOAT,18,5)\n else\n xfield = Field.Make(\"X-coord\",#FIELD_FLOAT,12,3 )\n yfield = Field.Make(\"Y-coord\",#FIELD_FLOAT,12,3)\n end\n \n 'if the FTab is currently being edited, make a note so we don't close it later\n if(theFTab.IsEditable) then\n alreadyOpen = TRUE\n else\n alreadyOpen = FALSE\n end\n theFTab.SetEditable(TRUE)\n \n 'only add the new fields if they do not exist already\n if(theFTab.FindField(\"X-coord\") = NIL) then\n theFTab.AddFields({xfield})\n else\n xfield = theFTab.FindField(\"X-coord\")\n end\n if(theFTab.FindField(\"Y-coord\") = NIL) then\n theFTab .AddFields({yfield})\n else\n yfield = theFTab.FindField(\"Y-coord\")\n end\n \n for each record in theFTab\n theShape = theFTab.ReturnValue(shapefield,record)\n 'if shape is a point or node, grab its coordinates\n 'if shape is a polygon or multipoint (polygon's labelpoint), grab the coordinates of its centroid\n if(theFTab.GetShapeClass.GetClassName = \"point\") then\n x = theShape.GetX\n y = theShape.GetY\n else\n x = theShape.ReturnCenter.GetX\n y = theShape.ReturnCenter.GetY\n end\n theFTab.SetValue(xfield,record,x)\n theFTab.SetValue(yfield,record,y)\n end\n\n 'if the FTab was not being edited to begin with, close it \n if ((alreadyOpen = TRUE).NOT) then\n theFTab.SetEditable(FALSE)\n end\n \n 'open the table so folks can see the result\n if(theTheme.HasTable) then\n theTheme.EditTable\n end\nend\n\n\n" ) (Script.3 Name: "ScanCode.Append" SourceCode: "' Name: Table.Append\n'\n' Headline: Appends tables\n'\n' Self: \n'\n' Called by: (User is presented with a list of tables to \n' select for merging.)\n'\n' Returns: \n'\n' Description: Merges tables into a single table. A new table is created \n' that combines the attributes of the tables. The tables to \n' be merged need NOT have the same set of attributes (fields). \n' The union of a ll the visible fields found is used to \n' define the new table's structure. Where fields from \n' separate tables have the same alias and type but differ in \n' width or precision, the largest of the widths and precisions\n' is used in defining the output fields. One more field is\n' added to the output for identifying the source table of each\n' record.\n'\n' Topics: Table\n'\n' Search Keys: Table, merge, append\n'\n' Requires: \n'\n' History: \n' AV 3.2, 3 Jan 2000. Use only visible fields.\n' AV 3.1, 26 July 1999. Field type checking and resolution.\n' AV 3.0a. 11 Sep 1998.\n' William A. Huber @ Quantitative Decisions, Merion, PA.\n' mailto:whuber@QuantDec.com\n'\n' Comments: Originally was a modification of the mergeThemes script from \n' ESRI. However, as of the AV 3.2 version, there's essentially\n' nothing left of the original code.\n'\n' This script is not intended to merge themes into a shapefile.\n'============================================================================='\nstrTitle = \"Table.Append\"\n'.............................................................................'\n'\n' Find all tables in the project.\n'\nlstTables = {}\nfor each theDoc in av.GetProject.GetDocs\n if (theDoc.Is(Table)) then lstTables.Add(theDoc) end\nend\n\nif (lstTables.Count < 2) then\n MsgBox.Error(\"Must h ave at least two tables to append.\", strTitle)\n exit\nend\n'.............................................................................'\n'\n' Allow the user to choose tables to be merged.\n'\nlstTablesToAppend = {}\n'while (true)\n lstNew = MsgBox.MultiList (lstTables, \"Choose tables to append\", strTitle)\n if (lstNew = NIL) then \n 'break\n else\n lstTablesToAppend.Merge(lstNew)\n end\n'end\n\nif ((lstTablesToAppend = Nil) or (lstTablesToAppend.Count < 2)) then\n MsgBox.Error(\"Not enough tables to merge.\", s trTitle)\n exit\nend\n'.............................................................................'\n'\n' Specify the output table.\n'\nFNOut = av.GetProject.MakeFileName(\"table\", \"dbf\")\nFNOut = FileDialog.Put(FNOut, \"*.dbf\", \"Output Table\")\nif (FNOut = Nil) then\n exit\nend\n'.............................................................................'\n'\n' Construct a list of fields. This list will be the union\n' of all visible fields found in the tables. It is checked for type\n' mis-matches; errors are repor ted and cause the operation \n' not to complete. Otherwise, mismatches of length or precision\n' alone are resolved by choosing the widest lengths and precisions\n' found among matching fields.\n'\nlstStrFields = List.Make\n'\n' Dictionary entries are {field, table, error status}.\n' Keys are the field aliases.\n'\nFField = 0\nFTable = 1\nFStatus = 2\n\ndctFields = Dictionary.Make(lstTablesToAppend.Count * 10) ' Rough guess\nstrErrs = \"\" ' Accumulate all errors for display afterwards\nfor each t in lstTablesToAppend\n for each f in t.GetVTab.GetFields\n if (f.IsVisible.Not) then continue end\n if (f.IsTypeShape) then continue end\n \n s = f.GetAlias\n objG = dctFields.Get(s)\n if (objG = NIL) then\n dctFields.Add(s, {f.Clone,t,NIL})\n lstStrFields.Add(s)\n else\n '\n ' Compare field types.\n '\n g = objG.Get(FField)\n isMatch = false\n \n if (f.IsTypeNumber and g.IsTypeNumber) then\n p = f.GetPrecision max g.GetPrecision\n w = ((f.GetWidth - f.GetPrecision) max ( g.GetWidth - g.GetPrecision) + p) min 254\n if ((g.GetPrecision < p) or (g.GetWidth < w)) then\n if ((f.GetPrecision < p) or (f.GetWidth < w)) then\n f = Field.Make(s, g.GetType, w, p)\n else\n f = f.Clone\n end\n dctFields.Set(s, {f, t, NIL})\n end\n \n elseif (f.IsTypeString and g.IsTypeString) then\n if (f.GetWidth > g.GetWidth) then\n dctFields.Set(s, {f.Clone, t, NIL})\n end\n \n elseif (f.IsTypeShap e and g.IsTypeShape) then\n \n elseif (f.GetType = g.GetType) then\n \n else\n objG.Set(FStatus, true)\n strErrs = strErrs + NL +\n t.GetName + \"[\" + s + \"] is \" + f.GetType.AsString + \"; \" +\n objG.Get(1).GetName + \"[\" + s + \"] is \" + g.GetType.AsString\n end\n end \n end ' for each field f\nend ' for each table t\n\nif (strErrs <> \"\") then\n strErrs = \"Field mis-matches found: continue processing?\" + strErrs\n if (MsgBox.LongYesNo(strErrs, str Title).Not) then\n exit\n end\nend\n'.............................................................................'\n'\n' Find all fields whose status is good (NIL).\n'\nlstFields = {}\nfor each s in lstStrFields\n objS = dctFields.Get(s)\n if (objS.Get(FStatus) = NIL) then\n lstFields.Add(objS.Get(FField))\n end\nend\n'.............................................................................'\n'\n' Create the new VTab and \n' add fields that we've gathered from the input tables.\n'\nvtbMerge = VTab.MakeNew( FNOu t, dBase )\nif (lstFields.Count > 0) then\n vtbMerge.AddFields( lstFields )\nend\n'.............................................................................'\n'\n' Include one more field to track the source of each record.\n'\nfldFile = Field.Make(\"Table\", #FIELD_CHAR, 24, 0)\nvtbMerge.AddFields({fldFile})\n\ntheTable = Table.Make(vtbMerge)\ntheTable.SetName(FNOut.AsString)\n'.............................................................................'\n'\n' Populate the new VTab from the VTabs of the input tables.\n '\ncanIterate = true ' Manages a user break from the inner loop\nfor each t in lstTablesToAppend\n if (canIterate.Not) then break end\n \n av.SetStatus(0)\n av.ShowMsg( \"Appending\"++t.GetName )\n strName = t.GetName\n vtbIn = t.GetVTab\n\n 'if (vtbIn.GetSelection.Count = 0) then\n theRecordsToMerge = vtbIn\n numRecs = vtbIn.GetNumRecords\n 'else\n ' theRecordsToMerge = vtbIn.GetSelection\n ' numRecs = theRecordsToMerge.Count\n 'end\n '\n ' Construct a map from output fields to input fields.\n '\n lstFld Pairs = {}\n for each f in vtbMerge.GetFields\n g = vtbIn.FindField(f.GetAlias)\n if (g <> NIL) then\n lstFldPairs.Add({f,g})\n end\n end\n '\n ' Append the records.\n '\n for each rec in theRecordsToMerge \n if(av.SetStatus( (rec / numRecs) * 100 ).not) then \n canIterate = false\n break\n end\n \n newRec = vtbMerge.AddRecord ' Appends a new blank record\n for each fg in lstFldPairs ' Copies field values from the input record\n objValue = vtbIn.ReturnValue( fg.Get(1), rec )\n vtbMerge.SetValue( fg.Get(0), newRec, objValue )\n end \n \n ' Identify the source table for this record: \n vtbMerge.SetValue(fldFile, newRec, strName) \n end ' for each rec\nend ' for each t\n'.............................................................................'\n'\n' Clean up.\n'\nvtbMerge.SetEditable(false)\nav.ClearMsg\nav.ClearStatus\ntheTable.GetWin.Activate\n' end of script\n\n\n\n\n" ) (Script.4 Name: "ScanCode.autoid" SourceCode: "'M.R. Binkley\n'Davey Resource Group\n'1500 N. Mantua St.\n'Kent OH 44240\n'\n'email bugs to:\n'mbinkley@davey.com\n'mr_binkley@yahoo.com\n'\n'created: 03/10/99\n'\n'---------------------------------------\n'AutoID\n'---------------------------------------\n'Open this script in a script document\n'and compile it with the check button.\n'\n'Make your table active (click on it),\n'make the script active and run it.\n'\n'A sequential, numeric ID will be added\n'to each record, starting with 1. You can\n'add a prefix, suffix, or bot h to the ID.\n'(note: with a non-numeric prefix or suffix, \n'the new field will be character type.)\n'---------------------------------------\n'\ntheTable = av.getActiveDoc\ntheCurrentActiveFld = theTable.GetActiveField \ntheVtab = av.getActiveDoc.getVtab\n\n'Set table editable; if it can't be, halt script now\nIf (theVtab.CanEdit.Not) Then\n MsgBox.Error(\"The table can not be edited.\",\"\")\n Return Nil\nElse\n theVtab.SetEditable(true)\nEnd\n\n'If table is not editable, then halt script now\nIf (theVTab.Iseditable. Not) Then\n MsgBox.Error(\"The table is no longer editable.\",\"\")\n Return Nil\nEnd\n\n\npre_suf = false\n\nIf (pre_suf) then\nlabels = { \"Prefix:\", \"Suffix:\" }\ndefaults = { \" \", \" \" }\nthePreSufList = MsgBox.MultiInput( \"Click Cancel to exit. Add prefix, suffix or both.\", \"Auto_ID Records\", labels, defaults )\n If (thePreSufList.count = 0) then\n return nil\n Else\n If (thePreSufList.Get(0)<> \" \") then\n thePrefix = (thePreSufList.Get(0).trim)\n else\n thePrefix = nil\n End\n If (thePreSufList. Get(1)<> \" \") then\n theSuffix = (thePreSufList.Get(1).trim)\n else\n theSuffix = nil\n End \n End\nEnd\n\nIf (pre_suf) then\n If (thePrefix <> nil) then\n If (thePrefix.isnumber.not) then\n thePreIsChar = true\n else\n thePreIschar = false\n end\n elseif (thePrefix = nil) then\n thePreIsChar = false\n end\n If (theSuffix <> nil) then\n If (theSuffix.isnumber.not) then\n theSufIsChar = true\n else\n theSufIsChar = false\n end\n elseif (theSuffix = nil) then\n th eSufIsChar = false\n end\n If ((thePreIsChar) or (theSufIsChar)) then \n theFld = Field.Make (\"Auto_ID\", #FIELD_CHAR, 25, 0)\n If (theFld <> NIL) then\n theTable.GetVTab.AddFields({theFld})\n theTable.SetActiveField(theFld)\n End\n theCount = 1\n For each rec in theVtab\n progress = (theCount/theVtab.GetNumRecords) * 100\n doMore = av.SetStatus( progress )\n If ((thePrefix <> nil) and (theSuffix <> nil)) then\n 'theValue = theVtab.SetValue(theFld,rec, theCount)\n theValue = thePrefix.AsString+theCount.AsString+theSuffix.AsString\n elseif ((thePrefix <> nil) and (theSuffix = nil)) then\n theValue = thePrefix.AsString+theCount.AsString\n elseif ((thePrefix = nil) and (theSuffix <> nil)) then\n theValue = theCount.AsString+theSuffix.AsString\n elseif ((thePrefix = nil) and (theSuffix = nil)) then\n theValue = theCount\n end\n theVtab.SetValue(theFld,rec, theValue.AsString)\n av.ShowMsg(\"Adding ID: \"+theValue.AsString)\n theCount = theCount + 1\n End\n Else\n theFld = Field.Make (\"Auto_ID\", #FIELD_DOUBLE, 25, 0)\n If (theFld <> NIL) then\n theTable.GetVTab.AddFields({theFld})\n theTable.SetActiveField(theFld)\n End\n theCount = 1\n For each rec in theVtab\n progress = (theCount/theVtab.GetNumRecords) * 100\n doMore = av.SetStatus( progress )\n If ((thePrefix <> nil) and (theSuffix <> nil)) then\n 'theValue = theVtab.SetValue(theFld,rec, theCount)\n theValue = thePrefix.AsString +theCount.AsString+theSuffix.AsString\n elseif ((thePrefix <> nil) and (theSuffix = nil)) then\n theValue = thePrefix.AsString+theCount.AsString\n elseif ((thePrefix = nil) and (theSuffix <> nil)) then\n theValue = theCount.AsString+theSuffix.AsString\n elseif ((thePrefix = nil) and (theSuffix = nil)) then\n theValue = theCount\n end\n theVtab.SetValue(theFld,rec, theValue.AsNumber)\n av.ShowMsg(\"Adding ID: \"+theValue.AsString)\n theCount = theCount + 1\n E nd\n End\n 'End\nElse\n theFld = Field.Make (\"Auto_ID\", #FIELD_DOUBLE, 25, 0)\n If (theFld <> NIL) then\n theTable.GetVTab.AddFields({theFld})\n theTable.SetActiveField(theFld)\n End\n theCount = 1\n For each rec in theVtab\n progress = (theCount/theVtab.GetNumRecords) * 100\n doMore = av.SetStatus( progress )\n theVtab.SetValue(theFld,rec, theCount)\n av.ShowMsg(\"Adding ID: \"+theCount.AsString)\n theCount = theCount + 1\n End\nEnd\n\nIf (theCurrentActiveFld <> nil) then \n theTable.SetActiveField(theCurrentActiveFld)\nEnd\n\ntheTable.getwin.Invalidate\ntheTable.StopEditing\ntheVtab.SetEditable(False)\ntheVtab.Flush\n\n\n" ) (Script.5 Name: "ScanCode.BorderPoly" SourceCode: "'ScanCode.Borderpolygons\n'By Edgar Okioga\n'On 20/11/2000\n'Rewritten by Harold Weepener 13-05-2002\n'Purpose: To approximate the number of bordering polygons on a selected polygon\n'A bordering polygon is one where two or more points are shared by adjacent polygons with the\n'same attribute label.\n\n'Get the active document and check if it is a view\ntheDoc = av.getActiveDoc\nif (theDoc.is(View).not) then\n Msgbox.info(\"Can only work with a view\",\"Aborting\")\n Return nil\nend \nViewName = theDoc.GetName\n\nif (theDoc. GetActiveThemes.count = 0) then\n msgbox.info(\"Please select a theme first.\", \"Info\") \n return nil\nend\n\n\n'Get theme that is currently active\nif (theDoc.GetActiveThemes.Count = 0) then\n Msgbox.info(\"No Theme in View!\", \"Aborting\")\n Return nil\nend\n\ntheTheme = theDoc.GetActiveThemes.Get(0)\n_themeName = theTheme.GetNAme\n'if the theme is nil, return an error and exit now!\nif (theTheme = Nil) then\n Msgbox.Error(\"Cannot Process! Theme Error\",\"Aborting\")\n Return Nil\nend\n\n'Get the FTab of the View\ntheFTab = the Theme.GetFTab\n\n'Check to see if it exists\nif (theFTab = Nil) then\n Msgbox.Error(\"Cannot get the Feature Table of the View! Theme Error\", \"Aborting\")\n Return nil\nend\n\n'Get the feature class of the FTab. If it is not polygon. then exit now!\nshapeClass = theFTab.GetShapeClass\nif (shapeClass.GetClassName <> \"Polygon\") then\n Msgbox.info(\"Cannot Process non polygon theme!\", \"Aborting\")\n Return nil\nend\n\ntheFieldList = theftab.GetFields\nif (theFieldList = Nil) then\n Msgbox.Info(\"Will not continue! No fields\",\" Aborting\")\n Return Nil\nend\n\n'Get the label field to use in the report generation\ntheLabelField=Msgbox.List(theFieldList,\"Select the polygon label Field.\", \"Polygon label\")\n\nif (theLabelField = Nil) then\n Return Nil\nend\n\nif (theLabelField.GetType <> #FIELD_CHAR) then\n Msgbox.Info(\"Only fields of type Sting are supported.\",\"Aborting\")\n Return Nil\nend\n\n\n\n WasBeingEdited = theFTab.IsBeingEditedWithRecovery \n\n If (WasBeingEdited = False ) then\n theFTab.SetEditable(True)\n end\n\n\n\nlabelfieldname = theLabelFie ld.GetName \nBPFieldname = \"XXBP\"\nBPField = theFTab.findfield(BPFieldname)\nif (BPField = NIL) then \n BPField = Field.Make (BPFieldname, #FIELD_BYTE, 1, 0)\n theFTab.addfields({BPField})\nelse\n theFTab.GetSelection.ClearAll\n theFTab.UpdateSelection \n theFTab.Calculate(\"0\", BPField) \n \nend\n\n\n'Loop thru the whole FTab and query for the intersection\nCount = 0\nfor each fRecord in theFtab\n queryItems = \"\"\n Count = Count + 1\n theFTab.GetSelection.ClearAll\n theFTab.UpdateSelection\n\n theFtab.getSelection.S et(fRecord)\n theFtab.UpdateSelection\n\n\n label0 = theFtab.REturnValue(theLabelField,fRecord)\n \n 'We have the correct theme and the class of the theme\n theFTab.SelectByFTab(theFtab, #FTAB_RELTYPE_INTERSECTS, 0,#VTAB_SELTYPE_NEW)\n theFTab.UpdateSelection \n theQuery = \"[\" + labelfieldname + \"] = \" + label0.asstring.Quote\n theBitmap = theFTab.GetSelection\n theFTab.Query(theQuery, theBitmap, #VTAB_SELTYPE_AND) \n theFTab.SetSelection (theBitmap)\n theFTab.UpdateSelection\n \n if (theFTab.GetSelectio n.count > 1) then\n theFTab.Calculate(\"1\", BPField)\n end\n \nend\n \ntheQuery = \"[\" + BPFieldname + \" ] = 1 \" \ntheBitmap = theFTab.GetSelection\ntheFTab.Query(theQuery, theBitmap, #VTAB_SELTYPE_NEW) \ntheFTab.UpdateSelection\ntheFTab.RemoveFields ({BPField})\n\n\nIf (WasBeingEdited = False ) then\n theFTab.SetEditable(False)\nend\n\n \n" ) (Script.6 Name: "ScanCode.centroid" SourceCode: "'this script will create a point shapefile with the centroids.\n\ntheProject = av.GetProject\ntheView = av.GetActiveDoc\ntheThemes = theView.GetActiveThemes\n\nif (theThemes.count = 0) then\n Msgbox.info (\"Please select a theme first.\",\"Warning\")\nEnd\n\nfor each theTheme in theThemes\n 'only FThemes have FTabs that may be altered\n if(theTheme.Is(FTheme).NOT) then\n MsgBox.Info(\"This theme is not an ARC/INFO coverage or an ArcView shapefile.\",\"Theme:\"++theTheme.GetName)\n continue\n end\n \n 'Create the point s hapefile\n def = av.GetProject.MakeFileName(\"z\" + theTheme.GetName, \"shp\")\n theFN = FileDialog.Put(def, \"*.shp\", \"Point shapefile\")\n if ( theFN = NIL ) then\n return FALSE\n end\n\n\n pnttbl = FTab.MakeNew(theFN, Point)\n if (pnttbl.HasError) then\n if (pnttbl.HasLockError) then\n MsgBox.Error(\"Unable to acquire Write Lock for file \" + def.GetBaseName, \"\")\n else\n MsgBox.Error(\"Unable to create \" + def.GetBaseName, \"\")\n end\n return nil\n end\n fld = Field.Make(\"ID\", #FIELD_DECIMAL , 8, 0)\n fld.SetVisible( TRUE )\n pnttbl.AddFields({fld})\n pnttbl.SetEditable(False)\n\n 'get the FTheme's FTab and check to see what type of ShapeClass it contains\n theFTab = theTheme.GetFTab\n theShapeClass = theFTab.GetShapeClass\n 'is it a coverage?\n if(Coverage.Exists(theTheme.GetSrcName.AsString)) then\n 'if so, find out if it's a point or polygon coverage, the only two we can work with\n theSubName = theTheme.GetSrcName.GetSubName\n if(((theSubName = \"point\") OR (theSubName = \"polygon\") OR ( theSubName = \"labelpoint\") OR (theSubName = \"node\")).NOT) then\n MsgBox.Info(\"This operation only works on points, polygons, labelpoints, and nodes.\",\"Theme:\"++theTheme.GetName)\n continue \n end\n end\n \n 'capture the shape field for reference\n shapeField = pnttbl.FindField(\"Shape\")\n \n pnttbl.SetEditable(True)\n \n for each record in theFTab\n theShape = theFTab.ReturnValue(shapefield,record)\n 'if shape is a point or node, grab its coordinates\n 'if shape is a polygon or multipoi nt (polygon's labelpoint), grab the coordinates of its centroid\n if(theFTab.GetShapeClass.GetClassName = \"point\") then\n x = theShape.GetX\n y = theShape.GetY\n else\n x = theShape.ReturnCenter.GetX\n y = theShape.ReturnCenter.GetY\n end\n NewPoint = Point.make(X,Y)\n NewRecord = pnttbl.AddRecord \n pnttbl.SetValue(shapeField,NewRecord,NewPoint)\n end\n pnttbl.SetEditable(False)\n theFTab.SetEditable(FALSE)\n \n theTheme = FTheme.Make(pnttbl)\n theView.AddTheme(theTheme)\nend\n \n\n" ) (Script.7 Name: "ScanCode.clip" SourceCode: "' 19-04-2002\n' Harold Weepener\n' \n' A script from the Geoprocessing Wizzard was edited.\n' All polygons in the clip file will be used one after the other to clip\n\n\ntheview = av.GetActiveDoc\n\n'get the themes\ntheThemes = theView.GetThemes \n\n'Check if we have the right number of themes\nif(thethemes.Count < 2) then\n Msgbox.info(\"Need 2 themes!\",\"Aborting\")\n Return nil\nend\n\nToClipTheme = MsgBox.Choice (thethemes, \"Please select the theme to be clipped\", \"Theme 1\")\n\nif(ToClipTheme = NIL) then\n Return nil\nend\n\n \nToClip = ToClipTheme.GetName\n\nthemenames = list.make\nfor each thme in thethemes\n if (thme.GetFtab.GetShapeClass.GetClassName = \"Polygon\") then\n if (thme.getname <> ToClip) then\n themenames.add(thme.getname)\n end\n end\nend\n\nif(themenames.Count = 0) then\n Msgbox.info(\"No more polygon themes!\",\"Aborting\")\n Return nil\nend\n\n\nClipWith = MsgBox.ChoiceAsString (themenames, \"Please select the theme to clip with\", \"Theme 2\")\n\nif (ClipWith = Nil) then\n return nil\nend\n\n\nstrFields = List.Make\nAllFields = theView.FindTheme(ClipWith).GetFtab.GetFields\n\nstrFields = List.Make\n\nFor each Fielditem in AllFields\n if(Fielditem.GetName <> \"Shape\") then\n strFields.Add(FieldItem)\n end\nend\n\n\ntmpfield = MsgBox.listasstring(strFields, \"Choose the field to be used for filenames\",\"\")\n\ntmpfieldname = tmpfield.getname\n\nlabels = { \"Prefix\", \"Suffix\"} \ndefaults = { \"xx\",\"xx\" } \ninputs = MsgBox.MultiInput( \"\", \"Leave prefix and suffix as xx if you do not need a prefix or suffix\", labels, defaults )\nif (inputs.count = 0) then\n return nil\nend\n \nnameprefix = inputs.get(0) \nnamesuffix = inputs.get(1) \nselectToClip = false \nselectClipWith = true \n\n'ToClip = Msgbox.Input ( \"File to be clipped:\", \"Name\", \"\" ) \n'ClipWith = Msgbox.Input ( \"File used to clip:\", \"Name\", \"\" ) \n'tmpflieldname = Msgbox.Input ( \"Name of field for names of output files:\", \"File used to clip\", \"\" ) \n'selectToClip = false \n'selectClipWith = true \n\ntmpftab = theView.FindTheme(ClipWi th).getftab\nthebitmap = tmpftab.getselection\nthebitmap.setall\n\nnrrec = thebitmap.count\nthebitmap.clearall\n\n\n\n\nfor each therec in 0..(nrrec-1)\n\n\nintheme1 = ToClip \nintheme2 = ClipWith \nfieldname = tmpfieldname \nselect1 = selectToClip \nselect2 = selectClipWith \n\n\n\ntmpftab = theView.FindTheme(intheme2).getftab\nthebitmap = tmpftab.getselection\nthebitmap.clearall\nthebitmap.set(therec)\ntmpftab.SetSelection (thebitmap)\n\nthefield = tmpftab.findfield(fieldname)\nthename = namep refix + tmpftab.ReturnValue (thefield, therec).asstring + namesuffix\n\nthename = thename.substitute(\"xx\",\"\")\n\noutFName = thename.AsFileName ' GPR.FindByName(\"ClipSrc\").GetText.AsFileName\n\n\n\n\n\n'''''''''''''''''''' New code to fix file error Begin\nif (outFName.asstring.contains(\".\")) then\n outFName=outFName.asstring.Substitute(\".shp\",\"\")\n outFName=outFName.asstring.Substitute(\".\",\"\")\n outFName=outFName.asstring+\".shp\" \n outFName=outFName.asfilename\nend\nif (outFName.getextension= \"\") then\n outFName.se textension(\"shp\")\nend\n'''''''''''''''''''' New code to fix file error end\n\n\nif ((theview.findtheme(intheme2)=NIL) or (theview.findtheme(intheme1)=NIL)) then\n msgbox.error(\"At least one theme is not selected\",\"Error\")\n return(false)\nend\n\n'geowait=av.finddialog(\"GeoWait\")\n'geowait.findbyname(\"changeme\").setlabel(\"Clipping 2 themes\")\n'geowait.open\n\nftab1 = theView.FindTheme(intheme1).getftab\nftab1shpField=ftab1.findfield(\"shape\")\nif (select1) then\n ftab1records = ftab1.getselection\n nrecords=ftab1.GetNumSe lRecords\nelse\n ftab1records = ftab1\n nrecords=ftab1.GetNumRecords\nend\n\nftab2 = theView.FindTheme(intheme2).getftab\nftab2shpField=ftab2.findfield(\"shape\")\nif (select2) then\n ftab2records = ftab2.getselection\n nrecords2=ftab2.GetNumSelRecords\nelse\n ftab2records = ftab2\n nrecords2=ftab2.GetNumRecords\nend\n\n\naFilename=\"$HOME\".asfilename.MakeTmp (\"tmp\", \"shp\")\n\nftab22=FTab.MakeNew( aFilename, POLYGON )\ntempfield={Field.Make (\"c\", #FIELD_SHORT, 2, 0)}\nftab22.AddFields( tempfield )\nftab22.seteditable(false)\nf tab22.seteditable(TRUE)\n\nftab22shpField=ftab22.findfield(\"shape\")\nftab22cField=ftab22.findfield(\"c\")\ncount=0\nfor each arec in ftab2records\n count=count+1\n av.showmsg(\"processing overlay shapes on\"++count.asstring++\"of\"++nrecords2.asstring)\n test=av.SetWorkingStatus\n av.showstopbutton\n if (test=FALSE) then\n ' geowait=av.finddialog(\"GeoWait\")\n ' geowait.close\n return(nil)\n end\n\n ashp=ftab2.returnvalue(ftab2shpfield,arec)\n x=ftab22.addrecord\n ftab22.setvalue(ftab22shpField,x,ashp)\n ftab22.setv alue(ftab22cField,x,1)\nend\nftab22.seteditable(false)\n\n\nftab2=ftab22\nftab2records=ftab2\nftab2shpField=ftab2.findfield(\"shape\")\nftab2cField=ftab2.findfield(\"c\")\nnrecords2=ftab2.getnumrecords \nintheme2 = FTheme.Make(ftab2)\ntheview.addtheme(intheme2)\n\n\notheme=intheme2\n\n\n \nshapeType = ftab1shpField.GetType\n\nif (shapeType = #FIELD_SHAPELINE) then \n outClass = POLYLINE\nelseif (shapeType = #FIELD_SHAPEMULTIPOINT) then\n outClass = MULTIPOINT\nelseif (shapeType = #FIELD_SHAPEPOINT) then\n outClass = POINT\nelseif (shapeType = #FIELD_SHAPEPOLY) then\n outClass = POLYGON\nelse\n MsgBox.Error(\"Invalid shape field type.\", \"Clip Themes\")\n 'geowait.close\n return nil\nend\n\nOutputFTab = FTab.MakeNew( outFName, outClass )\n\ntheme1Fields = {}\ntheme2Fields = {}\n\nfor each f in ftab1.GetFields\n if (f.GetName <> \"Shape\") then\n fCopy = f.Clone\n theme1Fields.Add(fCopy)\n end\nend\n\nif (theme1Fields.Count > 0) then\n OutputFTab.AddFields( theme1Fields )\nend\n\noutshpfld = OutputFtab.findfield(\"Shape\")\n\nftab1_oldselection = ftab1.g etselection.clone\n\n\nOutputFtab.SetEditable(False)\n\n\nacount=0\nftab1_oldselection = ftab1.GetSelection.Clone\n\n\nif (select1.not) then\n '** Select the features of intheme1\n theView.FindTheme(intheme1).SelectByTheme (intheme2, #FTAB_RELTYPE_INTERSECTS, 0, #VTAB_SELTYPE_NEW )\n ftab1.updateselection\n ftab1records = ftab1.getselection\n nrecords = ftab1.getnumselrecords\nelseif (select1) then\n '** Select the features of intheme1 from the currently selected set\n theView.FindTheme(intheme1).SelectByTheme (inthem e2, #FTAB_RELTYPE_INTERSECTS, 0, #VTAB_SELTYPE_AND )\n ftab1.updateselection\n ftab1records = ftab1.getselection\n nrecords = ftab1.getnumselrecords\nend\n\naFilename2=\"$HOME\".asfilename.MakeTmp (\"tmp\", \"shp\")\nnewFTab = FTab2.Summarize( aFilename2, Shape, ftab2cfield,{ftab2shpfield},{#VTAB_SUMMARY_AVG})\nnewFTab.CreateIndex( newFTab.FindField( \"Shape\" )) \nftab2=nil\nftab2=newftab\nnewftab=nil\nftab2records=ftab2\nftab2shpField=ftab2.findfield(\"shape\")\nnrecords2=ftab2.getnumrecords \ntheview.deletetheme(intheme2)\ni ntheme2 = FTheme.Make(ftab2)\ntheview.addtheme(intheme2)\nselectedshape=ftab2.returnvalue(ftab2shpField,0)\n\nOutputFtab.seteditable(True)\n\nacount=0 'A counter variable\nfor each aFtab1record in ftab1records\n acount=acount+1\n av.showmsg(\"Splitting Shapes. On shape\"++acount.asstring++\" of\"++nrecords.asstring)\n test=av.SetStatus(acount/nrecords * 100)\n av.showstopbutton\n if (test=FALSE) then\n ' geowait=av.finddialog(\"GeoWait\")\n ' geowait.close\n return(nil)\n end\n theSRCshape = ftab1.returnvalue(ft ab1shpField,aFtab1record)\n' if (select2) then\n' ftab2.setselection(ftab2_oldselection)\n' ftab2.updateselection\n' seltype=#VTAB_SELTYPE_AND \n' else\n seltype=#VTAB_SELTYPE_NEW\n' end\n if (theView.getprojection.isNull) then\n intheme2.SelectbyShapes({theSRCshape}, seltype)\n else\n pshp=theSRCShape.returnProjected(theView.getprojection)\n intheme2.SelectbyShapes({pshp}, seltype)\n end\n\n recordcount = 0 \n' for each Selrec in ftab2.getselection\n recordcount=recordcount +1\n' Sele ctedShape = biginshp\n' ftab2.returnvalue(ftab2shpField,Selrec)\n if (outshpfld.getType = #FIELD_SHAPELINE) then\n if (SelectedShape.iscontainedin(theSRCShape)) then\n alineshp1 = SelectedShape\n else 'Else split the line using the polygon\n alineshp1 = theSRCshape.LineIntersection(SelectedShape)\n end \n for each alineshp in alineshp1.explode\n theoutrec=outputftab.addrecord\n outputFtab.SetValue(outshpfld,theoutrec,alineshp) \n for e ach afield in theme1Fields\n oldfield=ftab1.findfield(afield.getname)\n if (oldfield<>NIL) then \n oldvalue=ftab1.returnvalue(oldfield,aFtab1record)\n outputftab.setValue(afield, theoutrec, oldvalue)\n end\n end\n end\n elseif(outshpfld.getType = #FIELD_SHAPEPOLY) then\n shpIntersect1 = theSRCshape.ReturnIntersection(SelectedShape) \n if (shpintersect1.isempty) then \n continue \n end\n for each shpIntersect in shpInterse ct1.explode\n theoutrec=outputftab.addrecord\n outputFtab.SetValue(outshpfld,theoutrec,shpIntersect)\n for each afield in theme1Fields\n oldfield=ftab1.findfield((afield.getname))\n if (oldfield<>NIL) then \n oldvalue=ftab1.returnvalue(oldfield,aFtab1record)\n outputftab.setValue(afield, theoutrec, oldvalue)\n end\n end \n end\n else\n if (theSRCshape.IsContainedIn(SelectedShape) ) then \n theoutrec=outputfta b.addrecord\n outputFtab.SetValue(outshpfld,theoutrec,theSRCshape)\n for each afield in theme1Fields\n oldfield=ftab1.findfield((afield.getname))\n if (oldfield<>NIL) then \n oldvalue=ftab1.returnvalue(oldfield,aFtab1record)\n outputftab.setValue(afield, theoutrec, oldvalue)\n end\n end \n end\n end 'if its poly or line\n' end 'end for each selected record in the table2\nend 'ends the for each record in the table1\n\nOutputftab.setedit able(false)\n\n\n'----------------------------------------------------------\n' Reset the initial selection\n'----------------------------------------------------------\ntheview.deletetheme(otheme)\ntheview.deletetheme(intheme2)\n\nftab2.deactivate\nftab22.deactivate\n\notheme=nil\nintheme2=nil\nftab22=nil\ntempfield=nil\nnewftab=nil\nftab22shpField=nil\nftab22cField=nil\nftab2=nil\nftab2shpField=NIL\nftab2records=NIL\n\nav.purgeobjects\nav.purgeobjects\n\n\n\nftab1.setselection(ftab1_oldselection)\nftab1.updateselection\n\nif (OutPutFTa b.GetNumRecords = 0) then\n Msgbox.info(\"No features were clipped for polygon \"+ thename + \" Aborting ... \",\"\")\n return nil\nend\n\n\ntheNewTheme = FTheme.Make( OutputFTab )\ntheView.AddTheme( theNewTheme )\nSelectedShape=nil\n\n'geowait.close\nav.clearstatus\nav.purgeobjects\n\nif (file.canDelete(aFilename)) then\n file.delete(aFileName)\nend\nif (file.canDelete(aFilename2)) then\n file.delete(aFileName2)\nend\n\n\nend 'for each therec\n\n\n" ) (Script.8 Name: "ScanCode.describe" SourceCode: "'Name: \"SCANCODE.DESCRIBE\"\n'CreationDate: \"28 May 2001 10:03:34\"\n'Source: \"'By Edgar Okioga\n'To Give the positional Occurance of all the codes in a country\n'28/05/2001\n\n'Purpose: For each code in a database (country), we want to find the positional occurance of various codes\n' this is because, some codes cannot be found as the first entry , middle or l;ast respectively.\n\n'Method:\n'A result table is created with four columns CODE, POS1, POS2, POS3\n'Starting with the code1, thru code3, get the the code, if no r found, add the code and add \n'the positoin as need be staring with the current location\n\ntheFldTable = av.getActiveDoc\nif (theFldtable.is(Table).Not) then\n Return Nil\nend\n\n\ntheTable = theFldtable.GetVTab\n\nfor each fld in {\"Code1\",\"Code2\",\"Code3\" } \n if (theTable.FindField(fld) = Nil) then\n Msgbox.info(\"Please run the Recalculate command first\", \"Error\")\n Return Nil\n end\nend\n\n'obtain the codes we need\nfldCode1 = theTable.FindField(\"Code1\")\nfldCode2 = thetable.FindField(\"Code2\")\nfldCode3 = theTable.FindF ield(\"Code3\")\n\n'Create a table to write the information to\n'Make a fileName for the result\n\nsDirName = av.getproject.getworkdir\nsFileName = sDirName.MakeTmp (\"Des\", \"dbf\")\n\n'Create the Vtab (result table)\nResultTable = VTab.MakeNew (sFileName, DBASE)\n\nif (VTab.CanMake(sFileName)) then\n ResultTable = VTab.Make (sFileName, True, False)\nelse\n Msgbox.Error(\"Cannot Create Result File\",\"Aborting\")\n Return Nil\nend\n\n'Add the fields to the VTab\nResultTable.AddFields({Field.Make(\"Code\",#FIELD_CHAR ,40,0)})\nResultT able.AddFields({Field.Make(\"Code1\",#FIELD_DECIMAL ,6,0)})\nResultTable.AddFields({Field.Make(\"Code2\",#FIELD_DECIMAL ,6,0)})\nResultTable.AddFields({Field.Make(\"Code3\",#FIELD_DECIMAL ,6,0)})\n\n'Create variables for the fields\nfldTCode = ResultTable.FindField(\"Code\")\n\n\n'The table has been created. Now set the index of the table to Code for fast search and update\nResultTable.CreateIndex(fldTCode)\ntheTable.GetSelection.ClearAll\n'Summarise the tables\ntemp1 = sDirName.MakeTmp(\"code1\",\"dbf\")\ntemp2 = sDirName.MakeTmp( \"code2\",\"dbf\")\ntemp3 = sDirName.MakeTmp(\"code3\",\"dbf\")\n\nvCode1 = theTable.Summarize(temp1,dBAse,fldCode1,{fldCode1},{#VTAB_SUMMARY_COUNT})\nvCode2 = theTable.Summarize(temp2 ,dBAse,fldCode2,{fldCode2},{#VTAB_SUMMARY_COUNT})\nvCode3 = theTable.Summarize(temp3 ,dBAse,fldCode3,{fldCode3},{#VTAB_SUMMARY_COUNT})\n\nDataList = {vcode1, vcode2, vcode3}\n'Loop thru each record of the data and update\nFor Each DataSet in DataList\n CodeFld = DataSet.FindField(DataSet.GetName.Middle(0,5))\n CountFld = DataSet.FindField(\"Co unt\")\n ResultFld = ResultTable.FindField(DataSet.GetName.Middle(0,5))\n For Each rec in DataSet \n Code = DataSet.ReturnValueString(CodeFld, rec)\n Count=DataSet.ReturnValueNumber(Countfld, rec)\n \n 'Search for code\n 'Search the code in the table. The field is fldTCode\n theBitMap = ResultTable.GetSelection\n theBitMap.ClearAll\n if (ResultTable.Query (\"[code] =\" + Code.Trim.Quote, theBitMap, #VTAB_SELTYPE_NEW) = False) then\n MsgBox.Error(\"Cannot Compile Query\",\"Aborting\")\n Exit\n end\n ResultTable.UpdateSelection\n \n if (theBitmap.Count = 0) then\n 'Add the code to the resutl table\n newRec = ResultTable.AddRecord\n 'Update the fields for the new data item added\n ResultTable.SetValueString(fldTCode,newRec,Code)\n ResultTable.SetValueNumber(ResultFld,newRec,Count)\n else\n for each uprec in theBitmap\n 'Update the code1 by one\n ResultTable.SetValueNumber(ResultFld,uprec,ResultTable.ReturnValueNumber(ResultFld,uprec)+Count)\n end\n end\n ResultTable.Flush\n end\nend\n\n'Clean the House\n'Remove all the tables created. First Deactive (remove all handles)\nvCode1.Deactivate\nvCode2.Deactivate\nvCode3.Deactivate\n'Now delete the temp files\nFile.Delete(temp1)\nFile.Delete(temp2)\nFile.Delete(temp3)\n\nResultTable.SetEditable(FALSE)\ntheTable = Table.Make(ResultTable)\ntheTable.SetName(sFileName.asstring)\ntheTable.GetWin.Activate\n\n" ) (Script.9 Name: "ScanCode.Explode" SourceCode: "'Converts multi-part polygons to single-part polygons\n\n\ntheView = av.getactivedoc\nif (theView.GetActiveThemes.Count < 1) then\n MsgBox.Error(\"Please select a theme first.\",\n \"Error\")\n return nil\nend\n\norigTheme = theView.GetActiveThemes.Get(0) \norigFtab = origTheme.GetFtab\norigShpFld = origFtab.FindField(\"Shape\")\n\nif (origShpFld.GetType <> #FIELD_SHAPEPOLY) then\n MsgBox.Error(\"The active theme in the View must be a polygon theme.\",\n \"Error\")\n return nil\nend\n\n \norigFldList = o rigFtab.GetFields.Clone\norigFldList.RemoveObj(origShpFld)\norigJoinFld = MsgBox.ChoiceAsString(origFldList,\n \"Choose join field\",\"\")\nif (origJoinFld = nil) then\n return nil\nend \n\ndef = av.GetProject.MakeFileName(\"z\" + origTheme.GetName, \"shp\")\n\nnewSFN = FileDialog.Put(def,\"*.shp\",\n \"New Exploded Shapefile\")\nif (newSFN = nil) then\n return nil\nend \nnewFtab = Ftab.MakeNew(newSFN,Polygon)\nnewIDfld = Field.Make(\"theID\",#FIELD_SHORT,8,0)\nnewJoinFld = origJoinFld.Clone \n\nnewFtab.AddFields({newIDfld, newjoinFld})\nnewShpFld = newFtab.FindField(\"Shape\")\n\nfor each rec in origFtab\n origPolygon = origFtab.ReturnValue(origShpFld,rec)\n origJoinVal = origFtab.ReturnValue(origJoinFld,rec)\n \n if (origPolygon.AsList.Count < 2)\n then\n newRecNo = newFtab.AddRecord\n newFtab.SetValue(newShpFld,newRecNo,origPolygon)\n newFtab.SetValue(newJoinFld,newRecNo,origJoinVal)\n newFtab.SetValue(newIDfld,newRecNo,newRecNo)\n end\n\n \n if (origPolygon.AsList.Count > 1)\n t hen\n for each polyPiece in origPolygon.Explode\n newRecNo = newFtab.AddRecord\n newFtab.SetValue(newShpFld,newRecNo,polyPiece)\n newFtab.SetValue(newJoinFld,newRecNo,origJoinVal)\n newFtab.SetValue(newIDfld,newRecNo,newRecNo)\n end\n end\nend\n\nnewTheme = Ftheme.Make(newFtab)\ntheView.AddTheme(newTheme)\nnewTheme.SetVisible(true)\n' End of Script \"explode.ave\"\n" ) (Script.10 Name: "ScanCode.export" SourceCode: "' Name: View.ShapeToGenerate\n' \n' Title: Exports active theme to ARC/INFO export format\n'\n' Topics: GeoData\n'\n' Description: Exports the active themes to ARC/INFO Export (Generate) \n' format files. Each active theme will require the user to specify an \n' output file name. The format of the export file with be either POINT,\n' LINE, or POLYGON depending upon the type of Shape Field found in the \n' Theme FTab (the Enum Type FieldEnum).\n'\n' The user will be prompted for the field from which to create IDs in\n' the generate file. If is selected the ID for the feature will \n' be set to the current FTab record number. \n'\n' In the case of overlapping polygons, the data should be further\n' converted into an ARC/INFO region coverage with the REGIONCLASS\n' command. ArcView polygon shapes may need to be modeled in ARC/INFO as\n' regions to handle the case of polygons with multiple parts.\n'\n' Following conversion of the generate file to an ARC/INFO coverage\n' the Theme's FTab can be exported to an INFO file t hat can be joined to\n' the coverage Feature Attribute Table (FAT) to restore all attributes as\n' found in the original Theme. Consult ARC/INFO command documentation for\n' JOINITEM and related commands.\n'\n' When creating polygon format Generate files the AUTO keyword is used\n' along with the feature ID to indicate that labels will be automatically\n' created when coverages are imported using ARC/INFO Generate. Consult\n' the ARC/INFO Generate documentation for additional options and discussion.\n'\n' Requires: A View must be the active document.\n'\n' Self: \n'\n' Returns: \n' \n\n\n' View should be the Active Document\n'\ntheView = av.GetActiveDoc\n\n' Establish output precision...\n'\nScript.The.SetNumberFormat( \"d.dddddd\" )\n\nfor each t in theView.GetActiveThemes\n defaultName = FN.Make(\"$HOME\").MakeTmp(t.GetName.LCase,\"gen\")\n ungenFileName = FileDialog.Put( defaultName,\"*.gen\",\"Export\"++t.GetName )\n if (ungenFileName = nil) then \n exit \n else\n exportFile = LineFile.Make(ungenFileName, #FILE_PERM_WRITE)\n en d\n\n ' The ARC/INFO generate format uses the ID number of the feature\n ' in the export file to provide a means for joining attributes.\n ' When the generate file is converted to an ARC/INFO coverage the ID\n ' as found in the generate file will be used as the ID in the coverage\n ' feature attribute table (the .AAT or .PAT). Allow the user to specify\n ' the ID field to use or default to the record number....\n '\n fieldList = t.GetFTab.GetFields.Clone\n fieldList.Insert( \"\" )\n idField = MsgBox.Cho iceAsString( fieldList, \n \"Select ID field for export file:\",\"Choose ID Field\" )\n if ( idField = nil ) then \n exit\n elseif ( idField = \"\" ) then\n useID = false\n else\n useID = true\n end \n\n theFTab = t.GetFTab\n shapeField = theFTab.FindField( \"Shape\" )\n shapeType = shapeField.GetType\n numRecs = theFTab.GetNumRecords\n\n av.ShowStopButton\n av.ShowMsg( \"Exporting\"++t.GetName+\"...\" )\n\n for each recNum in theFTab\n currentShape = theFTab.ReturnValue( shapeField, recNum )\n\n if ( useID ) then\n id =theFTab.ReturnValueString( idField, recNum )\n else\n id = (recNum + 1).SetFormat(\"d\").AsString\n end\n\n if (shapeType = #FIELD_SHAPEPOINT) then \n ' ARC/INFO POINT format export file...\n '\n Xvalue = currentShape.GetX.AsString\n Yvalue = currentShape.GetY.AsString\n outputLine = id+\", \"+Xvalue+\", \"+Yvalue\n exportFile.WriteElt( outputLine )\n\n elseif (shapeType = #FIELD_SHAPEMULTIPOINT) then\n ' ARC/INFO POINT format export file...\n '\n pointList = currentShape.AsList\n for each pt in pointList\n Xvalue = pt.GetX.AsString\n Yvalue = pt.GetY.AsString\n outputLine = id+\", \"+Xvalue+\", \"+Yvalue\n exportFile.WriteElt( outputLine )\n end\n\n elseif (shapeType = #FIELD_SHAPELINE) then\n\n ' ARC/INFO LINE format export file...\n '\n exportFile.WriteElt( id )\n shapeList = currentShape.AsList\n for each shapePart in shapeList\n for each xyPoint in shapePart\n outputLine = xyPoint.GetX.AsString+\", \"\n +xyPoint.GetY.AsString\n exportFile.WriteElt( outputLine )\n end\n exportFile.WriteElt( \"END\" )\n end\n\n elseif (shapeType = #FIELD_SHAPEPOLY) then\n\n ' ARC/INFO POLYGON format export file...\n '\n exportFile.WriteElt( id++\"AUTO\" ) 'automatic label generation flag...\n shapeList = currentShape.AsList\n for each shapePart in shapeList\n for each xyPoint in shapePart\n outputLine = xyPoint.GetX.AsString+\", \"\n +xyPoint.GetY.AsString\n exportFile.WriteElt( outputLine )\n end\n exportFile.WriteElt( \"END\" )\n end\n end\n\n progress = (recNum / numRecs) * 100\n proceed = av.SetStatus( progress )\n if ( proceed.Not ) then\n av.ClearStatus\n av.ShowMsg( \"Stopped\" )\n exit\n end\n\n end\n \n exportFile.WriteElt( \"END\" )\n exportFile.Close\n\n av.ClearStatus\n av.ClearMsg\nend\n\n" ) (Script.11 Name: "ScanCode.findfromtable" SourceCode: "'\n' Written by Harold Weepener\n'\n' 18 May 2002\n'\n\ntheTable = av.getActiveDoc\nif (thetable.is(Table).Not) then\n Return Nil\nend\n\nthevtab = thetable.GetVTab\n\n\n \n labels = { \"Find text\", \"Replace text\" } \n defaults = { \"\", \"\" } \n thefind = MsgBox.Input( \"Text to Find\", \"Find\",\"\" ) \n\n\n theReplace = \"¬\"\n\nIf (thefind = nil) then return nil end\n\nvalist = list.make\n\n'Get the string fields\nstrFields = List.Make\nAllFields = thevtab.GetFields\nFor each Fielditem in AllFields\n if(Fielditem.GetType = #FIELD_CHAR) t hen\n strFields.Add(FieldItem)\n end\nend\n\nfld = MsgBox.listasstring(strFields, \"Choose field to find the data in\",\"\")\n\nfldname = fld.getname\nreplacefieldname = \"xxx\" + fldname\ncancontinue = true\n\nif (cancontinue) then\n\n WasBeingEdited = thevtab.IsBeingEditedWithRecovery \n If (WasBeingEdited = False ) then\n thevtab.SetEditable(True)\n end\n\n replacefield = thevtab.FindField( replacefieldname )\n if (replacefield = nil ) then\n thevtab.AddFields({Field.Make (replacefieldname, #FIELD_CHAR, fld.getwidth, 0) })\n replacefield = thevtab.FindField(replacefieldname)\n end \n thevtab.GetSelection.ClearAll\n thevtab.UpdateSelection\n \n calcstr = \"[\" + fldname + \"].substitute(\" + thefind.quote +\",\" + theReplace.quote +\")\"\n\n thevtab.Calculate( calcstr, replacefield)\n \n \n theQuery = \"[\" + replacefieldname + \"] <> [\" + fldname + \"]\"\n theBitmap = thevtab.GetSelection\n thevtab.Query(theQuery, theBitmap, #VTAB_SELTYPE_NEW) \n thevtab.SetSelection (theBitmap)\n thevtab.UpdateSelection\n For each rec in thevtab.G etSelection\n valist.add(thevtab.returnvalue(fld, rec).asstring) \n end\n \n'\n' Calculate NewField = OldField\n' \n thevtab.GetSelection.ClearAll\n thevtab.UpdateSelection \n calcstr = \"[\" + fldname + \"]\"\n thevtab.Calculate( calcstr, replacefield) \n\n If (valist.count = 0) then \n MsgBox.Info(\"Sorry, nothing found\" + nl + \"Please try again!\", \"Find\") \n thevtab.RemoveFields ({replacefield})\n return nil \n end\n\n num = \"false\"\n valist.sort(true)\n valist.removeduplicates\n If (valist.coun t > 1) then\n selvalues = MsgBox.MultiListAsString (valist, \"Mulitple entries found containing text searched.\" + nl + \"Select one or more of the following\",\"Found\")\n else\n selvalues = {valist.get(0)} \n end\n \n If (selvalues = nil) then \n thevtab.RemoveFields ({replacefield})\n return nil \n end\n\n ' \n ' Replace the selected occurences\n '\n for each oldval in selvalues\n newval = oldval.substitute(thefind,theReplace)\n \n '\n ' Select all records = oldval\n ' \n theQuery = \"[\" + rep lacefieldname + \"] = \" + oldval.quote \n theBitmap = thevtab.GetSelection\n thevtab.Query(theQuery, theBitmap, #VTAB_SELTYPE_NEW) \n thevtab.SetSelection (theBitmap)\n thevtab.UpdateSelection\n '\n 'Replace selected records\n '\n calcstr = \"[\" + replacefieldname + \"].substitute(\" + oldval.quote +\",\" + newval.quote +\")\"\n thevtab.Calculate( calcstr, replacefield)\n end\n\ntheQuery = \"[\" + replacefieldname + \"] <> [\" + fldname + \"]\" \ntheBitmap = thevtab.GetSelection\nthevtab.Query(theQuery, t heBitmap, #VTAB_SELTYPE_NEW) \nthevtab.SetSelection (theBitmap)\nthevtab.UpdateSelection\n \n\nthevtab.RemoveFields ({replacefield})\nIf (WasBeingEdited = False ) then\n thevtab.SetEditable(False)\nend\nend" ) (Script.12 Name: "ScanCode.findfromtheme" SourceCode: "'\n' Written by Harold Weepener\n'\n' 18 May 2002\n'\n\n\ntheview = av.getactivedoc\n\nthethemelist = theview.getactivethemes\n\n\n If (thethemelist.count < 1) then\n MsgBox.Error(\"Please select a theme first.\",\"Error!\")\n return nil\n end\n\n\n If (thethemelist.count <>1) then\n MsgBox.Error(\"Only one theme must be active\",\"Error!\")\n return nil\n end\n \n labels = { \"Find text\", \"Replace text\" } \n defaults = { \"\", \"\" } \n thefind = MsgBox.Input( \"Text to Find\", \"Find\",\"\" ) \n\n\n theReplace = \"¬\"\n\nIf (thefind = nil) th en return nil end\n\nthetheme = thethemelist.get(0)\ntheftab = thetheme.getftab\nvalist = list.make\n\n'Get the string fields\nstrFields = List.Make\nAllFields = theftab.GetFields\nFor each Fielditem in AllFields\n if(Fielditem.GetType = #FIELD_CHAR) then\n strFields.Add(FieldItem)\n end\nend\n\nfld = MsgBox.listasstring(strFields, \"Choose field to find the data in\",\"\")\n\nfldname = fld.getname\nreplacefieldname = \"xxx\" + fldname\ncancontinue = true\n\nif (cancontinue) then\n\n\nWasBeingEdited = theFTab.IsBeingEditedWithRecov ery \n\nIf (WasBeingEdited = False ) then\n theFTab.SetEditable(True)\nend\n\n replacefield = theftab.FindField( replacefieldname )\n if (replacefield = nil ) then\n \n theftab.AddFields({Field.Make (replacefieldname, #FIELD_CHAR, fld.getwidth, 0)})\n replacefield = theFTab.FindField(replacefieldname)\n end \n theFTab.GetSelection.ClearAll\n theFTab.UpdateSelection\n \n \n \n calcstr = \"[\" + fldname + \"].substitute(\" + thefind.quote +\",\" + theReplace.quote +\")\"\n\n theFTab.Calculate( calcstr, replacefield)\n \n theQuery = \"[\" + replacefieldname + \"] <> [\" + fldname + \"]\"\n theBitmap = theFTab.GetSelection\n theFTab.Query(theQuery, theBitmap, #VTAB_SELTYPE_NEW) \n theFTab.SetSelection (theBitmap)\n theFTab.UpdateSelection\n For each rec in theftab.GetSelection\n valist.add(theftab.returnvalue(fld, rec).asstring) \n end\n \n'\n' Calculate NewField = OldField\n' \n theFTab.GetSelection.ClearAll\n theFTab.UpdateSelection\n \n calcstr = \"[\" + fldname + \"]\"\n theFTab.Calculate( calcstr, replacefield)\n \n\n If (valist.count = 0) then \n MsgBox.Info(\"Sorry, nothing found\" + nl + \"Please try again!\", \"Find\") \n theFTab.RemoveFields ({replacefield})\n return nil \n end\n\n\n num = \"false\"\n valist.sort(true)\n valist.removeduplicates\n If (valist.count > 1) then\n selvalues = MsgBox.MultiListAsString (valist, \"Mulitple entries found containing text searched.\" + nl + \"Select one or more of the following\",\"Found\")\n else\n if (valist.get(0) <> thefind) then\n Msgbox.info(\"Polygons with the value \" + v alist.get(0) + \" will be selected.\",\"\")\n end \n selvalues = {valist.get(0)}\n end\n \n If (selvalues = nil) then \n theFTab.RemoveFields ({replacefield})\n return nil \n end\n\n ' \n ' Replace the selected occurences\n '\n for each oldval in selvalues\n newval = oldval.substitute(thefind,theReplace)\n \n '\n ' Select all records = oldval\n ' \n theQuery = \"[\" + replacefieldname + \"] = \" + oldval.quote \n theBitmap = theFTab.GetSelection\n theFTab.Query(theQuery, theBitmap, #VTAB_SE LTYPE_NEW) \n theFTab.SetSelection (theBitmap)\n theFTab.UpdateSelection\n '\n 'Replace selected records\n '\n calcstr = \"[\" + replacefieldname + \"].substitute(\" + oldval.quote +\",\" + newval.quote +\")\"\n theFTab.Calculate( calcstr, replacefield)\n end\n\ntheQuery = \"[\" + replacefieldname + \"] <> [\" + fldname + \"]\" \ntheBitmap = theFTab.GetSelection\ntheFTab.Query(theQuery, theBitmap, #VTAB_SELTYPE_NEW) \ntheFTab.SetSelection (theBitmap)\ntheFTab.UpdateSelection\ntheFTab.RemoveFields ({replacefield })\n\nIf (WasBeingEdited = False ) then\n theFTab.SetEditable(False)\nend\nend" ) (Script.13 Name: "ScanCode.gaps" SourceCode: "theView = av.GetActiveDoc\nif (theView.GetActiveThemes.count = 0) then\n msgbox.info(\"Please select a theme first.\", \"Info\") \n return nil\nend\n\ntheActiveTheme = theView.GetActiveThemes.Get(0)\nif ( theActiveTheme.Is ( FTHEME ).NOT ) then\nreturn NIL\nend\ntheFTab = theActiveTheme.GetFTab\ntheShapeFld = theFTab.FindField ( \"Shape\" )\nif ( theShapeFld = NIL ) then\nMsgBox.Warning ( \"Error in getting shape field for theFtab\",\"\")\nend\n'*******************\n' CLEAN the POLYGONS\n'*******************\n' get the filename for the new polygon shapefile\ndef = av.GetProject.MakeFileName(\"z\" + theActiveTheme.GetName, \"shp\")\n\ntheFN = FileDialog.Put(def, \"*.shp\", \"Cleaned Shapefile\")\nif ( theFN = NIL ) then\nreturn FALSE\nend\n' clean the shapes and put into a new theme\nShape.SetCleanPreference ( #SHAPE_CLEAN_HIGHEST_QUALITY )\ntheNewFTab = theFTab.ExportClean ( theFN, FALSE)\nif (( theNewFTab.HasError)) then\nmsgBox.Warning ( \"Error making ftab!\",\"\")\nreturn NIL\nend\ntheNewFTab.SetEditable ( TRUE )\ntheNewFTab.BeginTransaction\ntheNShapeFld = theNewFTab.FindField ( \"Shape\" )\n' (re-)calculate the AREA and PERIMETER\ntheAFld = theNewFTab.FindField ( \"Area\" )\nif ( theAFld = NIL ) then\ntheNewFTab.AddFields ( { Field.Make ( \"Area\", #FIELD_FLOAT, 16, 5 ) } )\ntheAFld = theNewFTab.FindField ( \"Area\" )\nend\nthePFld = theNewFTab.FindField ( \"Perimeter\" )\nif ( thePFld = NIL ) then\ntheNewFTab.AddFields ( { Field.Make ( \"Perimeter\", #FIELD_FLOAT, 16, 5 ) } )\nthePFld = theNewFTab.FindField ( \"Perimeter\" )\nend\nfor each rec in theNewFTab\ntheNewFTab.SetValue ( the AFld, rec, ( theNewFTab.ReturnValue ( theNShapeFld, rec ).ReturnArea ) )\ntheNewFTab.SetValue ( thePFld, rec, ( theNewFTab.ReturnValue ( theNShapeFld, rec ).ReturnLength ) )\nend\n'*******************\n' CHECK TOPOLOGY\n'******************* \ntheFld = Field.Make (\"Type\", #FIELD_CHAR, 8, 0)\ntheNewFTab.AddFields ( { theFld } )\n' get a list of the polygons\nthePolygons = List.Make\ntheOrigBM = theNewFTab.GetSelection\nif ( theOrigBM.Count = 0 ) then\ntheOrigBM.Not\nend\nfor each rec in theNewFTab\nthePolygons.Add ( theFTab .ReturnValue ( theShapeFld, rec ) )\ntheNewFTab.SetValue ( theFld, rec, \"Original\" )\nend\n'*******************\n' FIND GAPS \n'******************* \ntheMER = theActiveTheme.ReturnExtent.Scale ( 2 )\ntheMERArea = theActiveTheme.ReturnExtent.ReturnArea\ntheShape2 = thePolygons.Get(0)\nfor each theP in thePolygons\ntheShape2 = theP.ReturnUnion ( theShape2 )\nend\ntheGaps1 = theMER.ReturnDifference ( theShape2 )\n' remove the largest polygon\ntheGaps = theGaps1.Explode\nfor each i in 0..(theGaps.Count - 1)\nif ( theGaps.Get(i ).ReturnArea > theMERArea ) then\ntheGaps.Remove ( i )\nbreak\nend\nend\n'*******************\n' FIND OVERLAPS \n'*******************\ntheOverlapShapes = List.Make\nfor each i in 0..(thePolygons.Count - 2)\nfor each j in (i+1)..(thePolygons.Count - 1)\ntheOL = thePolygons.Get(i).ReturnIntersection ( thePolygons.Get(j) )\nif ( theOL.ReturnArea > 0.0 ) then\ntheOverlapShapes.Add ( theOL )\nend\nend\nend\ntheOverlaps = List.Make\nfor each theOL in theOverlapShapes\ntheOL2 = theOL.Explode\nfor each theOL3 in theOL2\ntheOverlaps.Add ( theOL3 )\nend\nend\n' ************\n' now add the gaps and overlaps to the new shapefile\n' ****************\ntheNumOverlaps = theOverlaps.Count\ntheNumGaps = theGaps.Count\nif ( ( theNumOverlaps > 0 ) OR ( theNumGaps > 0 ) )then \nfor each theP in theOverlaps\nrec = theNewFTab.AddRecord\ntheNewFTab.SetValue ( theNShapeFld, rec, theP )\ntheNewFTab.SetValue ( theFld, rec, \"Overlap\" )\ntheNewFTab.SetValue ( theAFld, rec, ( theNewFTab.ReturnValue ( theNShapeFld, rec ).ReturnArea ) )\ntheNewFTab.SetValue ( thePFld, rec, ( theNewFTab.ReturnValue ( theNShapeFld, rec ).ReturnLength ) )\nend\nfor each theG in theGaps\nrec = theNewFTab.AddRecord\ntheNewFTab.SetValue ( theNShapeFld, rec, theG )\ntheNewFTab.SetValue ( theFld, rec, \"Gap\" )\ntheNewFTab.SetValue ( theAFld, rec, ( theNewFTab.ReturnValue ( theNShapeFld, rec ).ReturnArea ) )\ntheNewFTab.SetValue ( thePFld, rec, ( theNewFTab.ReturnValue ( theNShapeFld, rec ).ReturnLength ) )\nend\nend\nmsgBox.info (\"Found \"+theNumOverlaps.asString + \" overlaps and \"+theNumGaps.asString + \" gaps!\", \"\")\n' finish up the new theme\ntheNewFTab.EndTransaction\ntheNewFTab.SetEditable ( FALSE )\n\n'\n' Clear the seledction\n'\n\ntheBitmap = theNewFTab.GetSelection\ntheBitmap.clearall\ntheNewFTab.SetSelection (theBitmap)\ntheNewFTab.UpdateSelection\n\n'\n' Make the new theme and set it's legend\n'\ntheTheme = FTheme.Make ( theNewFTab )\ntheLegend = theTheme.GetLegend\n\n' First Set the LegendType\n\ntheLegend.SetLegendType(#LEGEND_TYPE_UNIQUE)\n\n' Make the Unique Legend\n\ntheLegend.Unique(theTheme,\"Type\")\n\n' Load and Set the Color Scheme\ntheColorSchemes = SymbolList.GetPreDefined(#SYMLIST_TYPE_COLORSCHEME)\n\nfor each scheme in theColorSchemes\n if (scheme.GetName = \"Bountiful Harvest\") then\n theColorScheme = scheme\n end\nend\n\ntheLegend.GetSymbols.RandomSavedSymbols(theColorScheme)\n\n' Change the TOC and redraw the theme.\n\ntheView.AddTheme ( theTheme )\n\ntheTheme.UpdateLegend\n\n\n\n\n" ) (Script.14 Name: "ScanCode.ImagePos" SourceCode: "workdir = av.getproject.getworkdir.asstring \ntheView = av.GetActiveDoc\nAllthemes = theView.GetThemes\n\n\naFileName = av.GetProject.MakeFileName(\"scenes\", \"shp\")\n\naFileName = FileDialog.Put(aFileName, \"*.shp\", \"Scenes\")\n\nif ( aFileName = NIL ) then\n return NIL\nend\n\n\n\ntheFTab = FTab.MakeNew (aFileName, Polygon)\n\n\nfld = Field.Make(\"ID\", #FIELD_CHAR , 40, 0)\n\ntheFTab.AddFields({fld})\n\n\nshpField = theFTab.FindField(\"Shape\") \nidField = theFTab.FindField(\"ID\") \ncodeField = theFTab.FindField(\"Code\") \nnewShp = Point .Make(1,2) \ntheFTab.SetEditable(true) \nif (theFTab.IsEditable) then \n for each atheme in Allthemes\n if ( atheme.CanExportToFTab.not ) then \n theID = aTheme.GetName\n thePos = theID.IndexOf (\".\")\n if (thePos > 0) then\n theID = theId.left(thePos)\n end\n\n newShp = aTheme.ReturnExtent.aspolygon \n theRec = theFTab.AddRecord \n theFTab.SetValue(shpField,theRec,newShp) \n theFTab.SetValue(idField,theRec,theID) \n end \n end\nend \n\nthebitmap = theFtab.getselection\ntheBitmap.setall\nif (theBit map.count = 0) then\n msgbox.info(\"There are no images in the view\",\"Info\")\nend\n\ntheFTab.SetEditable(FALSE)\n\naSymbol = Symbol.Make(#SYMBOL_TEXT)\naSymbol.SetSize (8)\naSymbol.SetColor (Color.GetBlack)\n\ntheTheme = FTheme.Make(theFTab)\ntheView.AddTheme(theTheme)\ntheTheme.SetLabelTextSym (aSymbol)\ntheTheme.SetLabelField (idField)\ntheTheme.SetActive(TRUE)\ntheTheme.SetVisible(TRUE)\n" ) (Script.15 Name: "ScanCode.Multiplepoly" SourceCode: " 'program: FSA Show Multipart Polygons\n 'programmer: Jim Heald, FSA\n 'date: 4/22/99\n '\n 'purpose: highlights polygons which have been combined but are not adjacent.\n '\n 'Revised by Edgar Okioga\n \n theView = av.GetActiveDoc\n \n if (theView.GetActiveThemes.count = 0) then\n msgbox.info(\"Please select a theme first.\", \"Info\") \n return nil\n end\n\n \n theTheme = theView.GetActiveThemes.Get(0)\n \n \n thePoly = Polygon.MakeNull\n anFTab = theTheme.GetFTab\n shpFld = anFTab.FindField(\"Shape\")\n theList = List.Make\n\n theBi tmap = anFTab.GetSelection\n theBitmap.ClearAll\n theGraphics = theView.GetGraphics\n for each x in anFTab\n thePoly = anFTab.ReturnValue(shpFld,x)\n thePolys = thePoly.explode\n if (thePolys.count > 1) then \n theBitmap.Set(x)\n end\n end\n\n ' query and apply selection \n \n anFTab.UpdateSelection\n theView.Invalidate\n\nif (anFTab.GetSelection.count <> 0) then\nelse\nMsgBox.Info(\"No Errors Found\",\"Multipart Polygon Error Checking\")\nend\n\n" ) (Script.16 Name: "ScanCode.Properties" SourceCode: "'\n' Written by Harold Weepener\n'\n' 21 June 2002\n'\n\ntheTable = av.GetActiveDoc\ntheVTab = theTable.GetVTab\ntheActiveField = theTable.GetActiveField\n\nif (theActiveField = nil) then\n MsgBox.Error(\"Please select a field by clicking on table field name.\", \"No Field Selected\")\n exit\nend\n\nif (theActiveField.IsTypeString.not) then\n MsgBox.Error(\"Can only rename string fields\", \"Invalid Field\")\n exit\nend\n\nOldFieldName = theActiveField.GetName\nOldWidth = TheActiveField.GetWidth\nOldType = theActiveField.GetType\nOld Precision = theActiveField.GetPrecision\n\n\nlabels = { \"Fied Name\", \"FieldWidth\"}\ndefaults = { OldFieldName, OldWidth.asstring } \nproperties = MsgBox.MultiInput( \"If the width is changed to a value less than being displayed data might be cut off.\", \"Field properties\", labels, defaults )\n\nif (properties.count = 0) then\n return nil\nend\n\n\nNewFieldName = properties.Get(0)\nNewWidth = properties.Get(1)\n\n\nif ((NewFieldName = OldFieldName) AND (OldWidth = NewWidth)) then\n MsgBox.Info(\"No Changes were made\", \"Info\")\n return nil\nend\n\nif (NewFieldName <> OldFieldName) then\n\n theVTab.SetEditable(true)\n theVTab.AddFields({(Field.Make(NewFieldName, OldType, NewWidth.asNumber, OldPrecision))})\n theNewField = theVTab.FindField(NewFieldName)\n av.ShowMsg(\"Renaming\"++OldFieldName++\"to\"++NewFieldName+\"...\")\n \n theVTab.Calculate(\"[\" + OldFieldName + \"]\", theNewField)\n\n av.ClearMsg\n av.ClearStatus\n theVTab.SetEditable(false)\n theVTab.Flush\n\nend\n\n\nif (NewFieldName = OldFieldName) then\n if (MsgBox.YesNo(\"The original field will be replaced\"+ nl +\"Coninue?\", \"Warning\",true)) then\n TmpFieldName = \"XXX\" + OldFieldName\n \n theVTab.SetEditable(true)\n \n theBitmap = thevtab.GetSelection\n theBitmap.clearall\n thevtab.SetSelection (theBitmap)\n thevtab.UpdateSelection\n\n \n theVTab.AddFields({(Field.Make(TmpFieldName, OldType, NewWidth.asNumber, OldPrecision))})\n theTmpField = theVTab.FindField(TmpFieldName)\n 'av.ShowMsg(\"Renaming\"++OldFieldName++\"to\"++NewFieldName+\"...\")\n \n theVTab.Calculate(\"[\" + OldFieldName + \"]\", theTmpField)\n \n theNewField = theVTab.FindField(NewFieldName)\n theVTab.removefields({theNewField})\n theVTab.AddFields({(Field.Make(NewFieldName, OldType, NewWidth.asNumber, OldPrecision))})\n theNewField = theVTab.FindField(NewFieldName)\n theVTab.Calculate(\"[\" + TmpFieldName + \"]\", theNewField)\n theVTab.removefields({theTmpField})\n\n av.ClearMsg\n av.ClearStatus\n theVTab.SetEditable(false)\n theVTab.Flush\n end\nend\n\n\n\n" ) (Script.17 Name: "ScanCode.Recalc" SourceCode: "'By Edgar Okioga\n'Rewritten by Harold Weepener 14/12/2001\n'It was edited to make provision for the following codes\n' // and /// and for more tha one -\n\n'get the active theme\ntheDoc = av.getActiveDoc\nif (theDoc.is(Table).Not) then\n Msgbox.info(\"Need a table only\",\"ABORTING\")\n Return Nil\nelse\n theVTab = theDoc.GetVtab\nend\n\n'Determine if the VTab can be edited\nif (theVtab.CanEdit) then\n else\n Msgbox.info(\"Cannot Edit table contents\",\"Aborting\")\n Return nil\nend\n\n'Select the Code Separator Character\nCo deSeparator = Msgbox.input(\"Enter the Code Separator Character\",\"MAJOR CODE SEPARATOR\",\"/\")\nif (CodeSeparator = Nil) then\n Msgbox.Info(\"User Select Cancel\",\"Aborting\")\n Return Nil\nend\n\n'Select the Minor Code Separator\nmCodeSeparator = Msgbox.input(\"Enter the SubCode Separator Character\",\"MINOR CODE SEPARATOR\",\"-\")\nif (mCodeSeparator = Nil) then\n Msgbox.Info(\"User Select Cancel\",\"Aborting\")\n Return Nil\nend\n \n'Make sure the mCode and Code separator are not the same\nif (mCodeSeparator.Trim = CodeSeparator .Trim) then\n Msgbox.Info(\"Code separators are identical\",\"Aborting\")\n Return Nil\nend\n\n'Get the Finca Record Attribute\nstrFields = List.Make\nAllFields = theVTab.GetFields\nFor each Fielditem in AllFields\n if(Fielditem.GetType = #FIELD_CHAR) then\n strFields.Add(FieldItem)\n end\nend\n\nClassCode = Msgbox.Choice(strFields,\"Select the Field that holds the Final Code Attribute\",\"ATTRRIBUTE SELECTION\")\nif (ClassCode = nil) then\n Msgbox.Info(\"User Select Cancel\",\"Aborting\")\n Return Nil\nend\n\n'Set transaction\nEr rorCount = 0\nif (theVTab.StartEditingWithRecovery) then \n 'These three editing operations contained in this Begin/End transaction \n 'block can be undone or reapplied as a group using VTab.Undo or VTab.Redo \n theVTab.BeginTransaction \n \n \n 'Code1\n if (theVtab.FindField(\"Code1\") = Nil) then\n theVTab.AddFields({Field.Make (\"CODE1\", #FIELD_CHAR, 20, 0)})\n Code1 = theVtab.FindField(\"Code1\")\n else\n Code1 = theVtab.FindField(\"Code1\")\n end\n 'Code2\n if (theVtab.FindField(\"Code2\") = Nil) th en\n theVTab.AddFields({Field.Make (\"CODE2\", #FIELD_CHAR, 20, 0)})\n Code2 = theVtab.FindField(\"Code2\")\n else\n Code2 = theVtab.FindField(\"Code2\")\n end\n 'Code3\n if (theVtab.FindField(\"Code3\") = Nil) then\n theVTab.AddFields({Field.Make (\"CODE3\", #FIELD_CHAR, 20, 0)})\n Code3 = theVtab.FindField(\"Code3\")\n else\n Code3 = theVtab.FindField(\"Code3\")\n end\n \n 'SubCode1\n if (theVtab.FindField(\"SubCod1\") = Nil) then\n theVTab.AddFields({Field.Make (\"SUBCOD1\", #FIELD_CHAR, 15, 0)})\n SubCode 1 = theVtab.FindField(\"SubCod1\")\n else\n SubCode1 = theVtab.FindField(\"SubCod1\")\n end\n 'SubCode2\n if (theVtab.FindField(\"SubCod2\") = Nil) then\n theVTab.AddFields({Field.Make (\"SUBCOD2\", #FIELD_CHAR, 15, 0)})\n SubCode2 = theVtab.FindField(\"SubCod2\")\n else\n SubCode2 = theVtab.FindField(\"SubCod2\")\n end\n 'SubCode3\n if (theVtab.FindField(\"SubCod3\") = Nil) then\n theVTab.AddFields({Field.Make (\"SUBCOD3\", #FIELD_CHAR, 15, 0)})\n SubCode3 = theVtab.FindField(\"SubCod3\")\n else\n SubCode3 = t heVtab.FindField(\"SubCod3\")\n end\n \n \n codelst = list.Make\n FullGroup = list.make\n NumberRecs = theVTab.GetNumRecords\n av.ShowStopButton\n Av.useWaitCursor\n Progress = 0\n Hash3Str = CodeSeparator + CodeSeparator + CodeSeparator\n Hash2Str = CodeSeparator + CodeSeparator \n Hash2Replacement = CodeSeparator + \"!\" + CodeSeparator\n for Each Record in theVTab\n codelst.Empty\n FullGroup.Empty\n 'get the main code\n originalstrClass = thevtab.ReturnValueString(ClassCode,Record)\n strClass = or iginalstrClass.Substitute (Hash3Str, \"!!!\")\n strClass = strClass.Substitute (Hash2Str, Hash2Replacement)\n codelst = strClass.AsTokens(CodeSeparator.Trim)\n 'Create a tree for the codes\n Count = 0\n for each mCode in Codelst\n mcode_count = mCode.AsTokens(mcodeSeparator).count\n if (mcode_count > 2) then \n FullGroup.Add({{mCode}})\n else\n FullGroup.Add({mCode.AsTokens(mcodeSeparator)})\n end \n Fullgroup_count = Fullgroup.count \n end\n if (CodeLst.Count > 3) then\n 'Abandon if the list contains more than 3 major classes\n ErrorCount = ErrorCount + 1\n Continue\n else\n \n theVtab.SetValueString(Code1,Record,\"\")\n theVtab.SetValueString(Code2,Record,\"\")\n theVtab.SetValueString(Code3,Record,\"\")\n\n \n theVtab.SetValueString(SubCode1,Record,\"\")\n theVtab.SetValueString(SubCode2,Record,\"\")\n theVtab.SetValueString(SubCode3,Record,\"\")\n GroupCount = 0 \n for Each CodeGroup in FullGroup\n For Each it em in CodeGroup\n if (item.Count > 10 )then 'The program must not abord when there is more than 2\n Break\n else\n 'theVTab.SetValue(ClassCode,Record,strClass.Trim.Substitute (\"!!!\", Hash3Str).Substitute(\"!\",\"\"))\n 'Add items in the tables\n if (GroupCount = 0) then\n if (Item.Count = 1) then\n theVtab.SetValueString(Code1,Record,Item.Get(0).Trim.Substitute (\"!!!\", Hash3Str))\n else\n theVtab.SetVal ueString(Code1,Record,Item.Get(0).Trim.Substitute (\"!!!\", Hash3Str))\n theVtab.SetValueString(SubCode1,Record,Item.Get(1).Trim.Substitute (\"!!!\", Hash3Str))\n end\n end\n if (GroupCount = 1) then\n if (Item.Count = 1) then\n theVtab.SetValueString(Code2,Record,Item.Get(0).Trim.Substitute (\"!!!\", Hash3Str))\n else\n theVtab.SetValueString(Code2,Record,Item.Get(0).Trim.Substitute (\"!!!\", Hash3Str))\n theVtab.SetValueString(SubCode2,Record,Item.Get(1).Trim.Substitute (\"!!!\", Hash3Str))\n end\n end\n if (GroupCount = 2) then\n if (Item.Count = 1) then\n theVtab.SetValueString(Code3,Record,Item.Get(0).Trim.Substitute (\"!!!\", Hash3Str))\n else\n theVtab.SetValueString(Code3,Record,Item.Get(0).Trim.Substitute (\"!!!\", Hash3Str))\n theVtab.SetValueString(SubCode3,Record,Item.Get(1).Trim.Substitute (\"!!!\", Hash3S tr))\n end\n end\n end\n\n GroupCount = GroupCount + 1\n end\n end\n \n 'theVtab.SetValueString(ClassCode,Record,thevtab.ReturnValueString(ClassCode,Record).Substitute (\"!\", \"\"))\n theVtab.SetValueString(Code1,Record,thevtab.ReturnValueString(Code1,Record).Substitute (\"!\", \"\"))\n theVtab.SetValueString(Code2,Record,thevtab.ReturnValueString(Code2,Record).Substitute (\"!\", \"\"))\n theVtab.SetValueString(Code3,Record,thevtab.ReturnValueString(Cod e3,Record).Substitute (\"!\", \"\"))\n end\n progress = Progress + 1\n doMore = av.SetStatus((progress/NumberRecs)*100)\n if (not domore) then\n av.SetStatus(100)\n Break\n end\n end\n 'Loop thru all records updating the codes\n theVTab.EndTransaction \nend \nif (ErrorCount <> 0) then\n saveEdits = Msgbox.YesNo(ErrorCount.AsString ++ \"records have not been procesed due to error in codes\" + NL + \"Save the Changes ?\", \"CONFIRM Changes\",False) \nelse\n saveEdits = True\nend\n\n'Since saveEdits is set to TRUE the edits will be committed, if saveEdits 'was set to FALSE then the edits would be discarded \ntheVTab.StopEditingWithRecovery(saveEdits)\n\n\n" ) (Script.18 Name: "ScanCode.replacefromtable" SourceCode: "'\n' Written by Harold Weepener\n'\n' 18 May 2002\n'\n\ntheTable = av.getActiveDoc\nif (thetable.is(Table).Not) then\n Return Nil\nend\n\nthevtab = thetable.GetVTab\n \n labels = { \"Find text\", \"Replace text\" } \n defaults = { \"\", \"\" } \n replacelist = MsgBox.MultiInput( \"\", \"Replace\", labels, defaults ) \n\nIf (replacelist.count = 0) then return nil end\n\n\nthefind = replacelist.get(0)\ntheReplace = replacelist.get(1)\n\nIf (thefind = nil) then return nil end\nIf (theReplace = nil) then return nil end\n\nvalist = list.make\n\n 'Get the string fields\nstrFields = List.Make\nAllFields = thevtab.GetFields\nFor each Fielditem in AllFields\n if(Fielditem.GetType = #FIELD_CHAR) then\n strFields.Add(FieldItem)\n end\nend\n\nfld = MsgBox.listasstring(strFields, \"Choose field to find the data in\",\"\")\n\nfldname = fld.getname\nreplacefieldname = \"xx\" + fldname\n\nif (thevtab.FindField( replacefieldname ) = nil) then\n aMsg = thefind.quote + \" will be replaced with \" + theReplace.quote +\" in a new field called: \" + replacefieldname + nl + \"Continu e?\"\nelse\n aMsg = thefind.quote + \" will be replaced with \" + theReplace.quote +\" in an existing field called: \" + replacefieldname + nl + \"Continue?\"\nend\ncancontinue = msgbox.yesno(aMsg, \"Continue?\", true)\n\nif (cancontinue) then\n WasBeingEdited = thevtab.IsBeingEditedWithRecovery \n\n If (WasBeingEdited = False ) then\n thevtab.SetEditable(True)\n end\n\n replacefield = thevtab.FindField( replacefieldname )\n if (replacefield = nil ) then\n thevtab.AddFields({Field.Make (replacefieldname, #FIELD_CHAR, fld. getwidth, 0)})\n replacefield = thevtab.FindField(replacefieldname)\n end \n thevtab.GetSelection.ClearAll\n thevtab.UpdateSelection\n \n calcstr = \"[\" + fldname + \"].substitute(\" + thefind.quote +\",\" + theReplace.quote +\")\"\n\n thevtab.Calculate( calcstr, replacefield) \n \n theQuery = \"[\" + replacefieldname + \"] <> [\" + fldname + \"]\"\n theBitmap = thevtab.GetSelection\n thevtab.Query(theQuery, theBitmap, #VTAB_SELTYPE_NEW) \n thevtab.SetSelection (theBitmap)\n thevtab.UpdateSelection\n For each rec in thevtab.GetSelection\n valist.add(thevtab.returnvalue(fld, rec).asstring) \n end\n \n'\n' Calculate NewField = OldField\n' \n thevtab.GetSelection.ClearAll\n thevtab.UpdateSelection \n calcstr = \"[\" + fldname + \"]\"\n thevtab.Calculate( calcstr, replacefield) \n\n If (valist.count = 0) then \n MsgBox.Info(\"Sorry, nothing found\" + nl + \"Please try again!\", \"Message\") \n return nil \n end\n\n\n num = \"false\"\n valist.sort(true)\n valist.removeduplicates\n If (valist.count > 1) then\n selvalues = M sgBox.MultiListAsString (valist, \"Mulitple entries found containing text searched.\" + nl + \"Select one or more of the following to be replaced.\",\"Found\")\n else\n if (valist.get(0) <> thefind) then\n if (msgbox.yesno(valist.get(0) + \" was found. Replace?\",\"Replace\",True) = false) then\n return nil\n end \n end \n selvalues = {valist.get(0)}\n end\n \n If (selvalues = nil) then \n return nil \n end\n\n ' \n ' Replace the selected occurences\n '\n \n for each oldval in selvalues\n n ewval = oldval.substitute(thefind,theReplace)\n \n '\n ' Select all records = oldval\n ' \n theQuery = \"[\" + replacefieldname + \"] = \" + oldval.quote \n theBitmap = thevtab.GetSelection\n thevtab.Query(theQuery, theBitmap, #VTAB_SELTYPE_NEW) \n thevtab.SetSelection (theBitmap)\n thevtab.UpdateSelection\n '\n 'Replace selected records\n '\n calcstr = \"[\" + replacefieldname + \"].substitute(\" + oldval.quote +\",\" + newval.quote +\")\"\n thevtab.Calculate( calcstr, replacefield)\n end\n \n\n If (WasBeingEdited = False ) then\n thevtab.SetEditable(False)\n end\n\n theQuery = \"[\" + replacefieldname + \"] <> [\" + fldname + \"]\" \n\n theBitmap = thevtab.GetSelection\n thevtab.Query(theQuery, theBitmap, #VTAB_SELTYPE_NEW) \n thevtab.SetSelection (theBitmap)\n thevtab.UpdateSelection\n\nend" ) (Script.19 Name: "ScanCode.replacefromtheme" SourceCode: "'\n' Written by Harold Weepener\n'\n' 18 May 2002\n'\ntheview = av.getactivedoc\n\n\nthethemelist = theview.getactivethemes\n\nIf (thethemelist.count < 1) then\n MsgBox.Error(\"Please select a theme first.\",\"Error!\")\n return nil\nend\n\n\n If (thethemelist.count <>1) then\n MsgBox.Error(\"Only one theme must be active\",\"Error!\")\n return nil\n end\n \nlabels = { \"Find text\", \"Replace text\" } \ndefaults = { \"\", \"\" } \nreplacelist = MsgBox.MultiInput( \"\", \"Replace\", labels, defaults ) \n\n\n\nIf (replacelist.count = 0) then return nil end\n\nthefind = replacelist.get(0)\ntheReplace = replacelist.get(1)\n\n\nIf (thefind = nil) then return nil end\nIf (theReplace = nil) then return nil end\n\n\nthetheme = thethemelist.get(0)\ntheftab = thetheme.getftab\nvalist = list.make\n\n'Get the string fields\nstrFields = List.Make\nAllFields = theftab.GetFields\nFor each Fielditem in AllFields\n if(Fielditem.GetType = #FIELD_CHAR) then\n strFields.Add(FieldItem)\n end\nend\n\nif (strFields.count = 0) then\n MsgBox.Info(\"No text fields\", \"Warning\")\n return nil\nend\n\nfld = MsgBox.listasstring(strFields, \"Choose field to find the data in\",\"\")\n\nfldname = fld.getname\nreplacefieldname = \"xx\" + fldname\n\nif (theftab.FindField( replacefieldname ) = nil) then\n aMsg = thefind.quote + \" will be replaced with \" + theReplace.quote +\" in a new field called: \" + replacefieldname + nl + \"Continue?\"\nelse\n aMsg = thefind.quote + \" will be replaced with \" + theReplace.quote +\" in an existing field called: \" + replacefieldname + nl + \"Continue?\"\nend\ncancontinue = msgbox.ye sno(aMsg, \"Continue?\", true)\n\nif (cancontinue) then\n\n WasBeingEdited = theFTab.IsBeingEditedWithRecovery \n\n If (WasBeingEdited = False ) then\n theFTab.SetEditable(True)\n end\n\n replacefield = theftab.FindField( replacefieldname )\n if (replacefield = nil ) then\n theftab.AddFields({Field.Make (replacefieldname, #FIELD_CHAR, fld.getwidth, 0)})\n replacefield = theFTab.FindField(replacefieldname)\n end \n theFTab.GetSelection.ClearAll\n theFTab.UpdateSelection\n \n \n calcstr = \"[\" + fldname + \"].substitute (\" + thefind.quote +\",\" + theReplace.quote +\")\"\n\n theFTab.Calculate( calcstr, replacefield) \n \n theQuery = \"[\" + replacefieldname + \"] <> [\" + fldname + \"]\"\n theBitmap = theFTab.GetSelection\n theFTab.Query(theQuery, theBitmap, #VTAB_SELTYPE_NEW) \n theFTab.SetSelection (theBitmap)\n theFTab.UpdateSelection\n For each rec in theftab.GetSelection\n valist.add(theftab.returnvalue(fld, rec).asstring) \n end\n \n'\n' Calculate NewField = OldField\n' \n theFTab.GetSelection.ClearAll\n theFTab.Up dateSelection \n calcstr = \"[\" + fldname + \"]\"\n theFTab.Calculate( calcstr, replacefield) \n\n If (valist.count = 0) then \n MsgBox.Info(\"Sorry, nothing found\" + nl + \"Please try again!\", \"Find\") \n return nil \n end\n\n\n num = \"false\"\n valist.sort(true)\n valist.removeduplicates\n If (valist.count > 1) then\n selvalues = MsgBox.MultiListAsString (valist, \"Mulitple entries found containing text searched.\" + nl + \"Select one or more of the following to be replaced.\",\"Found\")\n else\n if (valist.get( 0) <> thefind) then\n if (msgbox.yesno(valist.get(0) + \" was found. Replace?\",\"Replace\",True) = false) then\n return nil\n end \n end \n selvalues = {valist.get(0)}\n end\n \n If (selvalues = nil) then \n return nil \n end\n\n ' \n ' Replace the selected occurences\n '\n \n for each oldval in selvalues\n newval = oldval.substitute(thefind,theReplace)\n \n '\n ' Select all records = oldval\n ' \n theQuery = \"[\" + replacefieldname + \"] = \" + oldval.quote \n theBitmap = theF Tab.GetSelection\n theFTab.Query(theQuery, theBitmap, #VTAB_SELTYPE_NEW) \n theFTab.SetSelection (theBitmap)\n theFTab.UpdateSelection\n '\n 'Replace selected records\n '\n calcstr = \"[\" + replacefieldname + \"].substitute(\" + oldval.quote +\",\" + newval.quote +\")\"\n theFTab.Calculate( calcstr, replacefield)\n end\n \n If (WasBeingEdited = False ) then\n theFTab.SetEditable(False)\n end\n\n \n theQuery = \"[\" + replacefieldname + \"] <> [\" + fldname + \"]\" \n\n theBitmap = theFTab.GetSelection\n theFTab.Query(theQuery, theBitmap, #VTAB_SELTYPE_NEW) \n theFTab.SetSelection (theBitmap)\n theFTab.UpdateSelection\n\n\n\nend" ) (Script.20 Name: "ScanCode.ShapeCompare" SourceCode: "'\n' Written by Harold Weepener\n' 2002-05-21\n'\n\n\n\n'Get the view\ntheView = av.GetActiveDoc\n'Determine if the doc is a view\nif (theView.is(View)) then\nelse\n Msgbox.info(\"Need a view!\", \"Aborting\")\n Return Nil\nend\n\n'get the themes\ntheThemes = theView.GetThemes \n\n'Check if we have the right number of themes\nif(thethemes.Count < 2) then\n Msgbox.info(\"Need 2 themes!\",\"Aborting\")\n Return nil\nend\n\nTheme1 = MsgBox.Choice (thethemes, \"Please select the first theme\", \"First Theme\")\n\nFtab1 = Theme1.GetFtab\n'Get the feature class of the FTab. If it is not polygon. then exit now!\nshapeClass = Ftab1.GetShapeClass\nif (shapeClass.GetClassName <> \"Polygon\") then\n Msgbox.info(\"Cannot Process non polygon theme!\", \"Aborting\")\n Return nil\nend\n\n'Get the string fields\nstrFields = List.Make\nAllFields = Ftab1.GetFields\nFor each Fielditem in AllFields\n if(Fielditem.GetType = #FIELD_CHAR) then\n strFields.Add(FieldItem)\n end\nend\n\nfld1 = MsgBox.listasstring(strFields, \"Choose the labelfield for \" + Theme1.getname,\"\")\n\n\n\nTheIndex = thethemes.Find (Theme1)\nthethemes.Remove(TheIndex)\n\nTheme2 = MsgBox.Choice (thethemes, \"Please select the second theme\", \"Second Theme\")\n\nFtab2 = Theme2.GetFtab\n'Get the feature class of the FTab. If it is not polygon. then exit now!\nshapeClass = Ftab2.GetShapeClass\nif (shapeClass.GetClassName <> \"Polygon\") then\n Msgbox.info(\"Cannot Process non polygon theme!\", \"Aborting\")\n Return nil\nend\n\n\n'Get the string fields\nstrFields.empty\nAllFields = Ftab2.GetFields\nFor each Fielditem in AllFields\n if(Fielditem .GetType = #FIELD_CHAR) then\n strFields.Add(FieldItem)\n end\nend\n\nfld2 = MsgBox.listasstring(strFields, \"Choose the labelfield for \" + Theme2.getname,\"\")\n\n\n\n\nreturn nil\n" ) (Script.21 Name: "ScanCode.Sliver" SourceCode: "' NAME: DissolveAdjacent.Calculate\n'\n' Last modified: August 9, 2001 \n'\n' TOPICS: ArcView 3.x, polygon, dissolve, merge, union, eliminate, adjacent, combine, sliver\n'\n' AUTHOR: Jeff Jenness\n' GIS Analyst\n' Jenness Enterprises\n' jeffj@jennessent.com\n'\n'\n' DESCRIPTION: This extension enables the user to eliminate small polygons by combining them with larger\n' adjacent polygons.  You begin by specifying a size limit and the extension will eliminate all polygons\n' smaller than thi s limit.  The extension creates a new shapefile of combined polygons so your original\n' polygon theme is not altered.  All attributes of the larger polygon will be saved.\n'\n' This function is especially useful for eliminating small sliver polygons that may be created during\n' digitizing, and is also useful for projects that require a set of polygons that are all greater than a\n' particular size.\n'\n' TWO OPTIONS FOR \"ADJACENT\":  This extension allows you to define \"adjacent\" as meaning that the two \n' polygo ns share either a common border or a common point.  If you imagine a chess board, two same-colored \n' squares that touch each other diagonally are adjacent at a single point.  This extension gives you the \n' option to decide whether that type of adjacency is good enough for your purposes, or if you need the two \n' polygons to share a common boundary.\n'\n' COMBINE WITH EITHER LARGEST OR SMALLEST ADJACENT POLYGON:  You may specify whether you want your small \n' polygons to be combined with either the largest o r the smallest adjacent polygon.  If two small polygons \n' combine, and the new polygon is larger than your specified limit, then that new polygon will not be combined \n' into any larger adjacent polygons.\n'\n' REPORT OF POLYGON ACTIONS:  After the extension finishes, you will get a report of all the small polygons \n' that were eliminated and which larger polygon they were combined with.  This report is saved to the hard \n' drive as a text file.\n'\n' REQUIRES: This extension requires at least a single polygo n theme present in a view.  This extension asks\n' for a field with unique values for each feature, but such a field is not necessary.  This extension also \n' requires that the file \"avdlog.dll\" be present in the ArcView/BIN32 directory (or $AVBIN/avdlog.dll) and \n' that the Dialog Designer extension be available in the ArcView/ext32 directory, which they almost certainly \n' are if you're running AV3.1 or higher. You don't have to load the Dialog Designer; it just has to be \n' available. \n'\n' SELF: n/a\n' \n' RETURNS: n/a\n'\n'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\ntheProject = av.GetProject\nDate.SetDefFormat (\"hh:m:s AMPM\")\ntheView = av.GetActiveDoc\nthePrj = theView.GetProjection\ntheWorkDir = av.GetProject.GetWorkDir\ntheWorkDirStr = theWorkDir.AsString\ntheDisplay = theView.GetDisplay\ntheGraphicsList = theView.GetGraphics\ntheOS = System.GetOS\n\nif (theView.getactivethemes.count = 0) then\n Msgbox.info (\"Please select a theme first.\",\"Warning\")\n Return Nil\nen d\n\n\n' SELECT THE THEME AND ANALYSIS OPTIONS\ntheInputTheme = theView.getactivethemes.get(0)\n\ntheInputFTab = theInputTheme.GetFTab\n\n\ntheFieldList = theInputFTab.GetFields\nif (theFieldList = Nil) then\n Msgbox.Info(\"Will not continue! No fields\",\"Aborting\")\n Return Nil\nend\ntheInputIDField=Msgbox.List(theFieldList,\"Select the polygon ID Field.\", \"Unique ID\")\nif (theInputIDField = Nil) then\n Return Nil\nend\n\nif (theInputIDField.getname = \"Shape\") then\n Msgbox.Error(\"The Shape field is not allowed\", \"Error\")\n Return Nil\nend\n\n\ntheMaxSize = MsgBox.Input(\"What is the minimum size?\",\"Area threshold\",\"\")\nif (theMaxSize = Nil) then\n Return Nil\nend\n\ntheSizeOption = \"optLargest\"\ntheAdjacencyOption = \"optBorder\"\n\nif (theAdjacencyOption = \"optBorder\") then\n theAdString = \"Dissolve if polygons share common border\"\nelse\n theAdString = \"Dissolve if polygons share any common points\"\nend\n\nif (theSizeOption = \"optSmallest\") then\n theSizeString = \"Dissolve into smallest adjacent polygon\"\nelse\n theSizeString = \"Dissolve into largest adjacent polygon\"\nend\n\n' FOR DEBUGGING\n'msgBox.ListAsString({theInputTheme.GetName, theInputIDField.AsString, theMaxSize.AsString, theSizeOption, theAdjacencyOption}, \"\", \"\")\n'return nil \n\n' CLEAR SELECTION. IT WILL BE RESTORED LATER -\n\ntheInputFTab = theInputTheme.GetFTab\ntheInputFTab.RememberSelection\ntheInputTheme.ClearSelection\n\n' CREATE SHAPEFILE IF REQUESTED: I CHECK FOR OPERATING SYSTEM BECAUSE THE FILE DIALOG BOX IN WINDOWS \n' WORKS BETTER WHEN USING THE '\\' SYMBOL RATHER THAN THE '/' SYMBOL IN THIS OPERATION.\n\nif (theOS = #SYSTEM_OS_MSW) then\n tempShapeFileString = \"\\dissolve.shp\"\nelse\n tempShapeFileString = \"/dissolve.shp\"\nend\ntempShapeFileName = FileName.Make(theWorkDirStr+tempShapeFileString)\ntempShapeCounter = 1\n\n' SUGGEST FILE NAME AND DIRECTORY, BUT NOT ONE THAT ALREADY EXISTS\n\nWhile (File.Exists(tempShapeFileName))\n tempShapeCounter = tempShapeCounter + 1\n if (theOS = #SYSTEM_OS_MSW) then\n tempShapeFileString = \"\\dissolve\"+tempShapeCounter.AsString+\".shp\"\n else\n tempS hapeFileString = \"/dissolve\"+tempShapeCounter.AsString+\".shp\"\n end\n tempShapeFileName = FileName.Make(theWorkDirStr+tempShapeFileString)\n if (File.Exists(tempShapeFileName).Not) then\n break\n end\nend\n\ntheFilename = FileDialog.Put(tempShapeFileName, \"*.shp\", \"Where do you want the dissolved polygon shapefile?\")\n\ntheFileNameString = theFilename.GetBaseName\n\nif (theFilename = nil) then \n msgBox.info (\"No dissolved polygon created: Exiting routine...\", \"Change of Plans:\")\n return nil\nend\n\n' CHANGE WOR K DIRECTORY TO SELECTED PATHNAME\n\ntheProject.SetWorkDir(theFileName.GetClass.GetCWD)\ntheWorkDirStr = theWorkDir.AsString\n\n' EXPORT POLYGON THEME TO NEW FTAB\n\nav.ClearStatus\nav.ShowMsg(\"Exporting \"+theInputTheme.GetName+\" to \"+theFileNameString+\"...\")\n\ntheWorkFTab = theInputTheme.ExportToFTab(theFilename)\ntheShapeField = theWorkFTab.FindField(\"Shape\")\ntheWorkFTab.SetEditable(True)\n\n' ADD AN ID FIELD IF NONE SELECTED\n\nnewName = \"rec_num\"\ntheFieldCount = 1\nif (theWorkFTab.FindField(newName) = nil) then\n theWo rkID = Field.Make(\"rec_num\", #FIELD_LONG, 10, 0)\nelse \n newName = \"rec_num_\"+theFieldCount.AsString \n while (theWorkFTab.FindField(newName) <> nil)\n theFieldCount = theFieldCount+1\n if (theWorkFTab.FindField(\"rec_num_\"+theFieldCount.AsString) = nil) then\n newName =(\"rec_num_\"+theFieldCount.AsString)\n break\n end\n end\n theWorkID = Field.Make(newName, #FIELD_LONG, 10, 0)\nend\n \ntheWorkFTab.AddFields({theWorkID})\ntheWorkFtab.Calculate(\"rec\", theWorkID)\n \ntheWorkIDName = theWorkID.Get Name\n\n' ADD AN ID FIELD IF NONE SELECTED\n\nif (theInputIDField = \"- No ID Field -\") then\n thePolygonIDField = theWorkFTab.FindField(newName) \nelse\n thePolygonIDField = theWorkFTab.FindField(theInputIDField.GetName)\nend\nthePolygonIDFieldName = thePolygonIDField.GetName\n \n' RESTORE SELECTION ON ORIGINAL POLYGON THEME, THEN DELETE IT FROM CURRENT MEMORY\ntheInputThemeName = theInputTheme.GetName\ntheInputFTab.SetSelection(theInputFTab.GetLastSelection.clone)\ntheInputFTab.UpdateSelection\ntheInputTheme = nil\n theInputFTab = nil\ntheInputIDField = nil\nav.PurgeObjects\n\n' CREATE REPORT:\ntempReportFileString = \"\\dis_report.txt\"\ntempReportFileName = FileName.Make(theWorkDirStr+tempReportFileString)\ntempReportCounter = 1\nWhile (File.Exists(tempReportFileName))\n tempReportCounter = tempReportCounter + 1\n tempReportFileString = \"\\dis_report\"+tempReportCounter.AsString+\".txt\"\n tempReportFileName = FileName.Make(theWorkDirStr+tempReportFileString)\n if (File.Exists(tempReportFileName).Not) then\n break\n end\nend\n\ntheR eport = LineFile.Make(tempReportFileName, #FILE_PERM_WRITE)\ntheReportPath = \" \"+tempReportFileName.GetFullName\n\n' -------------------------\n'-----------| ~~~ CALCULATE ~~~ | -----------\n' -------------------------\n\n\ntheRecordNumber = 0\n\n' ADD AREA FIELD\nav.ClearStatus\nav.ShowMsg(\"Calculating preliminary areas...\")\n\ntheAreaField = theWorkFTab.FindField(\"dslv_area\")\nif (theAreaField = nil) then\n theAreaField = Field.Make(\"dslv_area\", #FIELD_DOUBLE, 20, 6)\n theWorkFTab.AddFields({the AreaField})\nend\ntheWorkFTab.Calculate(\"[Shape].ReturnArea\", theAreaField)\n\n' QUERY FTAB FOR THOSE POLYGONS SMALLER THAN MINIMUM VALUE\ntest = theWorkFTab.Query(\"[dslv_area] < 0\"+theMaxSize.AsString, theWorkFTab.GetSelection, #VTAB_SELTYPE_NEW)\ntheWorkFTab.UpdateSelection\n\n' FOR DEBUGGING\n' msgBox.Info(test.AsString++theWorkFTab.GetNumSelRecords.AsString +\" < \"+theMaxSize.AsString, \"\")\n\n' MAKE DICTIONARY OF IDS AND AREAS\ntheSmallPolyDictionary = Dictionary.Make(theWorkFTab.GetNumSelRecords)\nfor each aRecord i n theWorkFTab.GetSelection\n theID = theWorkFTab.ReturnValue(theWorkID, aRecord)\n theArea = theWorkFTab.ReturnValue(theAreaField, aRecord)\n if (theSmallPolyDictionary.Get(theArea) = nil) then \n theSmallPolyDictionary.Add(theArea, theID)\n else\n while (theSmallPolyDictionary.Get(theArea) <> nil)\n theArea = theArea * 0.9999999\n if (theSmallPolyDictionary.Get(theArea) = nil) then\n theSmallPolyDictionary.Add(theArea, theID)\n break\n end\n end\n end\nend\n\n' WORK THROUGH SELEC TED POLYGONS, SMALLEST TO LARGEST, AND DISSOLVE THEM WITH ADJACENT POLYGONS\n\ntheSortedList = theSmallPolyDictionary.ReturnKeys\ntheSortedList.Sort(True)\n\n' FOR DEBUGGING\n'TestList = {}\n'for each AValue in theSortedList\n' TestList.Add(theSmallPolyDictionary.Get(aValue).AsString+\", \"+aValue.AsString)\n'end\n'msgBox.ListAsString(TestList, \"\", \"\")\n\ntheProblemList = {}\ntheRecordCount = theSortedList.Count\n \ntheReportString = \"-- DISSOLVE REPORT --\" +NL +\"~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\"+NL+\n \" P OLYGON THEME: \"+theInputThemeName+NL+\" SIZE OPTION: \"+theSizeString+NL+\n \" ADJACENCY OPTION: \"+theAdString+NL+\" SIZE CUTOFF: Dissolve polygons < \"+theMaxSize.AsString+\n \" square map units\"+NL +\" POLYGON COUNT: \"+theRecordCount.AsString+\" polygons are smaller than this limit\"\n +NL+\"~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\"+NL+\"Report saved to:\"+NL+theReportPath+NL+\n \"~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\"+NL\n\nfor each aSmallPolyArea in theSortedList\n theRecordNumber = theRecordNumbe r + 1\n\n theSmallID = theSmallPolyDictionary.Get(aSmallPolyArea)\n test = theWorkFTab.Query(\"[\"+theWorkIDName+\"] = \"+theSmallID.AsString, theWorkFTab.GetSelection, #VTAB_SELTYPE_NEW)\n theWorkFTab.UpdateSelection\n theSingleRecord = theWorkFTab.GetSelection.GetNextSet(-1)\n thePoly = theWorkFTab.ReturnValue(theShapeField, theSingleRecord)\n theOriginalReportID = theWorkFTab.ReturnValue(thePolygonIDField, theSingleRecord)\n \n ' CHECK SIZE OF POLYGON; IT MIGHT BE LARGE ENOUGH NOW IF IT'S BEEN MERGED WITH A S MALLER ONE\n if (thePoly.ReturnArea < theMaxSize.AsNumber) then \n\n theBitmapA = theWorkFTab.GetSelection.Clone\n \n theWorkFTab.SelectByShapes({thePoly}, #VTAB_SELTYPE_NEW)\n theWorkFTab.UpdateSelection\n \n theBitmapB = theWorkFTab.GetSelection.Clone\n \n theBitmapA.XOr(theBitmapB) ' SELECTS ALL ADJACENT POLYGONS, NOT ORIGINAL POLYGON\n theWorkFTab.SetSelection(theBitmapA)\n theWorkFTab.UpdateSelection\n \n ' FOR DEBUGGING\n ' ShouldStop = msgBox.YesNo(\"St op Routine\", \"\", True)\n ' if (shouldStop) then break end\n \n ' IF USER WANTS BORDER (NOT JUST POINT) ADJACENCY, DE-SELECT ANY POLYGONS THAT ONLY TOUCH AT A SINGLE POINT\n \n if (theAdjacencyOption = \"optBorder\") then\n theCheckBitmap = theWorkFTab.GetSelection.Clone\n for each theCheckPolygon in theWorkFTab.GetSelection\n theTestShape = theWorkFTab.ReturnValue(theShapeField, theCheckPolygon)\n theIntPointCount = theTestShape.PointIntersection(thePoly).AsList.Count\n if (t heIntPointCount = 1) then theCheckBitmap.Clear(theCheckPolygon) end\n end\n theWorkFTab.SetSelection(theCheckBitmap)\n theWorkFTab.UpdateSelection\n end\n \n ' IDENTIFY POLYGON TO DISSOLVE WITH\n\n if (theWorkFTab.GetNumSelRecords = 0) then ' IF POLYGON IS NOT NEXT TO ANY OTHER POLYGONS\n theProblemList.Add(theOriginalReportID)\n theStepString = theRecordNumber.AsString+\") Polygon \"+theOriginalReportID.AsString+\n \" (Size = \"+aSmallPolyArea.AsString+\") has no adjacent p olygons to merge with...\"+NL\n theReportString = theReportString+theStepString \n' theReportLineList.Add(theStepString)\n else\n theDissolvePoly = theWorkFTab.ReturnValue(theShapeField, theWorkFTab.GetSelection.GetNextSet(-1))\n theDissolveID = theWorkFTab.ReturnValue(theWorkID, theWorkFTab.GetSelection.GetNextSet(-1))\n theDissolveReportID = theWorkFTab.ReturnValue(thePolygonIDField, theWorkFTab.GetSelection.GetNextSet(-1))\n theDissolveSize = theDissolvePoly.ReturnArea\n for each AdjacentPolygon in theWorkFTab.GetSelection\n theTestPoly = theWorkFTab.ReturnValue(theShapeField, AdjacentPolygon)\n theTestID = theWorkFTab.ReturnValue(theWorkID, AdjacentPolygon)\n theTestReportID = theWorkFTab.ReturnValue(thePolygonIDField, AdjacentPolygon)\n if (theSizeOption = \"optSmallest\") then\n if (theTestPoly.ReturnArea < theDissolveSize) then\n theDissolvePoly = theTestPoly\n theDissolveSize = theTestPoly.ReturnArea\n theDissolve ID = theTestID\n theDissolveReportID = theTestReportID\n end\n elseif (theSizeOption = \"optLargest\") then\n if (theTestPoly.ReturnArea > theDissolveSize) then\n theDissolvePoly = theTestPoly\n theDissolveSize = theTestPoly.ReturnArea\n theDissolveID = theTestID\n theDissolveReportID = theTestReportID\n end\n end\n end\n \n ' UNION ORIGINAL AND DISSOLVE POLYGON SHAPES INTO NEW POLYGON SHAPE\n theNewPoly = th ePoly.ReturnUnion(theDissolvePoly)\n theNewPoly.Clean\n \n ' DELETE RECORD OF ORIGINAL POLYGON AND REPLACE DISSOLVE POLYGON SHAPE WITH NEW POLYGON SHAPE\n theWorkFTab.Query(\"[\"+theWorkIDName+\"] = \"+theSmallID.AsString, theWorkFTab.GetSelection, #VTAB_SELTYPE_NEW)\n theWorkFTab.UpdateSelection\n theWorkFTab.RemoveRecord (theWorkFTab.GetSelection.GetNextSet(-1))\n \n theWorkFTab.Query(\"[\"+theWorkIDName+\"] = \"+theDissolveID.AsString, theWorkFTab.GetSelection, #VTAB_SELTYPE_NEW)\n theWorkFTab.UpdateSelection\n theWorkFTab.SetValue(theShapeField, theWorkFTab.GetSelection.GetNextSet(-1), theNewPoly) \n \n theStepString = theRecordNumber.AsString+\") Dissolved Polygon \"+theOriginalReportID.AsString+\n \" (Size = \"+aSmallPolyArea.AsString+\") into Polygon \"+theDissolveReportID.AsString +\" (Size = \"+\n theDissolveSize.AsString+\")\"+NL\n theReportString = theReportString+theStepString\n' theReportLineList.Add(theStepString)\n \n ' FOR DEBUGGI NG \n ' theTestGraphic = GraphicShape.Make(theDissolvePoly)\n ' theGraphicsList.Add(theTestGraphic)\n ' theGraphicsList.Invalidate\n ' ShouldStop = msgBox.YesNo(\"Stop Routine\", \"\", True)\n ' if (shouldStop) then break end\n end ' END CHECKING IF POLYGON HAS ANY NEIGHBORS\n else\n theStepString = theRecordNumber.AsString+\") Polygon \"+theOriginalReportID.AsString+\n \" (Size = \"+thePoly.ReturnArea.AsString+\") previously combined with smaller polygon; now exceeds max si ze.\"+NL\n theReportString = theReportString+theStepString\n' theReportLineList.Add(theStepString)\n end ' END CHECKING TO SEE IF POLYGON IS LARGE ENOUGH\n \n \n\n \nend ' END WORKING THROUGH LIST OF SMALL POLYGONS\n\ntheWorkFTab.GetSelection.ClearAll\ntheWorkFTab.UpdateSelection\ntheWorkFTab.Calculate(\"[Shape].ReturnArea\", theAreaField)\ntheWorkFTab.SetEditable(False)\ntheTheme = FTheme.Make (theWorkFTab)\ntheView.AddTheme(theTheme)\n\ntheReport.Write({theReportString}, 1)\ntheReport.Close\n\n' SHOW LENGTH OF TIME IT TOOK TO RUN ANALYSIS\nEndTime = Date.Now\n\nif (theProblemList.Count>0) then\n MsgBox.ListAsString(theProblemList, \"The following polygons were smaller than the limit but had no adjacent polygons to dissolve with...\", \"WARNING:\")\nend\n\n\n\n" ) (Script.22 Name: "Install" SourceCode: "'CODE VALIDATION\n'BY EDGAR OKIOGA\n'ON 05/10/2000\n'PURPOSE: To install the extension as a menu item on the menu default menus\n' Edited By Harold Weepener\n'\n\n'Install ONLY if there is an active project\nif (av.GetProject = nil) then \n return nil\nend\n\n AllIcons = IconMgr.GetIcons\n IconDict= NameDictionary.Make( 100 ) \n for each i in AllIcons \n IconDict.Add( i ) \n end\n \n'remove existing objects owned by the extension from the project\ntablemenu = av.getproject.findGUI(\"Table\").GetMenuBar.FindByLabel(\"Africov er\")\nif (tablemenu <> Nil) then\n tablemenu.Empty\n 'Remove the menu\n av.GetProject.FindGUI(\"Table\").GetMenuBar.Remove(Tablemenu)\nend\n\nViewMenu = av.getproject.findGUI(\"View\").GetMenuBar.FindByLabel(\"Africover\")\nif (ViewMenu <> Nil) then\n ViewMenu.Empty\n 'Remove the menu\n av.GetProject.FindGUI(\"View\").GetMenuBar.Remove(ViewMenu)\nend\n\nTableButtonbar = av.getproject.findGUI(\"Table\").GetButtonbar\n\nButtonsToRemove = {\"AutoID\", \"recalc\"}\n\nfor each ButtonName in ButtonsToRemove\n TheButton = TableButtonbar.Fi ndByName(ButtonName)\n if (TheButton <> NIL)then\n TableButtonbar.Remove ( TheButton )\n end\nend\n\n\n \n'Now add the access control to the menu\n' Install the menu in the View DocGUI after the Window menu\ntableGUI = av.GetProject.FindGUI( \"Table\" )\nviewGUI = av.GetProject.FindGUI( \"View\" )\nif (tableGUI <> nil) then\n 'Find the position of the 'Table' menu item\n tablebuttonBar = tableGUI.GetMenuBar\n \n Newspace = Space.make\n ' Add new buttons \n newButton = Button.Make \n NewButton.SetName(\"AutoID\")\n newButton.SetIcon( IconDict.Get(\"ID\"))\n newButton.SetHelpTopic(\"Auto ID\") \n newButton.SetHelp (\"Auto ID//Auto ID\")\n newButton.SetClick( \"ScanCode.autoid\" ) \n ButtonIndex = tableGUI.GetButtonBar.GetControls.count + 1\n TableGUI.GetButtonBar.Add( Newspace, ButtonIndex )\n ButtonIndex = ButtonIndex + 1\n tableGUI.GetButtonBar.Add( newButton, ButtonIndex )\n\n newButton = Button.Make \n NewButton.SetName(\"recalc\")\n newButton.SetIcon( IconDict.Get(\"Redo\"))\n newButton.SetHelpTopic(\"Recalc code s\") \n newButton.SetHelp (\"Recalc codes//Recalc codes\")\n newButton.SetClick( \"ScanCode.recalc\" ) \n ButtonIndex = ButtonIndex + 1\n tableGUI.GetButtonBar.Add( newButton, ButtonIndex )\n\n\n ' Add new menu items\n \n tablemenu = tableGUI.GetMenuBar\n Newmenu = Menu.make\n Newmenu.SetLabel(\"&Africover\")\n tableMenu.Add(NewMenu, 999) 'Add to the lat item\n tableMenu = tableGUI.GetMenuBar.FindbyLabel(\"Africover\")\n place = tableGUI.GetMenuBar.GetControls.find(tablemenu)\n if (place <> -1) then\n MenuItem = Choice.make\n MenuItem.SetLabel(\"Recalculate codes\")\n MenuItem.SetName(\"Scan Code\")\n MenuItem.SetHelp(\"Recalculate codes\")\n MenuItem.SetClick(\"ScanCode.Recalc\")\n tableMenu.Add(MenuItem, 999) 'Add to the lat item\n\n MenuItem = Choice.make\n MenuItem.SetLabel(\"Describe codes\")\n MenuItem.SetName(\"Describe\")\n MenuItem.SetHelp(\"Describes the codes\")\n MenuItem.SetClick(\"ScanCode.Describe\")\n tableMenu.Add(MenuItem, 999) 'Add to the lat item\n ItemSpace = Space.Make\n tableMenu .Add(ItemSpace, 999) 'Add to the lat item\n\n 'Add the other script to make changes easy\n MenuItem4 = Choice.make\n MenuItem4.SetLabel(\"Create unique ID\")\n MenuItem4.SetName(\"AutoID\")\n MenuItem4.SetHelp(\"Add an unique ID to the table\")\n MenuItem4.SetClick(\"ScanCode.AutoID\")\n tableMenu.Add(MenuItem4, 999) 'Add to the last item\n 'Add the other script to make changes easy\n MenuItem5 = Choice.make\n MenuItem5.SetLabel(\"Append tables\")\n MenuItem5.SetName(\"Append tables\")\n MenuIt em5.SetHelp(\"Append tables to form one table\")\n MenuItem5.SetClick(\"ScanCode.Append\")\n tableMenu.Add(MenuItem5, 999) 'Add to the last item\n \n 'Add the other script to make changes easy\n MenuItem5 = Choice.make\n MenuItem5.SetLabel(\"Change width of field\")\n MenuItem5.SetName(\"Properties\")\n MenuItem5.SetHelp(\"Change width of field\")\n MenuItem5.SetClick(\"ScanCode.Properties\")\n tableMenu.Add(MenuItem5, 999) 'Add to the last item\n\n ItemSpace = Space.Make\n tableMenu.Add(ItemSp ace, 999) 'Add to the lat item\n\n\n 'Add the other script to make changes easy\n MenuItem6 = Choice.make\n MenuItem6.SetLabel(\"Find text\")\n MenuItem6.SetName(\"Findtbl\")\n MenuItem6.SetHelp(\"Find text\")\n MenuItem6.SetClick(\"ScanCode.findfromtable\")\n tableMenu.Add(MenuItem6, 999) 'Add to the last item\n \n 'Add the other script to make changes easy\n MenuItem6 = Choice.make\n MenuItem6.SetLabel(\"Replace text\")\n MenuItem6.SetName(\"Replacetbl\")\n MenuItem6.SetHelp(\"Replace text\")\n MenuItem6.SetClick(\"ScanCode.replacefromtable\")\n tableMenu.Add(MenuItem6, 999) 'Add to the last item\n\n\n end\nend\n'Append menus for the view\nif (ViewGUI <> nil) then\n Viewmenu = ViewGUI.GetMenuBar\n Newmenu = Menu.make\n Newmenu.SetLabel(\"&Africover\")\n viewMenu.Add(NewMenu, 999) 'Add to the lat item\n Viewmenu = ViewGUI.GetMenuBar.FindbyLabel(\"Africover\")\n place = ViewGUI.GetMenuBar.GetControls.find(ViewMenu)\n if (place <> -1) then\n \n 'Add the other script to make changes easy\n MenuItem 8 = Choice.make\n MenuItem8.SetLabel(\"Select multipart polygons\")\n MenuItem8.SetName(\"Multiplepolygons\")\n MenuItem8.SetHelp(\"Detects the presence of multipart polygons\")\n MenuItem8.SetClick(\"ScanCode.MultiplePoly\")\n ViewMenu.Add(MenuItem8, 999) 'Add to the last item\n MenuItem3 = Choice.make\n MenuItem3.SetLabel(\"Explode multipart polygons\")\n MenuItem3.SetName(\"Explode Polygons\")\n MenuItem3.SetHelp(\"Explode Multipart Polygons.\")\n MenuItem3.SetClick(\"ScanCode.Explode\")\n ViewMen u.Add(MenuItem3, 999) 'Add to the lat item \n\n ItemSpace = Space.Make\n ViewMenu.Add(ItemSpace, 999) 'Add to the lat item\n\n \n 'Add the other script to make changes easy\n MenuItem4 = Choice.make\n MenuItem4.SetLabel(\"Select bordering polygons\")\n MenuItem4.SetName(\"BORDERING\")\n MenuItem4.SetHelp(\"Select Border Polygons.\")\n MenuItem4.SetClick(\"ScanCode.BorderPoly\")\n MenuItem4.SetEnabled(True)\n ViewMenu.Add(MenuItem4, 999) 'Add to the lat item \n\n 'Add the other script to ma ke changes easy\n MenuItem4 = Choice.make\n MenuItem4.SetLabel(\"Clean shapefile, find gaps and overlaps\")\n MenuItem4.SetName(\"gaps\")\n MenuItem4.SetHelp(\"Clean shapefile, find gaps and overlaps\")\n MenuItem4.SetClick(\"ScanCode.gaps\")\n MenuItem4.SetEnabled(True)\n ViewMenu.Add(MenuItem4, 999) 'Add to the lat item\n \n \n 'Add the other script to make changes easy\n MenuItem9 = Choice.make\n MenuItem9.SetLabel(\"Eliminate sliver polygons\")\n MenuItem9.SetName(\"sliver\")\n MenuItem 9.SetHelp(\"Eliminate sliver polygons based on area and code\")\n MenuItem9.SetClick(\"ScanCode.Sliver\")\n ViewMenu.Add(MenuItem9, 999) 'Add to the last item\n ItemSpace = Space.Make\n ViewMenu.Add(ItemSpace, 999) 'Add to the lat item\n\n \n \n 'Add the other script to make changes easy\n MenuItem4 = Choice.make\n MenuItem4.SetLabel(\"Clip sequentially with polygons\")\n MenuItem4.SetName(\"Clip\")\n MenuItem4.SetHelp(\"Clip with polygons.\")\n MenuItem4.SetClick(\"ScanCode.clip\")\n MenuI tem4.SetEnabled(True)\n ViewMenu.Add(MenuItem4, 999) 'Add to the lat item \n \n \n 'Add the other script to make changes easy\n MenuItem4 = Choice.make\n MenuItem4.SetLabel(\"Create index grid (Pos. of images in view)\")\n MenuItem4.SetName(\"ImgPos\")\n MenuItem4.SetHelp(\"Get the extent of images in view.\")\n MenuItem4.SetClick(\"ScanCode.ImagePos\")\n MenuItem4.SetEnabled(True)\n ViewMenu.Add(MenuItem4, 999) 'Add to the lat item \n\n \n \n ItemSpace = Space.Make\n ViewMenu.Add (ItemSpace, 999) 'Add to the lat item\n\n \n 'Add the other script to make changes easy\n MenuItem6 = Choice.make\n MenuItem6.SetLabel(\"Find text\")\n MenuItem6.SetName(\"Find\")\n MenuItem6.SetHelp(\"Find text\")\n MenuItem6.SetClick(\"ScanCode.findfromtheme\")\n ViewMenu.Add(MenuItem6, 999) 'Add to the last item\n \n 'Add the other script to make changes easy\n MenuItem6 = Choice.make\n MenuItem6.SetLabel(\"Replace text\")\n MenuItem6.SetName(\"Replace\")\n MenuItem6.SetHelp(\"Replace text\")\n MenuItem6.SetClick(\"ScanCode.replacefromtheme\")\n ViewMenu.Add(MenuItem6, 999) 'Add to the last item\n \n ItemSpace = Space.Make\n ViewMenu.Add(ItemSpace, 999) 'Add to the lat item\n\n 'Add the other script to make changes easy\n MenuItem6 = Choice.make\n MenuItem6.SetLabel(\"Add X,Y fields to table\")\n MenuItem6.SetName(\"AddXY\")\n MenuItem6.SetHelp(\"Add XY\")\n MenuItem6.SetClick(\"ScanCode.Addxy\")\n ViewMenu.Add(MenuItem6, 999) 'Add to the last item\n \n 'Add the other script to make changes easy\n MenuItem6 = Choice.make\n MenuItem6.SetLabel(\"Get polygon centroids\")\n MenuItem6.SetName(\"centroids\")\n MenuItem6.SetHelp(\"Get polygon centroids\")\n MenuItem6.SetClick(\"ScanCode.centroid\")\n ViewMenu.Add(MenuItem6, 999) 'Add to the last item\n end\nend\n'Issue warning to the user\n_Message = False\n" ) (Script.23 Name: "Uninstall" SourceCode: "'CODE VALIDATION\n'BY EDGAR OKIOGA\n'ON 05/10/2000\n'PURPOSE: Remocve the menu item we have installed form the menu\n\n' Don't uninstall if there is no project\nif (av.GetProject = nil) then \n return nil\nend\n\n' Clean up even if the project is closing\n' don't uninstall extension objects if project is closing\nif (av.GetProject.IsClosing) then \n av.ClearGlobals\n return nil\nend\n\n' Remove objects owned by the extension from the project\ntablemenu = av.getproject.findGUI(\"Table\").GetMenuBar.FindByLabel(\"Africover\") \nif (tablemenu <> Nil) then\n tablemenu.Empty\n 'Remove the menu\n av.GetProject.FindGUI(\"Table\").GetMenuBar.Remove(Tablemenu)\nend\n\nTableButtonbar = av.getproject.findGUI(\"Table\").GetButtonbar\n\nButtonsToRemove = {\"AutoID\", \"recalc\"}\n\nfor each ButtonName in ButtonsToRemove\n TheButton = TableButtonbar.FindByName(ButtonName)\n if (TheButton <> NIL)then\n TableButtonbar.Remove ( TheButton )\n end\nend\n\n\n' Remove objects owned by the extension from the project\nViewMenu = av.getproject.findGUI(\"View\").GetMenuB ar.FindByLabel(\"Africover\")\nif (ViewMenu <> Nil) then\n ViewMenu.Empty\n 'Remove the menu\n av.GetProject.FindGUI(\"View\").GetMenuBar.Remove(ViewMenu)\nend\n\n" )