放射－ver.1.0

がらがらがらがらがら…

「ゆらぎ」と「重力」の両方をかけると、がらがら崩れ落ちたりなんかする。
伸びに伸びた「放射」、あれこれ内在していたエラーをあれこれ取り除きつつ一応完成。と言っても、もともとノープランで適当に作っているため、それはそれはテキトーなコードである。無駄に270行も費やしているあたり、いかにも頭が悪い。

ErrorBreakMode(0, 0, 0)
%pn = GetPage()
%fp1 = CountFigsPage(%pn)
%lpatern = GetLinePattern()

!!図形を指定
%fnp = GetSelectFig()
do
	if %fnp = nil
		SelectFig?()
		%err = ErrorCode()
		if %err then
			stop
		end if
		%fnp = GetSelectFig()
	else
		exit do
	end if
loop
LinePattern(1, 1, , "R25G25B25", , , , , , )
EditDisplayMode(0)
%fn = Size(%fnp)
for %i = 1 to %fn
	%fd = GetFigDocument(%pn, %fnp(%i))
	%fr = CalcFigRegion(%fd)
	%figCenter(%i, 1) = GetX(%fr("座標1")) + GetX(%fr("座標2"))
	%figCenter(%i, 2) = GetY(%fr("座標1")) + GetY(%fr("座標2"))
	%figRegion(%i) = %fr
next

