ベジエに沿って回転させつつ複写－なんちゃってベータ版

この強風はどうにかならんのじゃろか、という今日この頃。けっこう切実。

---

日の出前から自宅で業務。その合間に、先日テストしたマクロにちょいと手を加えてみる。
とりあえず基本的な動作はするようになった。

肝心のコードは以下。

ErrorBreakMode(0, 0, 0)
%pn = GetPage()
%fnAll = CountFigsPage(%pn)

!!複写する図形を指定
Message("複写する図形を指定して下さい", 1)
do
	if %fnCopy = nil then
		SelectFig?()
		%err = ErrorCode()
		if %err then
			stop
		end if
		%fnCopy = GetSelectFig()
	else
		exit do
	end if
loop

!!図形の中心を指定
Message("複写する図形の中心を指定して下さい", 1)
Dot?()
%err = ErrorCode()
if %err then
	stop
end if
%dot = GetFigDocument(%pn, %fnAll + 1)
%dotdata = GetDotData(%dot)
%dotX = GetX(%dotdata)
%dotY = GetY(%dotdata)
Delete(, )
%fd = GetFigDocument(%pn, %fnCopy(1))
%sp = CalcFigRegion(%fd)
%spx = GetX(%sp("座標1"))
%spy = GetY(%sp("座標1"))
%objectX = %spx - %dotX
%objectY = %spy - %dotY

!!基準になるベジエ曲線を指定
Message("ベジエ曲線を指定して下さい", 1)
do
	SelectFig?()
	%err = ErrorCode()
	if %err then
		stop
	end if
	%fnBezier = GetSelectFig()
	%fd = GetFigDocument(%pn, %fnBezier(1))
	%ft = GetFigType(%fd)
	if %ft = "ベジエ曲線" then
		exit do
	else
		Message("扱えない図形です－ベジエ曲線を指定し直して下さい", 1)
	end if
loop

!!等分数を指定
%divide = InputNumber("複写数を指定して下さい", 2, 1, 99, 50)

EditDisplayMode(0)
DisplayMode(0)

!!座標を計算
Copy(, , , , , , )
PutSelectFig(%pn, {%fnAll + 1})
Divide(2, , %divide, , , , , , )
for %i = 1 to %divide step 1
	%fd = GetFigDocument(%pn, %fnAll + %i)
	%coord = GetBezierData(%fd)
	%coordArray(%i, 1) = %coord(1, 1)
	%coordArray(%i, 2) = -Angle(GetX(%coord(1, 3)), GetY(%coord(1, 3))) * 180 / Pi()
	%coordArray(%i, 3) = #[GetX(%coord(1, 1)) + %objectX, GetY(%coord(1, 1)) + %objectY]
	%gradient(%i) = %fnAll + %i
next

!!コピーと回転
for %i = 1 to %divide step 1
	PutSelectFig(%pn, %fnCopy)
	Copy(, %coordArray(%i, 3), , , , , )
	Rotate(%coordArray(%i, 2), %coordArray(%i, 1), , , )
next

!!余計な図形を消す
PutSelectFig(%pn, %gradient)
Delete(,)

EditDisplayMode(1)
DisplayMode(1)
RedrawAll()

タグ：マクロ