Skip to content

PerlMapScriptExamples35ex10

Thomas Bonfort edited this page Apr 6, 2012 · 2 revisions

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 PerlMapScrip

Clone this wiki locally