2005年06月29日

SelectPath

選択した二つのエッジを繋ぐようにエッジを選択するスクリプト
SiloのSelectPathが便利だったので作ってみた

SelectPath 

シンメトリーモードで使えないことはないが、使えないと思ったほうが良いかも
もし使うとしたら、
シンメトリーをOFF→このスクリプト→選択を左右対称にするコマンドかスクリプト(あれば)→シンメトリーON
みたいなマクロを作った方が良いと思う

#! perl

#
# SelectPath
#
# 選択した二つのエッジを繋ぐようにエッジを選択します
#

 

my $mainLayer = lxq("query layerservice layers ? main");
my $numSelEdge = lxq("query layerservice edge.N ? selected");
my @selEdge = lxq("query layerservice edges ? selected");

my $errorMsg;
my @route;


if( 1 == &errorCheck ){
 lxout("--- SelectPath.pl --- START");
 
 #最短距離を求める
 my $shortest = &getShortest($selEdge[0], $selEdge[1]);
 lxout("shortest: $shortest");
 
 #最短距離の道順を頂点の配列@routeに保存
 my @start = lxq("query layerservice edge.vertList ? $selEdge[0]");
 my @goal = lxq("query layerservice edge.vertList ? $selEdge[1]");
 @route = ($start[0], $start[1], $goal[0], $goal[1]);
 foreach my $v (@start){
  if( 1 == &getRoute($v, $goal[0], $goal[1], 1, $shortest) ){
   last;
  }
 }
 lxout("route: @route");
 
 #
 lx("select.drop vertex");
 foreach my $v (@route){
  lx("select.element $mainLayer vertex add $v");
 }
 lx("select.convert edge");
 
 
 lxout("--- SelectPath.pl --- END");
}else{
 lx("dialog.setup error");
 lx("dialog.msg $errorMsg");
 lx("dialog.open");
}

 

 

# errorCheck
sub errorCheck
{
# lxout("--- errorCheck ---");
 # エッジモードでない
 if( !lxq("select.typeFrom typelist:edge;vertex;polygon;item ?") ){
  $errorMsg = "Must be in Edge selection mode.";
  return 0;
 }
 # 選択されたエッジが2つではない
 if( 2 != $numSelEdge ){
  $errorMsg = "Select 2 edges.";
  return 0;
 }
 # 選択されたエッジが既に繋がっている
 lx("select.convert vertex");
 my $temp = lxq("query layerservice vert.N ? selected");
 if( 4 != $temp ){
  $errorMsg = "The edges have already connected.";
  return 0;
 }
 # 選択されたエッジ同士が繋がることがありえない
 lx("select.drop edge");
 my @verts = lxq("query layerservice edge.vertList ? $selEdge[0]");
 lx("select.element $mainLayer edge set $verts[0] $verts[1]");
 lx("select.connect");
 if( !lxq("query layerservice edge.selected ? $selEdge[1]") ){
  $errorMsg = "The edges will not connect.";
  return 0;
 }
 return 1;
}

 

# getShortest(edge1, edge2)
sub getShortest
{
 my @verts = lxq("query layerservice edge.vertList ? $_[0]");
 lx("select.drop vertex");
 lx("select.element $mainLayer vertex set $verts[0]");
 lx("select.element $mainLayer vertex add $verts[1]");
 @verts = lxq("query layerservice edge.vertList ? $_[1]");
 my $count = 1;
 my $num1 = lxq("query layerservice vert.N ? selected");
 while( 1 ){
  lx("select.expand");
  my @sels = lxq("query layerservice verts ? selected");
#  lxout("sel: @sels");
  foreach my $v (@verts){
   foreach my $s (@sels){
    if( $v == $s ){
     return $count;
    }
   }
  }
  $count++;
  
  my $num2 = lxq("query layerservice vert.N ? selected");
  if( $num1 == $num2 ){
   die("The edges will not connect.");
  }
  $num1 = $num2;
 }
 
}

 

# getRoute($vert, $v1, $v2, $count, $shortest)
sub getRoute
{
 my ($vert, $v1, $v2, $count, $shortest) = @_;
 
 if( $vert == $v1 || $vert == $v2 ){
  push(@route, $vert);
  return 1;
 }elsif( $count > $shortest ){
  return 0;
 }else{
  my @verts = lxq("query layerservice vert.vertList ? $vert");
  foreach $v (@verts){
   my $result = getRoute($v, $v1, $v2, $count+1, $shortest);
   if( 1 == $result ){
    push(@route, $v);
    return 1;
   }
   lxout("sub");
  }
  return 0;
 }
}

 

 

【関連する記事】
posted by toka at 16:08| Comment(0) | TrackBack(0) | modo: perl | このブログの読者になる | 更新情報をチェックする
この記事へのコメント
コメントを書く
お名前:

メールアドレス:

ホームページアドレス:

コメント:


この記事へのトラックバック
×

この広告は90日以上新しい記事の投稿がないブログに表示されております。