Changes between Initial Version and Version 1 of PerlMapScriptExamples35ex10

Timestamp:

01/29/09 06:53:17 (4 years ago)

Author:

jmckenna

Comment:

--

PerlMapScriptExamples35ex10

@@ +1 @@
+= anno_crvt.pl =
+
+The parcel.tar.gz url is http://www.highwayengineer.co.medina.oh.us/parcel.tar.gz
+{{{
+#!perl
+#!/usr/bin/perl
+#
+# Copyright (C) 2002, Lowell Filak
+# You may distribute this file under the terms of the Artistic
+# License.
+#
+# Given an arcinfo coverage name this routine will convert the annotations
+#   (TX6/TX7 ONLY) from the first annotation subclass into a line shapefile.
+#
+# Required modules are mapscript (installed as part of make install)
+#    & Getopt (normally included with Perl).
+#   Please download parcel.tar.gz also, and:
+#     tar -xf parcel.tar.gz --ungzip
+#
+# Additional requirements are a working copy of avcexport
+#   (http://pages.infinit.net/danmo/e00/index.html) & a working copy of egrep.
+#
+# All of the information regarding the layout of the TX6&TX7 sections can
+#   be found with the avcexport package.
+#
+# Suggested run line = ./anno_cnvt.pl -cover=parcel
+#
+# Include the mapscript module.
+use mapscript;
+#
+# Include the xbase module for creating the dbf records.
+use XBase;
+#
+# Include the getopt module to read input.
+use Getopt::Long;
+#
+# Grab the filename from the input.
+&GetOptions("cover=s", \$cover);
+#
+# Check the input filename.
+if(!$cover) {
+  print "Syntax: anno_cnvt.pl -cover=[coverage_name]\n";
+  exit 0;
+}
+#
+# Create a unique name for the export file.
+#
+# Grab the time.
+my $sec = 0;
+my $min = 0;
+my $hr = 0;
+my $mnth = 0;
+my $yr = 0;
+my $wdy = 0;
+my $ydy = 0;
+my $isdst = 0;
+($sec,$min,$hr,$mdy,$mnth,$yr,$wdy,$ydy,$isdst) = localtime;
+#
+# Grab the process id.
+$spid = $$;
+#
+# Create the name & make sure it is no longer than 8 characters.
+$efile = "$hr$min$sec$spid";
+#
+# Create a name for the new shapefile from the original coverage name.
+# No longer than 8 characters.
+$sfile = substr($cover, -6) . "xa";
+#
+# Use avcexport to create an export file of the coverage.
+system("avcexport $cover $efile.e00");
+#
+# Use grep to quickly clip out everything before the annotation.
+system("grep -A 1000000000 '^TX' $efile.e00 > $efile.clp; mv $efile.clp $efile.e00");
+#
+# Open the export file for reading in the annotation information.
+open(E00, "<$efile.e00");
+#
+# Set the number of annotation coordinates to 0 to start with.
+my $num_cords = 0;
+#
+# Set the number of annotation characters to 0 to start with.
+my $num_chars = 0;
+#
+# Set the input file to an array so shift & cousins can be used.
+my @export = <E00>;
+#
+# Close the export file.
+close E00;
+#
+# Shift off the annotation type marker and record it.
+my $ano_type = shift(@export);
+#
+# Shift off the subclass name and record it.
+my $ano_name = shift(@export);
+$ano_name =~ s/\015\012|\015|\012//g;
+#
+# How many remaining lines are there.
+my $line_cnt = scalar(@export);
+#
+# Create the xbase call.
+my $xbcall = 'XBase->create(name => "' . $sfile . '.dbf", field_names => ["RECNO", "TEXT" ], field_types => ["N", "C"], field_lengths => ["6", "254"], field_decimals => ["undef", "undef"]) or die XBase->errstr;';
+#
+# Create the dbf file.
+$dbh = eval($xbcall);
+#
+# Create the shapefile.
+my $shapef = new shapefileObj("$sfile",$mapscript::MS_SHAPEFILE_ARC);
+#
+# Create a point object for holding the retrieved coordinates.
+my $point = new pointObj();
+#
+# Start the dbf record count at 0.
+my $dbfreccnt = 0;
+#
+# Loop through each line of the export file.
+for ($ln=0; $ln<$line_cnt; $ln++) {
+  #
+  # Create a line object for holding the created lines.
+  my $line = new lineObj();
+  #
+  # Create a shape object for holding the created line shapes.
+  my $shape = new shapeObj($mapscript::MS_SHAPE_LINE);
+  #
+  # Split the 1st line apart.
+  my @ln1_prts = split(' ', shift(@export));
+  #
+  # Pull out any good values (there should be at least 7).
+  my @gd_prts = grep { defined $_ } @ln1_prts;
+  #
+  # Check for end of annotation section.
+  if ( $gd_prts[0] == -1 ) {
+    last;
+  }
+  #
+  # Clear and reset the values for the 1st line.
+  @ln1_prts = ();
+  @ln1_prts = @gd_prts;
+  #
+  # How many anno vertices are there.
+  my $vrt_cnt = $ln1_prts[2];
+  #
+  # How many arrow vertices are there.
+  my $vrt_arr = $ln1_prts[3];
+  #
+  # How many characters in text string.
+  my $chr_cnt = $ln1_prts[6];
+  #
+  # Is the text string longer than 0.
+  if ( $chr_cnt > 0 ) {
+    #
+    # Divide the character count by 80 to set the number of text lines.
+    $chr_cnt = $chr_cnt / 80;
+  }
+   else {
+    $chr_cnt = 1;
+   }
+  #
+  # Print out the counts to see if we got this right.
+  #print "Annotation Vetices = $vrt_cnt\nArrow Vertices = $vrt_arr\nText Characters = $chr_cnt\n";
+  #
+  # Drop lines 2-9.
+  for ($drop=1; $drop<9; $drop++) {
+    my $grbg = shift(@export);
+  }
+  #
+  # Read in the first vertex.
+  my @vrt1_prts = split(' ', shift(@export));
+  #
+  # Pull out any good values (there should be at least 2).
+  @gd_prts = grep { defined $_ } @vrt1_prts;
+  #
+  # Clear and reset the values for the 1st vertex line.
+  @vrt1_prts = ();
+  @vrt1_prts = @gd_prts;
+  $vrt1_prts[1] =~ s/\015\012|\015|\012//g;
+  #
+  # If there is only one coordinate then manufacture a second coordinate.
+  if ( $vrt_cnt < 2 ) {
+    $vrtl_prts[0] = $vrt1_prts[0] + 1;
+    $vrtl_prts[1] = $vrt1_prts[0];
+  }
+   else {
+    #
+    # Read in the last vertex.
+    # At this point everything except the first and last can be dropped
+    #   because of how feature labels are handled.
+    for ($vrtx=1; $vrtx<$vrt_cnt; $vrtx++) {
+      @vrtl_prts = split(' ', shift(@export));
+    }
+    #
+    # Pull out any good values (there should be at least 2).
+    my @gd_prts = grep { defined $_ } @vrtl_prts;
+    #
+    # Clear and reset the values for the last vertex line.
+    @vrtl_prts = ();
+    @vrtl_prts = @gd_prts;
+    $vrtl_prts[1] =~ s/\015\012|\015|\012//g;
+   }
+  #
+  # Drop all the arrow vertices.
+  for ($drop=0; $drop<$vrt_arr; $drop++) {
+    my $grbg = shift(@export);
+  }
+  #
+  # Set the initial text string to blank;
+  my $text = '';
+  #
+  # Loop through each text line and append together.
+  for ($txt=0; $txt<$chr_cnt; $txt++) {
+    my $strng = shift(@export);
+    $strng =~ s/\015\012|\015|\012//g;
+    $text = $text . $strng;
+  }
+  #
+  # If the text string is blank then jump to the next annotation.
+  if ( !$text ) {
+    next;
+  }
+   else {
+   }
+  #
+  # Print the results to see if we got this right.
+  #print "Text String = $text\n";
+  #
+  # Convert from scientific notation.
+  # This may not be needed but just in case...
+  $vrt1_prts[0] = $vrt1_prts[0] - 0;
+  $vrt1_prts[1] = $vrt1_prts[1] - 0;
+  #
+  # Assign the point x & y for the first point.
+  $point->{x} = $vrt1_prts[0];
+  $point->{y} = $vrt1_prts[1];
+  #
+  # Add the point to the line.
+  $line->add($point);
+  #
+  # Do the same for the second point.
+  $vrtl_prts[0] = $vrtl_prts[0] - 0;
+  $vrtl_prts[1] = $vrtl_prts[1] - 0;
+  #
+  # Assign the point x & y for the first point.
+  $point->{x} = $vrtl_prts[0];
+  $point->{y} = $vrtl_prts[1];
+  #
+  # Add the point to the line.
+  $line->add($point);
+  #
+  # Add the line to the shape.
+  $shape->add($line);
+  #
+  # Add the shape to the shapefile.
+  $shapef->add($shape);
+  #
+  # Clear out the line object.
+  undef $line;
+  #
+  # Clear out the shape object.
+  undef $shape;
+  #
+  # Add the text & record number to the dbf as attributes.
+  # Record number is not needed but it will help if at some point
+  #   there is a need to select all annotation containing 'COUNTY'.
+  #
+  # Create the xbase add record call.
+  my $xbadd = '$dbh->set_record($dbfreccnt, $dbfreccnt, "$text");';
+  #
+  # Add the record to the dbf file.
+  eval($xbadd);
+  #
+  # Increment the dbf record counter.
+  $dbfreccnt = $dbfreccnt + 1;
+}
+#
+# Close the new shapefile.
+undef $shapef;
+#
+# Close the dbf handle/file.
+undef $dbh;
+#
+# Print the number of converted annotations.
+print "$dbfreccnt Annotations Were Converted from Subclass $ano_name into $sfile.shp.\n";
+#
+# Get rid of the export file.
+unlink "$efile.e00";
+}}}
+----
+back to PerlMapScript