' ============================================================================= ' NX Journal: 按需生成服务 worker (二期 A 版, NX 2506 实测适配版, 2026-08-27) ' ' ▍干什么: 常驻轮询 GenServer 任务队列, 认领任务后在**同一 NX 会话内**逐项生成: ' 开母模副本 → 设表达式 → 更新 → Save 副本 → PRT SaveAs → ' CloseAll 释放句柄 → 外部独立翻译器导出 STEP/IGES → 关闭不保存。 ' 结果写 jobs\job_.done (行式键值格式, 无 JSON — NX journal 编译环境没有 JSON 库)。 ' ' ▍关键改造 (2026-08-27): 批处理内 DexManager 导出判 0 solid (ST-DEVELOPER 翻译器 ' 在 run_journal 无 GUI 下读不到几何), 改为 Save 副本后 spawn 独立命令行翻译器 ' step214ug.exe (.prt→.step) / iges.exe (.prt→.igs), 实测成功。 ' ' ▍任务文件格式 (GenServer 写入, 本脚本解析; 母模/映射/开关/导出配置全部烘进任务, 不读 masters.json): ' ITEM ' SERIES=KC ' CODE=KC0032-87 ' PARAM type=00 (每参数一行, 值可为空) ' PARAM bore=32 ' MASTER=KC_master.prt ' MAP bore=bore (目录参数代码=NX表达式名) ' SW magnet,=magOn,0 (参数代码,参数值=NX表达式名,表达式值) ' EXP step=1 (导出格式开关; step 恒 1) ' END ' ' ▍运行 (run_journal 只接受一个参数; 用 WorkingDirectory 定位配置): ' WorkingDirectory = GenServer 运行目录 (含 worker-config.txt + worker-no.txt) ' run_journal.exe <本文件完整路径> ' ' ▍注意 ' - 中文注释需 UTF-8 带 BOM (改完手动恢复 BOM) ' - 母模副本现在必须 Save (独立翻译器从磁盘读); 但副本用完即删, 绝不保留脏副本 ' - 导出格式 (masters.json exports): step 恒导出, iges/prt 可选, parasolid/stl 已按用户要求砍掉 ' - NX 2506 关键 API (反射探针核对): OpenBaseDisplay(批处理必须, OpenBase 后 Work=NULL) / ' ExpressionCollection.CreateExpression("Number","名=值") / UF EditExp(仅编辑已存在) / CloseAll 两参数 ' ============================================================================= Option Strict Off Imports System Imports System.IO Imports System.Text Imports System.Diagnostics Imports System.Collections.Generic Imports NXOpen Imports NXOpen.UF Module WorkerGen Dim theSession As Session = Session.GetSession() Dim lw As ListingWindow = theSession.ListingWindow Dim jobsDir, outputDir, mastersDir, workDir, nxBin As String Dim workerNo As String = "0" Dim pollMs As Integer = 1500 Sub Main() lw.Open() ' 配置 = 当前工作目录 worker-config.txt (key=value 行式) Dim cfgPath As String = Path.Combine(Directory.GetCurrentDirectory(), "worker-config.txt") If Not File.Exists(cfgPath) Then lw.WriteLine("[worker] 未找到配置: " & cfgPath & " (请以 GenServer 运行目录为工作目录启动)") Return End If For Each line As String In File.ReadAllLines(cfgPath, Encoding.UTF8) Dim i As Integer = line.IndexOf("="c) If i <= 0 Then Continue For Dim k As String = line.Substring(0, i).Trim() Dim v As String = line.Substring(i + 1).Trim() If k = "jobsDir" Then jobsDir = v If k = "outputDir" Then outputDir = v If k = "mastersDir" Then mastersDir = v If k = "workDir" Then workDir = v If k = "nxBin" Then nxBin = v Next If jobsDir.Length = 0 OrElse outputDir.Length = 0 Then lw.WriteLine("[worker] 配置缺少 jobsDir/outputDir") Return End If If nxBin.Length = 0 Then ' 回退: 自动探测 NX 安装目录 (部署到新机器无需手填) For Each root As String In New String() { Path.Combine(Environment.GetFolderPath(Environment.SpecialFolder.ProgramFiles), "Siemens"), Path.Combine(Environment.GetFolderPath(Environment.SpecialFolder.ProgramFilesX86), "Siemens"), "C:\Program Files\Siemens"} If Not Directory.Exists(root) Then Continue For For Each ver As String In Directory.GetDirectories(root, "NX*") Dim b As String = Path.Combine(ver, "NXBIN") If File.Exists(Path.Combine(b, "run_journal.exe")) Then nxBin = b : Exit For Next If nxBin.Length > 0 Then Exit For Next End If If nxBin.Length = 0 Then lw.WriteLine("[worker] 警告: 未找到 NX NXBIN 目录 (nxBin 未配置且自动探测失败), STEP/IGES 导出将失败") Else lw.WriteLine("[worker] nxBin=" & nxBin) End If Dim noPath As String = Path.Combine(Directory.GetCurrentDirectory(), "worker-no.txt") If File.Exists(noPath) Then Dim noTxt As String = File.ReadAllText(noPath, Encoding.UTF8).Trim() If noTxt.Length > 0 Then workerNo = noTxt End If For Each d As String In {jobsDir, outputDir, workDir} If d.Length > 0 AndAlso Not Directory.Exists(d) Then Directory.CreateDirectory(d) Next lw.WriteLine("[worker" & workerNo & "] 启动: jobs=" & jobsDir & " 输出=" & outputDir) While True Try TouchHeartbeat() ProcessNextJob() Catch ex As Exception lw.WriteLine("[worker" & workerNo & "] 循环异常: " & ex.Message) End Try Threading.Thread.Sleep(pollMs) End While End Sub ' ---- 认领一个任务并处理 (原子改名防双 worker 抢同一任务) ---- Sub ProcessNextJob() Dim jobFile As String = Nothing Dim files() As String = Directory.GetFiles(jobsDir, "job_*.json") If files.Length = 0 Then Return Array.Sort(files) For Each f As String In files Dim running As String = f.Substring(0, f.Length - 5) & ".running" Try File.Move(f, running) jobFile = running Exit For Catch ' 被其他 worker 抢走, 试下一个 End Try Next If jobFile Is Nothing Then Return Dim jobId As String = Path.GetFileName(jobFile).Replace("job_", "").Replace(".running", "") Dim workJobDir As String = Path.Combine(workDir, "job_" & jobId) Directory.CreateDirectory(workJobDir) lw.WriteLine("[worker" & workerNo & "] 认领任务 " & jobId & " " & DateTime.Now.ToString("HH:mm:ss")) Dim okOverall As Boolean = True Dim errOverall As String = "" Dim doneSb As New StringBuilder() Dim items As New List(Of Dictionary(Of String, Object))() Dim masterCopies As New Dictionary(Of String, String)() ' 同系列共用一份母模副本 (副本从不保存) Try items = ParseJob(File.ReadAllText(jobFile, Encoding.UTF8)) doneSb.AppendLine("OK=1") doneSb.AppendLine("ERROR=") For idx As Integer = 0 To items.Count - 1 Dim it As Dictionary(Of String, Object) = items(idx) Dim series As String = GetStr(it, "series") Dim code As String = GetStr(it, "code") Dim pars As Dictionary(Of String, Object) = GetDict(it, "params") Dim outDir As String = Path.Combine(outputDir, series, code) Directory.CreateDirectory(outDir) Dim itemOk As Boolean = True Dim itemErr As String = "" Dim itemHit As Boolean = False Dim filesList As New List(Of String)() Try ' 检索先行 (认领时再查一次, 防并发窗口重复生成) If OutputHit(series, code, it) Then itemHit = True filesList = ListOutputFiles(code, it) lw.WriteLine(" [" & code & "] 已存在, 命中复用") Else ' 拷母模副本 (同系列共用; 绝不保存) If Not masterCopies.ContainsKey(series) Then Dim src As String = Path.Combine(mastersDir, series, GetStr(it, "master")) If Not File.Exists(src) Then Throw New Exception("母模缺失: " & src) Dim dst As String = Path.Combine(workJobDir, series & "_master.prt") File.Copy(src, dst, True) ' 清只读属性 (源母模可能带只读, NX 只读打开会拒绝保存/导出) File.SetAttributes(dst, File.GetAttributes(dst) And Not FileAttributes.ReadOnly) masterCopies(series) = dst End If GenerateOne(series, code, pars, it, masterCopies(series), outDir) filesList = ListOutputFiles(code, it) lw.WriteLine(" [" & code & "] 生成完成 → " & outDir) End If Catch ex As Exception okOverall = False itemOk = False itemErr = ex.Message lw.WriteLine(" [" & code & "] 失败: " & ex.Message) End Try doneSb.AppendLine("ITEM") doneSb.AppendLine("SERIES=" & series) doneSb.AppendLine("CODE=" & code) doneSb.AppendLine("OK=" & (If(itemOk, "1", "0"))) doneSb.AppendLine("HIT=" & (If(itemHit, "1", "0"))) doneSb.AppendLine("ERROR=" & itemErr) For Each f As String In filesList doneSb.AppendLine("FILE=" & f) Next doneSb.AppendLine("END") ' 逐项进度 (批量打包 UI 显示 done/total) File.WriteAllText(Path.Combine(jobsDir, "job_" & jobId & ".prog"), "DONE=" & (idx + 1) & vbCrLf & "TOTAL=" & items.Count & vbCrLf, Encoding.UTF8) ' 关闭所有部件 (不保存), 会话内循环 (NX 2506: CloseAll 两参数) Try theSession.Parts.CloseAll(NXOpen.BasePart.CloseModified.CloseModified, Nothing) Catch End Try Next Catch ex As Exception okOverall = False errOverall = ex.Message lw.WriteLine("[worker" & workerNo & "] 任务异常: " & ex.Message) End Try ' 写结果 (原子: 先写临时再改名; 错误信息去换行防格式破坏) Dim doneText As String = doneSb.ToString() If Not okOverall Then Dim errClean As String = errOverall.Replace(vbCr, " ").Replace(vbLf, " ") If doneText.IndexOf("ITEM", StringComparison.OrdinalIgnoreCase) < 0 Then doneText = "OK=0" & vbCrLf & "ERROR=" & errClean & vbCrLf Else doneText = doneText.Replace("OK=1" & vbCrLf & "ERROR=", "OK=0" & vbCrLf & "ERROR=" & errClean) End If End If Dim donePath As String = Path.Combine(jobsDir, "job_" & jobId & ".done") Dim tmpPath As String = donePath & ".tmp" File.WriteAllText(tmpPath, doneText, New UTF8Encoding(True)) If File.Exists(donePath) Then File.Delete(donePath) File.Move(tmpPath, donePath) Try File.Delete(jobFile) ' 删 .running Directory.Delete(workJobDir, True) ' 任务私有工作副本即清 (输出留存不删) Catch End Try lw.WriteLine("[worker" & workerNo & "] 任务 " & jobId & " 结束 " & (If(okOverall, "OK", "FAIL"))) End Sub ' ---- 任务文件解析 (行式键值; 返回每项一个字典: series/code/params/master/map/sw/exp) ---- Function ParseJob(text As String) As List(Of Dictionary(Of String, Object)) Dim result As New List(Of Dictionary(Of String, Object))() Dim cur As Dictionary(Of String, Object) = Nothing For Each raw As String In text.Split(New String() {vbCrLf, vbLf, vbCr}, StringSplitOptions.None) Dim l As String = raw.Trim() If l.Length = 0 Then Continue For If l = "ITEM" Then cur = New Dictionary(Of String, Object)() cur("params") = New Dictionary(Of String, Object)() cur("map") = New Dictionary(Of String, Object)() cur("sw") = New List(Of Object)() cur("exp") = New Dictionary(Of String, Object)() result.Add(cur) Continue For End If If l = "END" Then cur = Nothing : Continue For If cur Is Nothing Then Continue For If l.StartsWith("SERIES=") Then cur("series") = l.Substring(7).Trim() : Continue For If l.StartsWith("CODE=") Then cur("code") = l.Substring(5).Trim() : Continue For If l.StartsWith("MASTER=") Then cur("master") = l.Substring(7).Trim() : Continue For If l.StartsWith("PARAM ") Then Dim rest As String = l.Substring(6) Dim j As Integer = rest.IndexOf("="c) If j > 0 Then CType(cur("params"), Dictionary(Of String, Object))(rest.Substring(0, j).Trim()) = rest.Substring(j + 1).Trim() Continue For End If If l.StartsWith("MAP ") Then Dim rest As String = l.Substring(4) Dim j As Integer = rest.IndexOf("="c) If j > 0 Then CType(cur("map"), Dictionary(Of String, Object))(rest.Substring(0, j).Trim()) = rest.Substring(j + 1).Trim() Continue For End If If l.StartsWith("SW ") Then ' SW 参数代码,参数值=表达式名,表达式值 Dim rest As String = l.Substring(3) Dim j As Integer = rest.IndexOf("="c) If j > 0 Then Dim left() As String = rest.Substring(0, j).Split(","c) Dim right() As String = rest.Substring(j + 1).Split(","c) If left.Length >= 2 AndAlso right.Length >= 2 Then Dim sw As New Dictionary(Of String, Object)() sw("pc") = left(0).Trim() : sw("pv") = left(1).Trim() sw("ex") = right(0).Trim() : sw("ev") = right(1).Trim() CType(cur("sw"), List(Of Object)).Add(sw) End If End If Continue For End If If l.StartsWith("EXP ") Then Dim rest As String = l.Substring(4) Dim j As Integer = rest.IndexOf("="c) If j > 0 AndAlso rest.Substring(j + 1).Trim() = "1" Then CType(cur("exp"), Dictionary(Of String, Object))(rest.Substring(0, j).Trim()) = "1" End If Continue For End If Next Return result End Function Function GetStr(d As Dictionary(Of String, Object), key As String) As String If d Is Nothing OrElse Not d.ContainsKey(key) OrElse d(key) Is Nothing Then Return "" Return Convert.ToString(d(key)) End Function Function GetDict(d As Dictionary(Of String, Object), key As String) As Dictionary(Of String, Object) If d Is Nothing OrElse Not d.ContainsKey(key) OrElse d(key) Is Nothing Then Return New Dictionary(Of String, Object)() Return CType(d(key), Dictionary(Of String, Object)) End Function ' 导出格式开关: job 里 EXP 行 (EXP parasolid=1); step 恒导出 Function ExpOn(it As Dictionary(Of String, Object), fmt As String) As Boolean If fmt = "step" Then Return True Dim exp As Dictionary(Of String, Object) = GetDict(it, "exp") Return exp.ContainsKey(fmt) End Function ' ---- 检索先行: 输出目录存在且全部配置格式文件齐全 ---- Function OutputHit(series As String, code As String, it As Dictionary(Of String, Object)) As Boolean Dim dir As String = Path.Combine(outputDir, series, code) If Not Directory.Exists(dir) Then Return False For Each f As String In New String() {code & ".stp", code & ".x_t", code & ".igs", code & ".stl", code & ".prt"} If f.EndsWith(".stp") AndAlso Not File.Exists(Path.Combine(dir, f)) Then Return False If f.EndsWith(".x_t") AndAlso ExpOn(it, "parasolid") AndAlso Not File.Exists(Path.Combine(dir, f)) Then Return False If f.EndsWith(".igs") AndAlso ExpOn(it, "iges") AndAlso Not File.Exists(Path.Combine(dir, f)) Then Return False If f.EndsWith(".stl") AndAlso ExpOn(it, "stl") AndAlso Not File.Exists(Path.Combine(dir, f)) Then Return False If f.EndsWith(".prt") AndAlso ExpOn(it, "prt") AndAlso Not File.Exists(Path.Combine(dir, f)) Then Return False Next Return True End Function Function ListOutputFiles(code As String, it As Dictionary(Of String, Object)) As List(Of String) Dim list As New List(Of String)() list.Add(code & ".stp") If ExpOn(it, "parasolid") Then list.Add(code & ".x_t") If ExpOn(it, "iges") Then list.Add(code & ".igs") If ExpOn(it, "stl") Then list.Add(code & ".stl") If ExpOn(it, "prt") Then list.Add(code & ".prt") Return list End Function ' ---- 单型号生成: 开副本 → 设表达式 → 更新 → 多格式导出 → 关闭 ---- Sub GenerateOne(series As String, code As String, pars As Dictionary(Of String, Object), it As Dictionary(Of String, Object), masterCopy As String, outDir As String) ' 1) 打开母模副本 (OpenBaseDisplay 使其成为工作部件; 副本会 Save 供外部翻译器读盘, 用完即删) Dim partLoadStatus1 As NXOpen.PartLoadStatus = Nothing Dim basePart1 As NXOpen.BasePart = theSession.Parts.OpenBaseDisplay(masterCopy, partLoadStatus1) If partLoadStatus1 IsNot Nothing Then partLoadStatus1.Dispose() Dim workPart As NXOpen.Part = theSession.Parts.Work If workPart Is Nothing Then Throw New Exception("打开母模失败: " & masterCopy) ' 2) 设表达式 (UF EditExp 只编辑已存在的表达式; 母模必须已建好这些表达式) Dim ufsW As UFSession = UFSession.GetUFSession() Dim exprMap As Dictionary(Of String, Object) = GetDict(it, "map") For Each kv As KeyValuePair(Of String, Object) In exprMap If pars.ContainsKey(kv.Key) Then ufsW.Modl.EditExp(Convert.ToString(kv.Value) & "=" & ValueStr(pars(kv.Key))) End If Next Dim swList As Object = Nothing If it.ContainsKey("sw") Then swList = it("sw") If swList IsNot Nothing Then For Each swObj As Object In CType(swList, List(Of Object)) Dim sw As Dictionary(Of String, Object) = CType(swObj, Dictionary(Of String, Object)) If pars.ContainsKey(GetStr(sw, "pc")) AndAlso ValueStr(pars(GetStr(sw, "pc"))) = GetStr(sw, "pv") Then ufsW.Modl.EditExp(GetStr(sw, "ex") & "=" & GetStr(sw, "ev")) End If Next End If ' 3) Update model ufsW.Modl.Update() ' 4) Save the copy to disk so independent translators can read it. ' (in-session DexManager export yields 0 solids in batch - verified; see dev log 4.5) Dim pssSave As NXOpen.PartSaveStatus = workPart.Save(NXOpen.BasePart.SaveComponents.True, NXOpen.BasePart.CloseAfterSave.False) If pssSave IsNot Nothing Then pssSave.Dispose() ' 5) PRT save-as (NX native parametric part; session SaveAs) If ExpOn(it, "prt") Then ExportPrt(Path.Combine(outDir, code & ".prt")) ' 6) Close all parts to release the file handle so external translators can read Try theSession.Parts.CloseAll(NXOpen.BasePart.CloseModified.CloseModified, Nothing) Catch End Try ' 7) Export via independent CLI translators (bypass batch 0-solid dead end) ExportStepCli(masterCopy, Path.Combine(outDir, code & ".stp")) If ExpOn(it, "iges") Then ExportIgesCli(masterCopy, Path.Combine(outDir, code & ".igs")) End Sub ' ---- Independent CLI translators (bypass batch 0-solid dead end) ---- ' step214ug.exe: bidirectional. input .prt -> export STEP. (verified 2 solids, 7KB) ' Syntax: step214ug.exe o= d= l= Sub ExportStepCli(inputPrt As String, fileName As String) If File.Exists(fileName) Then File.Delete(fileName) Dim psi As New ProcessStartInfo() psi.FileName = Path.Combine(nxBin, "step214ug.exe") psi.Arguments = """" & inputPrt & """ o=""" & fileName & """ l=""" & fileName & ".log""" psi.WorkingDirectory = Path.GetDirectoryName(inputPrt) psi.UseShellExecute = False psi.CreateNoWindow = True Dim p As Process = Process.Start(psi) p.WaitForExit() If Not File.Exists(fileName) OrElse (New FileInfo(fileName)).Length < 1000 Then Throw New Exception("STEP export failed (empty/missing): " & fileName) End If End Sub ' iges.exe: input .prt -> export IGES. (verified Face=6) ' Syntax: iges.exe o= l= Sub ExportIgesCli(inputPrt As String, fileName As String) If File.Exists(fileName) Then File.Delete(fileName) Dim psi As New ProcessStartInfo() psi.FileName = Path.Combine(nxBin, "iges.exe") psi.Arguments = """" & inputPrt & """ o=""" & fileName & """ l=""" & fileName & ".log""" psi.WorkingDirectory = Path.GetDirectoryName(inputPrt) psi.UseShellExecute = False psi.CreateNoWindow = True Dim p As Process = Process.Start(psi) p.WaitForExit() If Not File.Exists(fileName) Then Throw New Exception("IGES export failed (missing): " & fileName) End If End Sub ' NX native part export: save-as current work part (parametric exprs + feature tree; 2026-08-26 user request) Sub ExportPrt(fileName As String) Dim pss As NXOpen.PartSaveStatus = theSession.Parts.Work.SaveAs(fileName) If pss IsNot Nothing Then pss.Dispose() End Sub ' ---- 工具 ---- Function ValueStr(v As Object) As String If v Is Nothing Then Return "" Return Convert.ToString(v, System.Globalization.CultureInfo.InvariantCulture).Replace(",", ".") End Function Sub TouchHeartbeat() Dim hb As String = Path.Combine(workDir, "heartbeat_" & workerNo & ".txt") File.WriteAllText(hb, DateTime.Now.ToString("yyyy-MM-dd HH:mm:ss"), New UTF8Encoding(True)) End Sub End Module