SplitCurve

カーブを分割するコマンドが見当たらなかったので、スクリプトを書いてみた

 

#! perl

#
# SplitCurve
#
# 選択した頂点でカーブを分割する
#

my $mainLayer = lxq("query layerservice layers ? main");
my $errorMsg;

my @curves = ();
my $selVert;

if( 1 == &errorCheck ){
 lxout("--- SplitCurve.pl --- START");
 
 my @cverts;
 foreach my $c (@curves){
  @cverts = ();
  my @vlist = lxq("query layerservice poly.vertList ? $c");
  while( my $v = shift(@vlist) ){
   push(@cverts, $v);
   if( $v == $selVert ){
    unshift(@vlist, $v);
    last;
   }
  }
  my $num = @cverts;
  if( 1 < $num ){
   &makeCurve(@cverts);
  }
  $num = @vlist;
  if( 1 < $num ){
   &makeCurve(@vlist);
  }
 }
 
 lx("select.drop polygon");
 foreach my $c (@curves){
  lx("select.element $mainLayer polygon add $c");
 }
 lx("select.delete");

 lxout("--- SplitCurve.pl --- END");
}else{
 lx("dialog.setup error");
 lx("dialog.msg $errorMsg");
 lx("dialog.open");
}

 

sub makeCurve
{
 lx("select.drop vertex");
 foreach my $v (@_){
  lx("select.element $mainLayer vertex add $v");
 }
 lx("poly.makeCurveOpen");
}

sub errorCheck
{
 # 頂点モードでない
 if( !lxq("select.typeFrom typelist:vertex;edge;polygon;item ?") ){
  $errorMsg = "Must be in Vertex selection mode.";
  return 0;
 }
 
 # 選択した頂点を含むカーブが無い
 $selVert = lxq("query layerservice verts ? selected");
 my @plist = lxq("query layerservice vert.polyList ? $selVert");
 foreach my $p (@plist){
  my $type = lxq("query layerservice poly.type ? $p");
  if( "curve" == $type ){
   push(@curves, $p);
  }
 }
 my $num = @curves;
 if( 0 == $num ){
  $errorMsg = "No curve include selected vertices.";
  return 0;
 }
 
 return 1;
}