備忘録 課題 円弧を使う時の座標出力
G01とG02／G03を区別するコード
VBA
Option Explicit
Sub ボタン1_Click()
Dim ws As Worksheet
Set ws = ActiveSheet
Dim XBASE As Double
If Trim$(ws.Range("B1").Value) = "" Then
MsgBox "B1（基準直径）が空です。例：510 を入れてください。"
Exit Sub
End If
XBASE = CDbl(ws.Range("B1").Value) ' 基準直径（例 510）
Dim xzPath As String
xzPath = "C:\jww\xz.txt" ' JWWの座標ファイル（事前に作っておく）
Dim csvPath As String
csvPath = "C:\jww\result.csv" ' Python出力
Dim pyPath As String
pyPath = "C:\jww\convert.py" ' Pythonスクリプト
'========================
' 出力欄クリア（残骸防止）
'========================
ws.Range("D1:H2000").Clear
ws.Range("D1").Value = "X0"
ws.Range("E1").Value = "Z0"
ws.Range("F1").Value = "X(dia)"
ws.Range("G1").Value = "Z"
ws.Range("H1").Value = "R"
'========================
' xz.txt があるか確認（消さない）
'========================
If Dir(xzPath) = "" Then
MsgBox "xz.txt が見つかりません。先にJw_cadで " & xzPath & " を作成してください。"
Exit Sub
End If
'========================
' result.csv は毎回消す（読み違い防止）
'========================
If Not DeleteFileIfExists(csvPath) Then Exit Sub
'========================
' Python実行（完了まで待つ）
'========================
If Dir(pyPath) = "" Then
MsgBox "convert.py が見つかりません：" & vbCrLf & pyPath
Exit Sub
End If
Dim cmd As String
cmd = "cmd /c python """ & pyPath & """"
Dim wsh As Object
Set wsh = CreateObject("WScript.Shell")
wsh.Run cmd, 0, True
'========================
' result.csv 確認
'========================
If Dir(csvPath) = "" Then
MsgBox "result.csv が作成されていません。convert.py を確認してください。"
Exit Sub
End If
'========================
' CSV読み込み（x0,z0,r）
' ※3列目が空でも落ちない
'========================
Dim lineText As String, arr
Dim r As Long: r = 2
Open csvPath For Input As #1
Do Until EOF(1)
Line Input #1, lineText
lineText = Trim$(lineText)
If Len(lineText) = 0 Then GoTo ContinueLoop
arr = Split(lineText, ",")
If UBound(arr) < 1 Then GoTo ContinueLoop ' x0,z0 必須
Dim x0 As Double, z0 As Double
If Not IsNumeric(arr(0)) Or Not IsNumeric(arr(1)) Then GoTo ContinueLoop
x0 = CDbl(arr(0))
z0 = CDbl(arr(1))
' (0,0)除外（あなたのルール）
If (x0 = 0# And z0 = 0#) Then GoTo ContinueLoop
Dim rr As String
rr = ""
If UBound(arr) >= 2 Then
rr = Trim$(arr(2)) ' 空でもOK
End If
' 書き込み
ws.Cells(r, "D").Value = x0
ws.Cells(r, "E").Value = z0
ws.Cells(r, "F").Value = XBASE + (2# * x0)
ws.Cells(r, "G").Value = z0
ws.Cells(r, "H").Value = rr
' Rがある行だけ色付け（見分け用）
If Len(rr) > 0 Then
ws.Range(ws.Cells(r, "D"), ws.Cells(r, "H")).Interior.Color = RGB(255, 255, 153) '薄黄色
ws.Cells(r, "H").Font.Bold = True
End If
r = r + 1
ContinueLoop:
Loop
Close #1
' 表示形式
If r > 2 Then
ws.Range("D2:H" & r - 1).NumberFormat = "0.0000"
End If
'========================
' 重要：処理後に xz.txt を退避（累積防止）
'========================
Call ArchiveXzFile(xzPath)
MsgBox "座標変換完了（RはH列、xz.txt は退避しました）"
End Sub
'------------------------------------------------------------
' ファイル削除。削除できなければ理由を出してFalse
'------------------------------------------------------------
Private Function DeleteFileIfExists(ByVal path As String) As Boolean
On Error GoTo EH
If Dir(path) <> "" Then
Kill path
If Dir(path) <> "" Then
MsgBox "ファイルを削除できません：" & vbCrLf & path & vbCrLf & _
"Excelで開いている/同期ロック等の可能性があります。閉じてから再実行してください。"
DeleteFileIfExists = False
Exit Function
End If
End If
DeleteFileIfExists = True
Exit Function
EH:
MsgBox "ファイル削除でエラー：" & vbCrLf & path & vbCrLf & _
"エラー内容: " & Err.Description
DeleteFileIfExists = False
End Function
'------------------------------------------------------------
' xz.txt をタイムスタンプ付きで退避（累積を防ぐ）
'------------------------------------------------------------
Private Sub ArchiveXzFile(ByVal xzPath As String)
On Error GoTo EH
If Dir(xzPath) = "" Then Exit Sub
Dim folder As String
folder = Left$(xzPath, InStrRev(xzPath, "\"))
Dim ts As String
ts = Format$(Now, "yyyymmdd_HHMMSS")
Dim dst As String
dst = folder & "xz_" & ts & ".txt"
Name xzPath As dst
Exit Sub
EH:
' 退避できなくても変換自体は完了しているので止めない
End Sub
PYTHON
import math
INFILE = r"C:\jww\xz.txt"
OUTFILE = r"C:\jww\result.csv"
ROUND_N = 4
TOL = 0.02 # mm
def r4(x): return round(float(x), ROUND_N)
# --- 読み取り ---
segments = []
arcs = [] # (cx,cz,R,a1,a2)
with open(INFILE, "r", encoding="utf-8", errors="ignore") as f:
for line in f:
s = line.strip()
if not s:
continue
parts = s.split()
# 円弧: ci cx cy R a1 a2 ...
if parts[0].lower() == "ci" and len(parts) >= 6:
try:
cx = float(parts[1]); cz = float(parts[2]); R = float(parts[3])
a1 = float(parts[4]); a2 = float(parts[5])
except ValueError:
continue
arcs.append((cx,cz,R,a1,a2))
continue
# 線分: x1 z1 x2 z2
if len(parts) == 4:
try:
x1,z1,x2,z2 = map(float, parts)
except ValueError:
continue
segments.append(((x1,z1),(x2,z2)))
# --- 8点用の点集合（線分端点） ---
pts = set()
for p1,p2 in segments:
pts.add((r4(p1[0]), r4(p1[1])))
pts.add((r4(p2[0]), r4(p2[1])))
points = list(pts)
if not points:
open(OUTFILE, "w", encoding="utf-8").close()
raise SystemExit("no points")
# --- ルール：輪郭点のXmax/Zmaxを0 ---
xmax = max(p[0] for p in points)
zmax = max(p[1] for p in points)
def conv_xy(x,z):
return (r4(x - xmax), r4(z - zmax))
def near(p,q):
return abs(p[0]-q[0]) <= TOL and abs(p[1]-q[1]) <= TOL
# --- 8点を作る（(0,0)除外・Z降順）---
converted = []
for x,z in points:
x0,z0 = conv_xy(x,z)
if x0 == 0.0 and z0 == 0.0:
continue
converted.append([x0,z0,""])
converted.sort(key=lambda p: p[1], reverse=True)
# --- 各円弧について「下側端点だけ」Rを付ける ---
arc_targets = [] # (x0,z0,R) ←下側端点のみ
for (cx,cz,R,a1,a2) in arcs:
t1 = math.radians(a1); t2 = math.radians(a2)
p1 = (cx + R*math.cos(t1), cz + R*math.sin(t1))
p2 = (cx + R*math.cos(t2), cz + R*math.sin(t2))
p1c = conv_xy(p1[0], p1[1])
p2c = conv_xy(p2[0], p2[1])
# ★下側（Zが小さい＝よりマイナス側）を採用
target = p1c if p1c[1] < p2c[1] else p2c
arc_targets.append((target[0], target[1], r4(R)))
# --- 8点の中で一致する行にだけRを入れる ---
for tx, tz, RR in arc_targets:
for row in converted:
if near((row[0],row[1]), (tx,tz)):
row[2] = f"{RR:.4f}"
break
# --- CSV出力 x0,z0,r ---
with open(OUTFILE, "w", encoding="utf-8") as f:
for x0,z0,rr in converted:
f.write(f"{x0:.4f},{z0:.4f},{rr}\n")
print("reading:", INFILE)
print("written:", OUTFILE, "rows:", len(converted))
print("arc R targets (lower endpoints):", len(arc_targets))
for t in arc_targets:
print(" target:", f"{t[0]:.4f}", f"{t[1]:.4f}", "R=", f"{t[2]:.4f}")
