多角形から曲線(円弧補間(4点))を生成するスクリプトです。
閉じた多角形を選択すれば閉じた曲線になります。円弧補間(4点)の曲線がどのようなものかは、前の投稿をご覧下さい。
注意：以下のスクリプトにはバグが多数あります。
procedure PolyToCurve;
{ 選択した多角形から曲線を作る(放物線補間(4点、2等分法)) }
{$ DEBUG}
label
999, 1000;
const
PolygonObj = 5;
nL = 5;
type
PointImfo = structure
dir :integer;
p, pc :vector;
rad, d :real;
hasArc, isArc :boolean;
end;
var
pt :dynArray[] of PointImfo;
i, iL, n :integer;
d :real;
p :vector;
hp, h, tmp :handle;
closed :boolean;
{$INCLUDE :vs_subroutins:If.vss}
{$INCLUDE :vs_subroutins:Basic.vss}
{$INCLUDE :vs_subroutins:Add_Inc_Dec.vss}
{$INCLUDE :vs_subroutins:KSSErrMsg.vss}
{$INCLUDE :vs_subroutins:Calc.vss}
{$INCLUDE :vs_subroutins:Small.vss}
{$INCLUDE :vs_subroutins:Large.vss}
{$INCLUDE :vs_subroutins:Swap.vss}
{$INCLUDE :vs_subroutins:SwapByOrder.vss}
{$INCLUDE :vs_subroutins:compound_type.vss}
{$INCLUDE :vs_subroutins:GetDefault.vss}
{$INCLUDE :vs_subroutins:Interpolation.vss}
{$INCLUDE :vs_subroutins:Math.vss}
{$INCLUDE :vs_subroutins:Math-Arc.vss}
{$INCLUDE :vs_subroutins:Drawing.vss}
{$INCLUDE :vs_subroutins:Drawing-New.vss}
{$INCLUDE :vs_subroutins:3d-Drawing.vss}
function GetPoints(h :handle): integer;
var
i, n :integer;
begin
closed:= IsPolyClosed(h);
n:= GetVertNum(h);
Allocate pt[-1..n + 2];
for i:= 1 to n do begin{ 点座標の取得 }
GetPolyPt(h, i, pt[i].p.x, pt[i].p.y);
pt[i].p.z:= 0;
pt[i].hasArc:= closed | ((1 < i) & (i < n));
end;
if closed then begin
pt[n+1]:= pt[1]; pt[n+2]:= pt[2];
pt[-1]:= pt[n-1]; pt[0]:= pt[n];
end;
GetPoints:= n;
end;{GetPoints}
function GetArcCenterAndDir(p9, p0, p1 :vector; var cnt :vector; var dir :integer): boolean;
var
ang :real;
v0, v1 :vector;
result :boolean;
begin
result:= SME2ArcCenterV(p9, p0, p1, cnt);
if result then begin
v0:= p0 - p9;
v1:= p1 - p0;
ang:= AzimuthByVecs(v0, v1);
dir:= Sign(ang);
end
else
dir:= 0;
GetArcCenterAndDir:= result;
end;{GetArcCenterAndDir}
function GetNewPt(i :integer; var p :vector): boolean;
var
ang, rad :real;
p0, p1, pc, pm :vector;
v, v0, v1, vc, vcc, vv :vector;
begin
p0:= pt[i].p; p1:= pt[i+1].p;
pm:= (p0 + p1) / 2;
if pt[i].hasArc then begin
if pt[i].isArc then
v0:= RotVec(UnitVec(pt[i].pc - p0), -pt[i].dir * 90)
else
v0:= UnitVec(p1 - p0);
end;
if pt[i+1].hasArc then begin
if pt[i+1].isArc then
v1:= RotVec(UnitVec(pt[i+1].pc - p0), -pt[i+1].dir * 90)
else
v1:= UnitVec(p1 - p0);
end;
if pt[i].hasArc then
if pt[i+1].hasArc then
v:= VecVec2MidAzimuthVec(v0, v1)
else
v:= v0
else if pt[i+1].hasArc then
v:= v1;
if SVE2ArcCenterV(p0, v, p1, pc) then begin
rad:= Vec2Dist(p0 - pc);
ang:= Vec2Ang(p1 - p0);
vc:= UnitVec(pc - pm);
vcc:= RotVec(vc, -ang);
vv:= RotVec(v, -ang);
p:= pc + Sign(vcc.y) * Sign(vv.y) * vc * rad;
end
else
p:= pm;
d:= Vec2Dist(p - pm);
GetNewPt:= true;
end;{GetNewPt}
begin {main}
hp:= FSActLayer;
h:= hp;
if (h = Nil) | (GetTypeN(h) <> PolygonObj) then GoTo 1000;
iL:= 1;
d:= 4/9 * GetDefaultWS('曲線', '誤差', 1.0, true);
while (iL <= nL) do begin
n:= GetPoints(h);
if n < 3 then GoTo 999;
for i:= 1 to n do begin
if pt[i].hasArc then begin{ 円弧の中心と回転方向を取得 }
pt[i].isArc:= GetArcCenterAndDir(pt[i-1].p, pt[i].p, pt[i+1].p, pt[i].pc, pt[i].dir);
if pt[i].isArc then begin
pt[i].rad:= Vec2Dist(pt[i-1].p - pt[i].pc);
end;
end;
end;
if closed then begin
pt[n+1]:= pt[1]; pt[n+2]:= pt[2];
pt[-1]:= pt[n-1]; pt[0]:= pt[n];
end;
if closed then
ClosePoly
else
OpenPoly;
BeginPoly;
for i:= 1 to n do begin
AddPointV(pt[i].p);
if closed | (i < n) then begin
if GetNewPt(i, p) then
if pt[i].d < d then
AddPointV(p);
end;
end;
EndPoly;
if h <> hp then
DelObject(h);
h:= LNewObj;
iL:= iL + 1;
end;
999:
SetDSelect(hp);
ReDrawAll;
1000:
end; {main}
Run(PolyToCurve);