WEB2.0なロゴの作成
新しい記事
JW外変用プロシージャ集
Hinoが外部変形に使用しているプロシージャ(コード)を置いてあります
ファイルオープン時にマクロを実行する
ファイルの書き出し
外部テキストファイルの参照方法
ステータスバーにメッセージを表示する
使用済みセルの最終行を取得する
使用済みセルの最終列を取得する
点が多角形の内部にあるか
点と線分の距離
2点の角度を求める
座標の回転
ファイルの有無をチェックする
多角形ソリッド図形の面積取得
ファイルを保存せずにエクセルを終了する
アクティブスケール取得
作図基点取得
jwc_temp.txt内からレイヤ定義を探す
jwc_temp.txt内からレイヤグループ定義を探す
jwc_temp.txt内から線種定義を探す
jwc_temp.txt内から線色定義を探す
ファイルオープン時にマクロを実行する
ファイルの書き出し
外部テキストファイルの参照方法
ステータスバーにメッセージを表示する
使用済みセルの最終行を取得する
使用済みセルの最終列を取得する
点が多角形の内部にあるか
点と線分の距離
2点の角度を求める
座標の回転
ファイルの有無をチェックする
多角形ソリッド図形の面積取得
ファイルを保存せずにエクセルを終了する
アクティブスケール取得
作図基点取得
jwc_temp.txt内からレイヤ定義を探す
jwc_temp.txt内からレイヤグループ定義を探す
jwc_temp.txt内から線種定義を探す
jwc_temp.txt内から線色定義を探す
Hino 00:29 2007.02.08 Thu
Hino 00:33 2007.11.04 Sun
Hino 21:44 2007.11.10 Sat
Hino 13:26 2007.11.11 Sun
新しい記事
2点の角度を求める
SSub get_angle(x1, y1, x2, y2, angl) pai = 3.14159265358979 xx = x2 - x1: yy = y2 - y1 If yy = 0 Then If 0 < xx Then angl = 0 If xx < 0 Then angl = pai GoTo endline End If If xx = 0 Then If 0 < yy Then angl = pai / 2 If yy < 0 Then angl = -pai / 2 GoTo endline End If angl = Atn(yy / xx) If xx < 0 Then angl = angl + pai endline: End Sub
■ 説明 ■
x1,y1,x2,y2:各点の各座標
angl:点1を原点として点2がなす角度を反時計回りに計算して返します
Hino 00:22 2007.02.08 Thu
新しい記事
jwc_temp.txt内から線色定義を探す
Sub linecolor_get(tmp, lc_tmp)
'jwc_temp.txt内から線色定義を探す
Dim a, b
a = Split(tmp) 'スペースで切り分け
b = UBound(a) '切り分けられた区分数を取得
If b = 0 And Left(a(0), 2) = "lc" Then '線色定義文字列の場合
lc_tmp = Right(a(0), 1) '線色を「lc_tmp」に格納
End If
End Sub
Hino 00:30 2007.01.25 Thu
新しい記事
jwc_temp.txt内から線種定義を探す
Sub linetype_get(tmp, lt_tmp)
'jwc_temp.txt内から線種定義を探す
Dim a, b
a = Split(tmp) 'スペースで切り分け
b = UBound(a) '切り分けられた区分数を取得
If b = 0 And Left(a(0), 2) = "lt" Then '線種定義文字列の場合
lt_tmp = Right(a(0), 1) '線種を「lt_tmp」に格納
End If
End Sub
Hino 00:30 2007.01.25 Thu
新しい記事
jwc_temp.txt内からレイヤグループ定義を探す
Sub group_get(tmp, lg_tmp)
'jwc_temp.txt内からレイヤグループ定義を探す
Dim a, b
a = Split(tmp) 'スペースで切り分け
b = UBound(a) '切り分けられた区分数を取得
If b = 0 And Left(a(0), 2) = "lg" Then 'レイヤグループ定義文字列の場合
lg_tmp = Right(a(0), 1) 'レイヤグループ番号を「ly_tmp」に16進数で取得
End If
End Sub
Hino 00:29 2007.01.25 Thu
新しい記事
jwc_temp.txt内からレイヤ定義を探す
Sub linetype_get(tmp, lt_tmp)
'jwc_temp.txt内から線種定義を探す
Dim a, b
a = Split(tmp) 'スペースで切り分け
b = UBound(a) '切り分けられた区分数を取得
If b = 0 And Left(a(0), 2) = "lt" Then '線種定義文字列の場合
lt_tmp = Right(a(0), 1) '線種を「lt_tmp」に格納
End If
End Sub
Hino 00:28 2007.01.25 Thu
新しい記事
作図基点取得
"hp"に求める基点の番号を指定し戻り値のx0,y0を記してCallで呼びます。
ex: Call Get_hp(2 ,x0 ,y0)
ex: Call Get_hp(2 ,x0 ,y0)
Sub Get_hp(hp, x, y) |
Hino 00:00 2007.01.25 Thu
新しい記事
アクティブスケール取得
Sub Get_Scale(Active_Scale) |
Hino 23:59 2007.01.24 Wed
新しい記事
ファイルを保存せずにエクセルを終了する
新しい記事
多角形ソリッド図形の面積取得
Sub solid_s_get(tmp, s) temp = tmp & " 0 0" s = 0 a = Split(temp) If UBound(a) = 8 Then a(7) = a(1): a(8) = a(2) If UBound(a) >= 8 And a(0) = "sl" Then
x0 = Val(a(1)) '各座標を格納
x1 = 0
x2 = (a(3) - x0) / 1000
x3 = (a(5) - x0) / 1000
x4 = (a(7) - x0) / 1000
y0 = Val(a(2))
y1 = 0
y2 = (a(4) - y0) / 1000
y3 = (a(6) - y0) / 1000
y4 = (a(8) - y0) / 1000
la1 = Sqr((x1 - x2) ^ 2 + (y1 - y2) ^ 2)
la2 = Sqr((x2 - x3) ^ 2 + (y2 - y3) ^ 2)
la3 = Sqr((x3 - x4) ^ 2 + (y3 - y4) ^ 2)
la4 = Sqr((x4 - x1) ^ 2 + (y4 - y1) ^ 2)
la5 = Sqr((x3 - x1) ^ 2 + (y3 - y1) ^ 2)
sh1 = (la1 + la2 + la5) / 2
s1 = Sqr(sh1 * (sh1 - la1) * (sh1 - la2) * (sh1 - la5))
sh2 = (la3 + la4 + la5) / 2
s2 = Sqr(sh2 * (sh2 - la3) * (sh2 - la4) * (sh2 - la5))
s = s1 + s2
End If
End Sub
※使用例
tmp = jwc_temp_txt.readline
s=0
call solid_s_get(tmp, s)
tmpにはjwc_temp.txtから読み込んだ1行を代入する
sは戻り値を得るためのダミーとして0値を代入しておく
Hino 23:58 2007.01.24 Wed
新しい記事
ファイルの有無をチェックする
Sub exist_or_not_1(Filename,exists)
'絶対パス+ファイル名で検索する場合
Dim pth As String
pth = Filename '<ファイル名を指定
If CreateObject("Scripting.FileSystemObject").FileExists(pth) = True Then
exists=true
Else
exists=false
End If
End Sub
Sub exist_or_not_2(Filename,exists)
'ブックと同じフォルダのファイルを探す場合
Dim pth As String
pth = ThisWorkbook.Path & "\" & Filename '<ファイル名を指定
If CreateObject("Scripting.FileSystemObject").FileExists(pth) = True Then
exists=true
Else
exists=false
End If
End Sub
※何れもcallで呼び出します.ファイルが存在すれば「exists」に「true」を返します.
Hino 23:58 2007.01.24 Wed
新しい記事
点と線分の距離
Sub get_distance_p_l(xx, yy, x1, y1, x2, y2, distance) dx = (x2 - x1): dy = (y2 - y1) a = dx ^ 2 + dy ^ 2: b = dx * (x1 - xx) + dy * (y1 - yy) t = -b / a If t < 0 Then t = 0 If t > 1 Then t = 1 tx = x1 + dx * t: ty = y1 + dy * t distance = Sqr((xx - tx) ^ 2 + (yy - ty) ^ 2) End Sub
※distanceに距離が格納されます
こちらのサイトやこちらのサイトを参考にさせていただきました
Hino 23:57 2007.01.24 Wed
新しい記事
点が多角形の内部にあるか
Sub in_out_check(bs, xx, yy, x1, y1, x2, y2, in_out) in_out = False sub_row = bs.Cells(Rows.Count, 1).End(xlUp).Row For check_row = 2 To sub_row x1 = bs.Cells(check_row, 1) - xx y1 = bs.Cells(check_row, 2) - yy x2 = bs.Cells(check_row, 3) - xx y2 = bs.Cells(check_row, 4) - yy If y1 * y2 > 0 Then GoTo bottom If x1 < 0 And x2 < 0 Then GoTo bottom If x1 + y1 * (x2 - x1) / (y1 - y2) >= 0 Then check_count = check_count + 1 End If bottom: Next check_row If check_count Mod 2 = 1 Then in_out = True End Sub
■ 説明 ■
callで呼び出します
bs 多角形座標が転記されているシート名
xx 対象点X座標
yy 対象点Y座標
x1,y1,x2,y2 線分の端部座標
check_count 交差回数(奇数ならば多角形内部にある)
in_out 内部ならtrue 外部ならfalseを返します
多角形座標をシートに転記した場合で記述してあります。
メイン部分は代入が終わった後のif文以降ですので
必要に応じて書き換えてください
■ 追記 ■
十分な長さを持つ線分と、多角形の各辺が交わる回数が
・奇数であれば多角形内
・偶数ならば多角形外
という定理を使用しています。
点1を原点として、各辺がX軸と交差するかどうかを全ての辺に対して判定し、
交差した回数を観察して判定させています。
Hino 23:56 2007.01.24 Wed
新しい記事
使用済みセルの最終列を取得する
For b = 255 To 1 Step -1 Cells(a, b).Select If Cells(a, b).Value <> "" Then Exit For Next b
a 検索する行番号
b 最終列を返します
※エクセルは列数が255までしか使用できません。
※短い上に使用頻度が低いのでスクリプト内に埋め込む場合で記述してあります。
Hino 23:56 2007.01.24 Wed
新しい記事
使用済みセルの最終行を取得する
1.シート全体の最終行を取得します
last_row = ss.UsedRange.Rows.Count
2.特定の列での最終行を取得します
last_row = Cells(Rows.Count, 1).End(xlUp).Row
※ここでは1列目を参照しています。
2列目を参照するためには
last_row = Cells(Rows.Count, 2).End(xlUp).Row
でOKです。
last_row = ss.UsedRange.Rows.Count
2.特定の列での最終行を取得します
last_row = Cells(Rows.Count, 1).End(xlUp).Row
※ここでは1列目を参照しています。
2列目を参照するためには
last_row = Cells(Rows.Count, 2).End(xlUp).Row
でOKです。
Hino 23:55 2007.01.24 Wed
新しい記事
ステータスバーにメッセージを表示する
Application.StatusBar = "メッセージ"
※これは Applicaton.ScreenUpdating=False でも有効です
※これは Applicaton.ScreenUpdating=False でも有効です
Hino 23:55 2007.01.24 Wed
新しい記事
外部テキストファイルの参照方法
新しい記事
ファイルの書き出し
新しい記事
Excel
新しい記事
「Excel で Web2.0 風画像を量産する方法」
[Link]
という記事を見て少し応用してみました。