☆ igsselect  IGES ->IGES コンバーター

  IGES から、特定の TYPE要素だけを取り出して、IGES として
出力するプログラム（perlスクリプト）です。

  下記は、IGES から

     TYPE=114 パラメトリックスプラインサーフェス
     TYPE=128 有利Ｂスプラインサーフェス
     TYPE=144 トリムドサーフェス

だけを取り出すようになっています。

  perl の分かる方は、他の要素を取り出すように変更したりすることも
出来ると思います。

  IGES は、ポインタが相互参照するという非常に複雑な構造をしています。
ポインタの相互参照をうまく解きほぐして、再度 IGES として組み立てるには
複雑なアルゴリズムのプログラムを要するのですが、perl という言語は
この複雑なアルゴリズムを出来る限り簡単に記述できる強力な言語です。
  短いスクリプトの中に複雑なアルゴリズムがまとめられていると思っています。

  $ igsselect <old_igs.igs >new_igs.igs

----------^ igsselect
#!/usr/bin/perl

#close(STDIN);
#open(STDIN,"t.is") || die "Cannnot open \n";

@outel=(  ## IGES-type-No for outputing
   114,128,144
);  
%refd=( ## A:B  P-sec A番目から P-sec B番目の数だけ D-secへのポインタとみなす
  100," ",      ## circular arc
  102,"2:1",    ## composite curve
  104," ",      ## conic arc
  106," ",      ## coious data
  108,"5",      ## plane
  110," ",      ## line entity
  112," ",      ## parametric spline curve
  114," ",      ## parametric spline surface
  116,"4",      ## point
  124," ",      ## transformation matrix
  126," ",      ## rational b-spline curve
  128," ",      ## rational b-spline surface
  202,"1 2 3 7 8",  ## angular dimension
  212," ",          ## general note
  214," ",          ## Leader
  216,"1 2 3 4 5 6",## linear dimension
  222,"1 2",        ## radius dimension
  142,"2 3 4",  ## curve on a parametric surface
  144,"1 4 5:3",## trimmed surface
  308,"4:3",    ## subfigure definition
  402,"2:1",    ## associativity instance (assumed form=7)
  404,"2:1:4",  ## drawing
  406," ",      ## property
  408,"1",      ## singular subfigure instance
  410,"3 4 5 6 7 8" ## view
);
################### read iges-file
while (<STDIN>) {
  local($f72,$sec,$n)=unpack("a72 a1 a7",$_);
  if      ($sec eq "S") {
    $ssec[$n]=$f72
  } elsif ($sec eq "G") {
    $gsec[$n]=$f72
  } elsif ($sec eq "D") {
    $dsec[($n+1)/2].=$f72   ## 2 lines
  } elsif ($sec eq "P") {
    local($data,$pd)=unpack("a64 a8",$f72);
    $psec[($pd+1)/2].=$data;
  }
}

################### check outputting element
for($i=1;$i<@dsec;$i++) {
    &analyzed($i,1) if (grep($_==($k=0+unpack("a8",$dsec[$i])),@outel));
}
for($i=1,$j=1;$i<@dsec;$i++) {  ## make newdi[$i]
  if ($dcheck[$i]) {
    $newdi[$i]=$j++;
  } else {
    $newdi[$i]=0;
  }
}
$newdmax=$j-1;  ## max of new d-sec 
$newdi[0]=0.5;  ## pointer 0 --> 0

################## output iges-file
for($i=1;$i<@ssec;$i++) {
  printf("%72sS%7d\n",$ssec[$i],$i);
}
for($i=1;$i<@gsec;$i++) {
  printf("%72sG%7d\n",$gsec[$i],$i);
}
$pcount=1;  ## counter for P-sec
for($i=1;$i<@dsec;$i++) {
    print &analyzed($i,0) if ($dcheck[$i]);
}
$pcount=1;  ## counter for P-sec
for($i=1;$i<@dsec;$i++) {
  if ($dcheck[$i]) {
    local($s)=$psec[$i];
    while ($s) {
      printf("%64s%8dP%7d\n",substr($s,0,64),$newdi[$i]*2-1,$pcount++);
      substr($s,0,64)='';
    }
  }
}
printf("S%7dG%7dD%7dP%7d%40sT%7d\n",$#ssec,$#gsec,$newdmax*2,$pcount-1,'',1);

################# subroutine for analyze d-sec
sub analyzed {
  local($n,$pass)=@_;    ## n:(DsecNo+1)/2  pass=true:mark  pass=false:rewrite
  return &warnmsg("Pointer($n) is too large (n=$n)") if ($n>=@dsec);
  return 0 if ($pass && $dcheck[$n]);
  $dcheck[$n]=1 if ($pass);
  local($type,$pp,$a17_48,$trans,$a57_72,$b1_24,$pc,$b33_72)=
    unpack("a8 a8 a32 a8 a16 a24 a8 a40",$dsec[$n]);
  ########### p-sec
  local($refd)=$refd{$type+0};
  if ($refd) {
    local(@p)=split(/\n*,\n*/,$psec[$n]);
    local($i,$j,$s,$sn);
    foreach $i (split(" ",$refd)) {
      ($s,$sn,$ss)=split(":",$i);
      if (!$ss) {$ss=1;}
      if (!$sn) {$sn=$s+1;} else {$sn=$s+$ss*$p[$sn];}
      for($j=$s; $j<$sn; $j+=$ss) {
        if ($pass) {
          if ($p[$j]>1) {
            &analyzed(($p[$j]+1)/2,$pass);
          } elsif ($p[$j]<0) {
            &warnmsg("Pointer in P-Section($p[$j])<0  (n=$n)\n");
          }
        } else {
          $p[$j]=$newdi[($p[$j]+1)/2]*2-1;
        }
      }
    }
    if (!$pass) {
      $s=join(",",@p); $i=-1;
      $s=~s/;?( *$)/;/;
      while (length($s)-1-$i>64) {
        $j=rindex($s,",",$i+=64);
        substr($s,$j+1,0)=" " x ($i-$j) unless (substr($s,$j+1,$i-$j)=~/^ *$/);
      }
      $s.=" " x ($i+64-length($s)+1);
#print "::length:" . length($psec[$n]) . "-->" . length($s) . "\n";
#while($s) {
#  print substr($s,  0,64) ."\n";
#  substr($s, 0,64)='';
#}
      $psec[$n]=$s;
    }
  } else {
      &warnmsg("Not defined type <$type>");
      $refd{$type+0}=" ";  ## Not output error-message 2times
  }
  ########### d-sec
  if ($pass) {
     &analyzed(($trans+1)/2,$pass) if ($trans > 0);
  } else {
    $pp=$pcount;  $pcount+=($pc=length($psec[$n])/64);
    $trans=$newdi[($trans+1)/2]*2-1 if ($trans > 0);
    $s=$newdi[$n]*2-1;
    sprintf("%8s%8d%32s%8d%16sD%7d\n%24s%8d%40sD%7d\n",
       $type,$pp,$a17_48,$trans,$a57_72,$s,$b1_24,$pc,$b33_72,$s+1);
  }
}
sub warnmsg {
  local($msg)=@_;
  print STDERR "=warning= $msg at " . __FILE__  . " line " . __LINE__ . ".\n";
}
----------$ igsselect