!!放射の中心をドラッグして指定
TemporaryMode()
DrawMode(3)
WaitMouseButton?(1, 1)
do
	if IsMouseButton(1) then
		WaitMouseButton?(1, 1)
		%mpa = GetMousePoint()
		%mpax = GetX(%mpa)
		%mpay = GetY(%mpa)
		if %mpa <> %mpa2 then
			for %i = 1 to %fn step 1
				%fc2(%i, 1) = %figCenter(%i, 1) - %mpax
				%fc2(%i, 2) = %figCenter(%i, 2) - %mpay
			next
			Redraw
			for %i = 1 to %fn step 1
				Line(%mpa, #[%fc2(%i, 1), %fc2(%i, 2)])
			next
		end if
	else
		exit do
	end if
		%mpa2 = %mpa
loop

!!放射の範囲をドラッグして指定
for %i = 1 to %fn step 1
	%lengths(%i) = ((%mpax - %fc2(%i, 1)) ^ 2 + (%mpay - %fc2(%i, 2)) ^ 2)
next
SortArray(%lengths, 2, )
%maxLength = %lengths(1) ^ 0.5
Circle(%mpa, %maxLength, , , 0, 0)
WaitMouseButton?(1, 1)
do
	if IsMouseButton(1) then
		WaitMouseButton?(1, 1)
		%mpb = GetMousePoint()
		%mpbx = GetX(%mpb)
		%mpby = GetY(%mpb)
		if %mpb <> %mpb2 then
			%length = ((%mpax - %mpbx) ^ 2 + (%mpay - %mpby) ^ 2) ^ 0.5
			%rate = %length / %maxLength
			for %i = 1 to %fn step 1
				%fc3(%i, 1) = (%fc2(%i, 1) - %mpax) * %rate + %mpax
				%fc3(%i, 2) = (%fc2(%i, 2) - %mpay) * %rate + %mpay
			next
			Redraw
			if %rate < 0.5 then
				LinePattern(1, 1, , "R255G25B35", , , , , , )
			else
				LinePattern(1, 1, , "R25G25B25", , , , , , )
			end if
			Circle(%mpa, %length, , , 0, 0)
			for %i = 1 to %fn step 1
				Line(%mpa, #[%fc3(%i, 1), %fc3(%i, 2)])
			next
		end if
	else
		exit do
	end if
		%mpb2 = %mpb
loop

!!設定
%ret = OpenMacroDialog ("radiate", )
%rep = %ret("repetition")
if %ret("cancel") then
	Redraw
	stop
end if
if %ret("repType") = "division" then
	%reptype = 1
else if %ret("repType") = "interval" then
	%reptype = 2
end if

!!複写
for %i = 1 to %fn step 1
	%fl(%i, 1) = %fc3(%i, 1) - ((GetX(%figRegion(%i, "座標2")) - GetX(%figRegion(%i, "座標1"))) / 2)
	%fl(%i, 2) = %fc3(%i, 2) - ((GetY(%figRegion(%i, "座標2")) - GetY(%figRegion(%i, "座標1"))) / 2)
next
DisplayMode(0)
for %i = 1 to %fn step 1
	PutSelectFig(, {%fnp(%i)})
	Copy(, #[%fl(%i, 1), %fl(%i, 2)], , , %reptype, %rep, )
	%err = ErrorCode()
	if %err then
		%copyerr = 1
	end if
	Progress("複写処理中...", %i, %fn)
next

!!ゆらぎ処理
%fp2 = CountFigsPage(%pn)
%fFigRegion = GetFigRegion(%pn, %fp1, %fp2)

!!移動
if %ret("move") > 0 then
	for %i = 1 to %fn step 1
		%maxMove = ((%fc3(%i, 1) - %mpax) ^ 2 + (%fc3(%i, 2) - %mpay) ^ 2) ^ 0.5 * %ret("move") / 20
		for %j = 1 to %rep step 1
			%err = Exist(%fFigRegion((%i - 1) * %rep + %j))
			if not %err then
				continue for
			end if
			%move((%i - 1) * %rep + %j, 1) = %fFigRegion((%i - 1) * %rep + %j, 1, 1) + Int(Rand() * %maxMove) - %maxMove / 2
			%move((%i - 1) * %rep + %j, 2) = %fFigRegion((%i - 1) * %rep + %j, 1, 2) + Int(Rand() * %maxMove) - %maxMove / 2
		next
	next
	for %i = %fp1 + 1 to %fp2 step 1
		PutSelectFig(, {%i})
		Move(, #[%move(%i - %fp1, 1), %move(%i - %fp1, 2)], , , )
		%err = ErrorCode()
		if %err then
			%moveerr = 2
		end if
		Progress("移動処理中...", %i, %fp2)
	next
end if

!!重力
if %ret("gravity") <> 0 then
	%accel = %ret("gravity") / 5
	if %ret("move") <> 0 then
		%gravity = %move
	else
		for %i = 1 to %fp2 - %fp1 step 1
			%gravity(%i, 1) = %fFigRegion(%i, 1, 1)
			%gravity(%i, 2) = %fFigRegion(%i, 1, 2)
		next
	end if
	for %i = 1 to %fn step 1
		for %j = 1 to %rep step 1
			%err = Exist(%fFigRegion((%i - 1) * %rep + %j))
			if not %err then
				continue for
			end if
			%gravity((%i - 1) * %rep + %j, 3) = %gravity((%i - 1) * %rep + %j, 2) + (%j ^ 2) * %accel
		next
	next
	for %i = %fp1 + 1 to %fp2 step 1
		PutSelectFig(, {%i})
		Move(, #[%gravity(%i - %fp1, 1), %gravity(%i - %fp1, 3)], , , )
		%err = ErrorCode()
		if %err then
			%gravityerr = 4
		end if
		Progress("重力処理中...", %i, %fp2)
	next
end if

!!回転
%fFigRegion = GetFigRegion(%pn, %fp1, %fp2)
if %ret("rotate") > 0 then
	for %i = 1 to %fp2 - %fp1 step 1
		%fFigCenter(%i) = #[(%fFigRegion(%i, 1, 1) + %fFigRegion(%i, 2, 1)) / 2, \\
		(%fFigRegion(%i, 1, 2) + %fFigRegion(%i, 2, 2)) / 2]
	next
	for %i = %fp1 + 1 to %fp2 step 1
		%angle = Int(Rand() * 36 * %ret("rotate")) - 18 * %ret("rotate")
		PutSelectFig(, {%i})
		Rotate(%angle, %fFigCenter(%i - %fp1), 0, , 0)
		Progress("回転処理中...", %i, %fp2)
	next
end if

!!終了処理
%fp3 = CountFigsPage(%pn)
for %i = 1 to %fp3 - %fp1 step 1
	%select(%i) = %fp1 + %i
next
PutSelectFig(, %select)
DisplayMode(1)
Redraw
Guidance("")
%error = %copyerr + %moveerr + %gravityerr
if %error <> nil then
	select case %error
	case 1
		%msg = "複写処理中"
	case 2
		%msg = "移動処理中"
	case 3
		%msg = "複写処理、移動処理中"
	case 4
		%msg = "重力処理中"
	case 5
		%msg = "複写処理、重力処理中"
	case 6
		%msg = "移動処理、重力処理中"
	case 7
		%msg = "複写処理、移動処理、重力処理中"
	end select
	%para = {.Title = "正常に処理できない図形がありました", .Icon = 4, .Button = 5, .Default = 2}
	%continue = MsgBox(%msg & "に一部の図形が領域外に出ました。処理を続行しますか？", %para)
	if %continue = 7 then
		Delete(, )
		PutSelectFig(, %fnp)
	end if
end if

function Progress(%message, %numerator, %denominator)
	%p = nil
	%r = nil
	%pn = Round(%numerator / %denominator, 1) * 10
	%rn = 10 - %pn
	for %i = 1 to %pn step 1
		%p = %p & "■"
	next
	for %i = 1 to %rn step 1
		%r = %r & "□"
	next
	Guidance(%message & " " & %p & %r)
end function

function GetFigRegion(%pn, %fp1, %fp2)
	for %i = 1 to %fp2 - %fp1 step 1
		%fd = GetFigDocument(%pn, %i + %fp1)
		%ffr = CalcFigRegion(%fd)
		%fFigRegion(%i, 1, 1) = GetX(%ffr("座標1"))
		%fFigRegion(%i, 1, 2) = GetY(%ffr("座標1"))
		%fFigRegion(%i, 2, 1) = GetX(%ffr("座標2"))
		%fFigRegion(%i, 2, 2) = GetY(%ffr("座標2"))
	next
	GetFigRegion = %fFigRegion
end function

---

ちなみに、いちいちマクロ本体とフォームをそれぞれ手作業でセットアップするのは面倒だなぁ、ということで、通常の花子のファイルに図面マクロの形で保存してみた。 http://members.jcom.home.ne.jp/t-usuda2/cg/macro/housha-ver.1.0.jhdc ↑のファイルをダウンロード、花子で開く。図面そのものは空っぽなものの、図面マクロの形で「放射」が保存されている。 そこで、「ツール」→「マクロ」→「変更」と操作。ここから先は感覚的に分かると思うが、表示されたダイアログ上で、図面マクロとして登録されている「放射」をシステムマクロにコピーするだけ。

タグ：マクロ