;; ============================================================
;;  钣金汇 真形套料（BJH2）— 调用本地最强套料引擎
;;  需与本插件 bjh.lsp 一起加载；引擎为免安装的 nest 便携包。
;;  命令：BJH2
;; ============================================================

(if (null bjh2:home)
  (setq bjh2:home (if (findfile "bjh_nest.lsp")
                    (vl-filename-directory (findfile "bjh_nest.lsp"))
                    nil)))
(setq bjh2:eng nil)
(setq bjh2:mkerf 0.0)
(setq bjh2:loaded nil)
(setq bjh2:engok nil)
(setq bjh2:uimode "rect")
(setq bjh2:uilive nil)
(setq bjh2:uidir nil)
(setq bjh2:uipicking nil)
;; 界面指纹缓存：同一几何只算一次轮廓/孔环，避免每次点选都重算全部规格
(setq bjh2:uicache nil)
(setq bjh2:uirev 0)
(setq bjh2:sheets '("1220 x 2440" "1500 x 3000" "1000 x 2000"
                    "2000 x 4000" "1250 x 2500" "自定义"))

;; ------------------------------------------------------------
;;  设置记忆
;; ------------------------------------------------------------
(defun bjh2:inifile ()
  (strcat (cond ((getenv "LOCALAPPDATA") (getenv "LOCALAPPDATA"))
                ((getenv "TEMP") (getenv "TEMP"))
                (T "."))
          "\\BanjinHui_bjh2.ini")
)

(defun bjh2:save-settings ( / f)
  (setq f (open (bjh2:inifile) "w"))
  (if f
    (progn
      (prin1 (list bjh2:mw bjh2:mh bjh2:mt bjh2:mgap bjh2:mmargin bjh2:mangle
                   bjh2:mbudget bjh2:mirror bjh2:mcom bjh2:mmat bjh2:eng) f)
      (close f)
    )
  )
)

(defun bjh2:load-settings ( / f s line lst)
  (setq bjh2:saved nil)
  (if (findfile (bjh2:inifile))
    (progn
      (setq f (open (bjh2:inifile) "r"))
      (if f
        (progn
          (setq s "")
          (while (setq line (read-line f)) (setq s (strcat s line)))
          (close f)
          (setq lst (vl-catch-all-apply 'read (list s)))
          (if (and (not (vl-catch-all-error-p lst)) (listp lst) (= (length lst) 11))
            (progn
              (setq bjh2:saved lst)
              (if (and (nth 10 lst) (= (type (nth 10 lst)) 'STR))
                (setq bjh2:eng (nth 10 lst)))
            )
          )
        )
      )
    )
  )
)

;; ------------------------------------------------------------
;;  引擎定位：返回 run_nest.bat 全路径，找不到返回 nil
;; ------------------------------------------------------------
(defun bjh2:engfile ( / cands c got)
  (setq cands (list
      bjh2:eng
      (if (getenv "LOCALAPPDATA")
        (strcat (getenv "LOCALAPPDATA") "\\BanjinHui\\nest\\engine\\run_nest.bat") nil)
      (if (getenv "LOCALAPPDATA")
        (strcat (getenv "LOCALAPPDATA") "\\BanjinHui\\run_nest.bat") nil)
      (if bjh2:home (strcat bjh2:home "\\nest\\engine\\run_nest.bat") nil)
      (if bjh2:home (strcat bjh2:home "\\engine\\run_nest.bat") nil)
      (if bjh2:home (strcat bjh2:home "\\run_nest.bat") nil)))
  (setq got nil)
  (foreach c cands
    (if (and (null got) c (= (type c) 'STR) (findfile c))
      (setq got c))
  )
  got
)

;; ------------------------------------------------------------
;;  基础工具
;; ------------------------------------------------------------
;; 快速分词：逐字符扫描，但把字符先 cons 成表、每个词只做一次 strcat。
;; 旧实现每个字符都 strcat，超长 RING/POLY 行会退化成 O(n^2)，是出图卡顿的主因。
(defun bjh2:tok (s / i n c cur out)
  (setq i 1 n (strlen s) cur nil out nil)
  (while (<= i n)
    (setq c (substr s i 1))
    (if (or (= c " ") (= c "\t") (= c ",") (= c "="))
      (progn
        (if cur (setq out (cons (apply 'strcat (reverse cur)) out)))
        (setq cur nil)
      )
      (setq cur (cons c cur))
    )
    (setq i (1+ i))
  )
  (if cur (setq out (cons (apply 'strcat (reverse cur)) out)))
  (reverse out)
)

;; 点串 "x1 y1 x2 y2 ..." -> 点表（按出现顺序）
(defun bjh2:pairpts (toks / out)
  (setq out nil)
  (while (and toks (cdr toks))
    (setq out (cons (list (atof (car toks)) (atof (cadr toks))) out))
    (setq toks (cddr toks))
  )
  (reverse out)
)

(defun bjh2:fmt (x) (rtos x 2 4))

;; 参数处取点（失败返回 nil）
(defun bjh2:ptat (ent t0 / p)
  (setq p (vl-catch-all-apply 'vlax-curve-getPointAtParam (list ent t0)))
  (if (or (vl-catch-all-error-p p) (null p))
    nil
    (list (car p) (cadr p))
  )
)

;; 一段参数区间内的最大弦高偏差（三点采样，判断是否需要细分）
(defun bjh2:segdev (ent p0 p1 t0 t1 / mx my dev s i tm pm dx dy d)
  (setq mx (* 0.5 (+ (car p0) (car p1)))
        my (* 0.5 (+ (cadr p0) (cadr p1)))
        dev 0.0)
  (foreach s '(0.25 0.5 0.75)
    (setq tm (+ t0 (* s (- t1 t0))))
    (setq pm (bjh2:ptat ent tm))
    (if pm
      (progn
        (setq dx (- (car pm) (+ (car p0) (* s (- (car p1) (car p0)))))
              dy (- (cadr pm) (+ (cadr p0) (* s (- (cadr p1) (cadr p0)))))
              d (sqrt (+ (* dx dx) (* dy dy))))
        (if (> d dev) (setq dev d))
      )
    )
  )
  dev
)

;; 递归细分一段曲线：直线段只保留端点，圆弧/样条按弦高偏差自动加点
(defun bjh2:segsplit (ent p0 t0 t1 tol depth out / p1 tm pm)
  (setq p1 (bjh2:ptat ent t1))
  (if (null p1)
    out
    (progn
      (setq tm (* 0.5 (+ t0 t1))
            pm (bjh2:ptat ent tm))
      (if (and pm (< depth 7) (> (bjh2:segdev ent p0 p1 t0 t1) tol))
        (progn
          ;; 先算右半段再算左半段：cons 累积后即为正序
          (setq out (bjh2:segsplit ent pm tm t1 tol (1+ depth) out))
          (setq out (bjh2:segsplit ent p0 t0 tm tol (1+ depth) out))
          out
        )
        (if (and out (< (distance p1 (car out)) 1e-6))
          out
          (cons p1 out)
        )
      )
    )
  )
)

;; 任意闭合实体的轮廓点（直线段用真实顶点，圆弧按弦高偏差自动加密，最高 0.05mm 误差）
(defun bjh2:outline (ent / endpl n i t0 t1 p0 out tol)
  (setq tol 0.05)
  (setq endpl (vl-catch-all-apply 'vlax-curve-getEndParam (list ent)))
  (if (or (vl-catch-all-error-p endpl) (null endpl) (not (numberp endpl)))
    nil
    (progn
      (setq n (fix endpl))
      (if (< n 1) (setq n 1))
      ;; 从最后一段往前累积，保证点表为正序
      (setq out nil i n)
      (while (> i 0)
        (setq t0 (1- i) t1 (if (= i n) endpl i))
        (setq p0 (bjh2:ptat ent t0))
        (if p0
          (setq out (bjh2:segsplit ent p0 t0 t1 tol 0 out))
        )
        (setq i (1- i))
      )
      (setq p0 (bjh2:ptat ent 0.0))
      (if (and p0 (or (null out) (> (distance p0 (car out)) 1e-6)))
        (setq out (cons p0 out))
      )
      out
    )
  )
)

;; 开放曲线按端点首尾相接成闭合环（面域分解后常为线段/圆弧）
(defun bjh2:chain (curves / out cur c nxt best bi bd rev done start end d1 d2 idx)
  (setq out nil)
  (while curves
    (setq cur (car curves) curves (cdr curves))
    (if (and (> (length cur) 3) (< (distance (car cur) (last cur)) 0.05))
      (setq out (cons cur out))
      (progn
        (setq start (car cur) end (last cur) done nil)
        (while (and curves (not done))
          (setq best nil bi nil bd nil nxt nil rev nil idx 0)
          (foreach c curves
            (setq d1 (distance end (car c)) d2 (distance end (last c)))
            (if (and (<= d1 0.05) (or (null bd) (< d1 bd)))
              (setq bd d1 best c bi idx rev nil))
            (if (and (<= d2 0.05) (or (null bd) (< d2 bd)))
              (setq bd d2 best c bi idx rev T))
            (setq idx (1+ idx))
          )
          (if best
            (progn
              (setq nxt (if rev (reverse best) best))
              (setq cur (append cur (cdr nxt)))
              (setq end (last cur))
              (if bi (setq curves (bjh:dropn curves bi)))
              (if (< (distance start end) 0.05) (setq done T))
            )
            (setq done T)
          )
        )
        (if (and (> (length cur) 3) (< (distance (car cur) (last cur)) 0.05))
          (setq out (cons cur out))
        )
      )
    )
  )
  out
)

;; 实体 -> 轮廓环表（块参照/面域先分解，支持嵌套块；返回多个点表）
(defun bjh2:rings (ent depth / obj typ arr lst o e out r)
  (if (> depth 4)
    nil
    (progn
      (setq obj (vl-catch-all-apply 'vlax-ename->vla-object (list ent)))
      (if (vl-catch-all-error-p obj)
        nil
        (progn
          (setq typ (vla-get-ObjectName obj))
          (cond
            ((wcmatch typ "AcDbBlockReference,AcDbRegion")
             (setq arr (vl-catch-all-apply 'vla-Explode (list obj)))
             (if (vl-catch-all-error-p arr)
               nil
               (progn
                 (setq out nil)
                 (setq lst (vl-catch-all-apply 'vlax-safearray->list
                                               (list (vlax-variant-value arr))))
                 (if (or (vl-catch-all-error-p lst) (not (listp lst))) (setq lst nil))
                 (foreach o lst
                   (setq e (vl-catch-all-apply 'vlax-vla-object->ename (list o)))
                   (if (not (vl-catch-all-error-p e))
                     (progn
                       (foreach r (bjh2:rings e (1+ depth))
                         (setq out (append out (list r))))
                       (vl-catch-all-apply 'vla-Delete (list o))
                     )
                   )
                 )
                 (bjh2:chain out)
               )
             )
            )
            (T
             (setq r (bjh2:outline ent))
             (if r (list r) nil)
            )
          )
        )
      )
    )
  )
)

;; 环按面积从大到小（外轮廓在前）
(defun bjh2:sort-rings (rs / out mx mxi i a)
  (setq out nil)
  (foreach r rs
    (setq a (bjh:polyarea r))
    (setq out (append out (list (list (if a a 0.0) r))))
  )
  (setq rs nil)
  (while out
    (setq mx nil mxi 0 i 0)
    (foreach x out
      (if (or (null mx) (> (car x) (car mx))) (setq mx x mxi i))
      (setq i (1+ i))
    )
    (setq rs (cons (cadr mx) rs))
    (setq out (bjh:dropn out mxi))
  )
  rs
)

(defun bjh2:ring (pts / parts)
  (setq parts (list "RING"))
  (foreach p pts
    (setq parts (cons (strcat " " (bjh2:fmt (car p)) " " (bjh2:fmt (cadr p))) parts))
  )
  (apply 'strcat (reverse parts))
)

;; ------------------------------------------------------------
;;  写引擎输入文件
;; ------------------------------------------------------------
(defun bjh2:write-in (path items / f i it inst o ho pts skip rs r)
  (setq f (open path "w"))
  (if (null f)
    (progn (alert "无法写入临时文件（目录不可写）。") nil)
    (progn
      (write-line "# BJH nest input" f)
      (write-line (strcat "SHEET " (bjh2:fmt bjh2:mw) " " (bjh2:fmt bjh2:mh)) f)
      (write-line (strcat "MARGIN " (bjh2:fmt bjh2:mmargin)) f)
      (write-line (strcat "GAP " (bjh2:fmt (if bjh2:mcom 0.0 bjh2:mgap))) f)
      (write-line (strcat "KERF " (bjh2:fmt bjh2:mkerf)) f)
      (write-line (strcat "ANGLE " (bjh2:fmt bjh2:mangle)) f)
      (write-line (strcat "MIRROR " (if bjh2:mirror "1" "0")) f)
      (write-line (strcat "BUDGET " (bjh2:fmt bjh2:mbudget)) f)
      (write-line "OBJECTIVE min_sheets" f)
      (write-line (strcat "COMMON " (if bjh2:mcom "1" "0")) f)
      (setq i 0 skip 0)
      (foreach it items
        (setq inst (car it))
        (setq rs (bjh2:sort-rings (bjh2:rings (nth 0 inst) 0)))
        (if rs
          (progn
            (write-line (strcat "PART P" (itoa (1+ i)) " " (itoa (cdr it))) f)
            (foreach r rs (write-line (bjh2:ring r) f))
            (if (<= (length rs) 1)
              (foreach ho (nth 1 inst)
                (foreach r (bjh2:sort-rings (bjh2:rings ho 0))
                  (write-line (bjh2:ring r) f)
                )
              )
            )
          )
          (setq skip (1+ skip))
        )
        (setq i (1+ i))
      )
      (close f)
      (if (> skip 0)
        (alert (strcat "有 " (itoa skip) " 类零件无法提取轮廓（如加密块/代理对象），"
                       "本次将跳过这些零件。\n建议先将其分解(EXPLODE)为多段线后再套料。"))
      )
      T
    )
  )
)

;; ------------------------------------------------------------
;;  调用引擎（隐藏窗口，同步等待）
;; ------------------------------------------------------------
(defun bjh2:run (bat inp outp / sh cmd rc)
  (setq cmd (strcat "\"" bat "\" \"" inp "\" \"" outp "\""))
  (setq sh (vl-catch-all-apply 'vlax-create-object (list "WScript.Shell")))
  (if (or (vl-catch-all-error-p sh) (null sh))
    (progn (alert "无法启动本地引擎（WScript.Shell 不可用）。") nil)
    (progn
      (setq rc (vl-catch-all-apply 'vlax-invoke (list sh 'Run cmd 0 1)))
      (vlax-release-object sh)
      (if (vl-catch-all-error-p rc)
        (progn (alert (strcat "调用引擎失败: " (vl-catch-all-error-message rc))) nil)
        T
      )
    )
  )
)

;; ------------------------------------------------------------
;;  绘制结果
;; ------------------------------------------------------------
(defun bjh2:lwpoly (pts layer / d e)
  (setq d (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity")
                (cons 8 layer) '(100 . "AcDbPolyline")
                (cons 90 (length pts)) '(70 . 1)))
  (setq e nil)
  (foreach p pts (setq e (cons (list 10 (car p) (cadr p)) e)))
  (entmake (append d (reverse e)))
)

(defun bjh2:draw (path ox0 oy0 / f lines line parsed toks first kind W H
                    sheetcnt util placed total idx ox oy pts j x y flags
                    partlen cutlen saved crat)
  (setq f (open path "r"))
  (if (null f)
    (progn (alert "引擎未产生结果文件，请检查引擎安装。") nil)
    (progn
      (setq lines nil)
      (while (setq line (read-line f)) (setq lines (cons line lines)))
      (close f)
      (setq lines (reverse lines))
      ;; 先把所有行分词一次（后面元数据与几何各扫一遍，不再重复分词）
      (setq parsed nil)
      (foreach line lines
        (setq parsed (cons (bjh2:tok line) parsed))
      )
      (setq parsed (reverse parsed))
      (setq toks (car parsed))
      (if (and toks (= (car toks) "ERROR"))
        (progn
          (alert (strcat "引擎报错：\n" (car lines)))
          nil
        )
        (progn
          (setq sheetcnt 0 util 0.0 placed 0 total 0 W nil H nil
                partlen 0.0 cutlen 0.0 saved 0.0 crat 0.0
                maxu nil q90 nil q95 nil)
          (foreach toks parsed
            (if (and toks (= (car toks) "RESULT"))
              (setq sheetcnt (atoi (nth 1 toks)) util (atof (nth 2 toks))
                    placed (atoi (nth 4 toks)) total (atoi (nth 5 toks)))
            )
            (if (and toks (= (car toks) "STATS"))
              (setq partlen (atof (nth 1 toks)) cutlen (atof (nth 2 toks))
                    saved (atof (nth 3 toks)) crat (atof (nth 4 toks)))
            )
            (if (and toks (= (car toks) "TARGET"))
              (setq maxu (atof (nth 1 toks)) q90 (atoi (nth 2 toks))
                    q95 (atoi (nth 3 toks)))
            )
            (if (and toks (= (car toks) "SHEET") (null W))
              (setq W (atof (nth 2 toks)) H (atof (nth 3 toks)))
            )
          )
          (if (null W) (setq W bjh2:mw H bjh2:mh))
          (bjh:layer "BJH_SHEET" "8")
          (bjh:layer "BJH_NEST" "3")
          (bjh:layer "BJH_CUT" "1")
          ;; 板框
          (setq idx 0)
          (while (< idx sheetcnt)
            (setq ox (+ ox0 (* idx (+ W 200.0))))
            (entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity")
                           '(8 . "BJH_SHEET") '(100 . "AcDbPolyline")
                           '(90 . 4) '(70 . 1)
                           (cons 10 (list ox oy0))
                           (cons 10 (list (+ ox W) oy0))
                           (cons 10 (list (+ ox W) (+ oy0 H)))
                           (cons 10 (list ox (+ oy0 H)))))
            (setq idx (1+ idx))
          )
          ;; 零件轮廓与共边路径：逐行解析一次，点表直接用 cdr 遍历（避免 nth 的 O(n^2)）
          (foreach toks parsed
            (if toks
              (cond
                ((= (car toks) "POLY")
                  (setq idx (atoi (cadr toks)))
                  (setq ox (+ ox0 (* idx (+ W 200.0))))
                  (setq pts (bjh2:pairpts (cddr toks)))
                  (if (>= (length pts) 3)
                    (progn
                      (setq j nil)
                      (foreach p pts
                        (setq j (cons (list (+ ox (car p)) (+ oy0 (cadr p))) j)))
                      (bjh2:lwpoly (reverse j) "BJH_NEST")
                    )
                  )
                )
                ((= (car toks) "CUT")
                  (setq idx (atoi (cadr toks)))
                  (setq ox (+ ox0 (* idx (+ W 200.0))))
                  (setq pts (bjh2:pairpts (cddr toks)))
                  (if (>= (length pts) 3)
                    (progn
                      (setq j nil)
                      (foreach p pts
                        (setq j (cons (list (+ ox (car p)) (+ oy0 (cadr p))) j)))
                      (bjh2:lwpoly (reverse j) "BJH_CUT")
                    )
                  )
                )
              )
            )
          )
          (list sheetcnt util placed total W H partlen cutlen saved crat
                maxu q90 q95)
        )
      )
    )
  )
)

;; ------------------------------------------------------------
;;  在线更新（仅下载脚本文件；套料运行时不变，图纸不外发）
;;  说明：更新源地址可配置，存在 %LOCALAPPDATA%\BanjinHui\update.ini
;; ------------------------------------------------------------
;; 版本号跟随主插件 bjh:appver，避免两个文件版本不一致导致反复提示更新
(setq bjh2:appver (if (and bjh:appver (= (type bjh:appver) 'STR))
                    bjh:appver
                    "2.13.13"))
(setq bjh2:defupdbase "https://banjinquan.com/static/cad-plugin-download/")

(defun bjh2:installdir ()
  (strcat (cond ((getenv "LOCALAPPDATA") (getenv "LOCALAPPDATA"))
                ((getenv "TEMP") (getenv "TEMP"))
                (T "."))
          "\\BanjinHui")
)

(defun bjh2:updini () (strcat (bjh2:installdir) "\\update.ini"))

(defun bjh2:plugdir ()
  (if (and bjh2:home (vl-file-directory-p bjh2:home))
    bjh2:home
    (bjh2:installdir))
)

(defun bjh2:engdir ( / b)
  (setq b (bjh2:engfile))
  (if b (vl-filename-directory b) (strcat (bjh2:installdir) "\\nest\\engine"))
)

(defun bjh2:exists (p / s)
  (setq s (vl-catch-all-apply 'vl-file-size (list p)))
  (and (not (vl-catch-all-error-p s)) s (> s 0))
)

(defun bjh2:load-upd ( / f s lst tmp)
  (setq bjh2:updbase bjh2:defupdbase)
  (if (findfile (bjh2:updini))
    (progn
      (setq f (open (bjh2:updini) "r"))
      (if f
        (progn
          (setq s "")
          (while (setq tmp (read-line f)) (setq s (strcat s tmp)))
          (close f)
          (setq lst (vl-catch-all-apply 'read (list s)))
          (if (and (not (vl-catch-all-error-p lst)) (listp lst) (assoc 'base lst))
            (setq bjh2:updbase (cdr (assoc 'base lst)))
          )
        )
      )
    )
  )
)

(defun bjh2:save-upd ( / f)
  (setq f (open (bjh2:updini) "w"))
  (if f (progn (prin1 (list (cons 'base bjh2:updbase)) f) (close f)))
)

(defun bjh2:split (s / i n c cur out)
  (setq i 1 n (strlen s) cur "" out nil)
  (while (<= i n)
    (setq c (substr s i 1))
    (if (or (= c "\n") (= c "\r"))
      (progn (if (/= cur "") (setq out (cons cur out))) (setq cur ""))
      (setq cur (strcat cur c))
    )
    (setq i (1+ i))
  )
  (if (/= cur "") (setq out (cons cur out)))
  (reverse out)
)

(setq bjh2:httpids '("WinHttp.WinHttpRequest.5.1"
                     "MSXML2.ServerXMLHTTP.6.0"
                     "MSXML2.ServerXMLHTTP.3.0"
                     "MSXML2.ServerXMLHTTP"
                     "MSXML2.XMLHTTP.6.0"
                     "MSXML2.XMLHTTP.3.0"
                     "MSXML2.XMLHTTP"
                     "Microsoft.XMLHTTP"))

(defun bjh2:httpopen (http url)
  (vl-catch-all-apply 'vlax-invoke (list http 'Open "GET" url :vlax-false))
  (vl-catch-all-apply 'vlax-invoke (list http 'SetTimeouts 3000 3000 8000 10000))
)

;; 某个 COM 对象失败（创建/Send/空响应）时自动换下一个
(defun bjh2:httptext (url / ids http r st txt out)
  (setq ids bjh2:httpids out nil)
  (while (and ids (null out))
    (setq http (vl-catch-all-apply 'vlax-create-object (list (car ids))))
    (setq ids (cdr ids))
    (if (or (vl-catch-all-error-p http) (null http))
      nil
      (progn
        (bjh2:httpopen http url)
        (setq r (vl-catch-all-apply 'vlax-invoke (list http 'Send)))
        (if (not (vl-catch-all-error-p r))
          (progn
            (setq st (vl-catch-all-apply 'vlax-get (list http 'Status)))
            (if (or (vl-catch-all-error-p st)
                    (= st 200) (= st "200") (= st 0))
              (progn
                (setq txt (vl-catch-all-apply 'vlax-get (list http 'ResponseText)))
                (if (and (not (vl-catch-all-error-p txt)) txt (/= txt ""))
                  (setq out txt))
              )
            )
          )
        )
        (vl-catch-all-apply 'vlax-release-object (list http))
      )
    )
  )
  out
)

(defun bjh2:httpfile (url dst / ids http r st rb stream sz ok)
  (setq ok nil ids bjh2:httpids)
  (while (and ids (null ok))
    (setq http (vl-catch-all-apply 'vlax-create-object (list (car ids))))
    (setq ids (cdr ids))
    (if (or (vl-catch-all-error-p http) (null http))
      nil
      (progn
        (bjh2:httpopen http url)
        (setq r (vl-catch-all-apply 'vlax-invoke (list http 'Send)))
        (if (not (vl-catch-all-error-p r))
          (progn
            (setq st (vl-catch-all-apply 'vlax-get (list http 'Status)))
            (if (or (vl-catch-all-error-p st)
                    (= st 200) (= st "200") (= st 0))
              (progn
                (setq rb (vl-catch-all-apply 'vlax-get (list http 'ResponseBody)))
                (if (not (vl-catch-all-error-p rb))
                  (progn
                    (setq stream (vl-catch-all-apply 'vlax-create-object (list "ADODB.Stream")))
                    (if (not (vl-catch-all-error-p stream))
                      (progn
                        (vl-catch-all-apply 'vlax-put (list stream 'Type 1))
                        (vl-catch-all-apply 'vlax-invoke (list stream 'Open))
                        (vl-catch-all-apply 'vlax-invoke (list stream 'Write rb))
                        (vl-catch-all-apply 'vlax-invoke (list stream 'SaveToFile dst 2))
                        (vl-catch-all-apply 'vlax-invoke (list stream 'Close))
                        (vl-catch-all-apply 'vlax-release-object (list stream))
                        (setq sz (vl-catch-all-apply 'vl-file-size (list dst)))
                        (if (and (not (vl-catch-all-error-p sz)) sz (> sz 0)) (setq ok T))
                      )
                    )
                  )
                )
              )
            )
          )
        )
        (vl-catch-all-apply 'vlax-release-object (list http))
      )
    )
  )
  ok
)

(defun bjh2:walk-support (root depth / d out)
  (setq out nil)
  (if (and root (vl-file-directory-p root) (> depth 0))
    (foreach d (vl-directory-files root nil -1)
      (if (not (member d '("." "..")))
        (progn
          (setq d (strcat root "\\" d))
          (if (vl-file-directory-p d)
            (if (= (strcase (vl-filename-base d)) "SUPPORT")
              (setq out (cons d out))
              (setq out (append out (bjh2:walk-support d (1- depth))))
            )
          )
        )
      )
    )
  )
  out
)

(defun bjh2:sync-support ( / ap sd fn src)
  (setq ap (getenv "APPDATA"))
  (if ap
    (foreach sd (bjh2:walk-support (strcat ap "\\Autodesk") 6)
      (foreach fn '("bjh.lsp" "bjh_nest.lsp")
        (setq src (strcat (bjh2:plugdir) "\\" fn))
        (if (bjh2:exists src)
          (vl-catch-all-apply 'vl-file-copy (list src (strcat sd "\\" fn)))
        )
      )
    )
  )
)

(defun bjh2:reload ( / d)
  (foreach f '("bjh.lsp" "bjh_nest.lsp")
    (setq d (strcat (bjh2:plugdir) "\\" f))
    (if (bjh2:exists d) (vl-catch-all-apply 'load (list d)))
  )
)

;; 确保配套的高精度求解内核（PackingSolver，约 6MB）存在；老包首次更新时按需补下
(defun bjh2:ensure-ps ( / eng d dst sz)
  (setq eng (bjh2:engdir))
  (setq d (strcat eng "\\ps"))
  (setq dst (strcat d "\\packingsolver_irregular.exe"))
  (cond
    ((bjh2:exists dst) T)
    ((not (bjh2:exists (strcat eng "\\run_nest.bat"))) nil)
    (T
      (if (not (vl-file-directory-p d))
        (vl-catch-all-apply 'vl-mkdir (list d)))
      (princ "\n  正在补下高精度求解内核（约 6MB，仅一次）...")
      (if (bjh2:httpfile (strcat bjh2:updbase "upd/ps/packingsolver_irregular.exe?t=" (itoa (getvar "MILLISECS"))) dst)
        (progn
          (setq sz (vl-catch-all-apply 'vl-file-size (list dst)))
          (if (and (not (vl-catch-all-error-p sz)) sz (> sz 5000000))
            (progn (princ " 完成") T)
            (progn
              (vl-catch-all-apply 'vl-file-delete (list dst))
              (princ " 未获取（将用本地启发式）")
              nil
            )
          )
        )
        (progn (princ " 未获取（将用本地启发式）") nil)
      )
    )
  )
)

(defun bjh2:update-flow ( / txt lines srvver flist fn dst n succ msg)
  (bjh2:load-upd)
  (princ (strcat "\n当前版本 v" bjh2:appver "，正在检查更新..."))
  (setq txt (bjh2:httptext (strcat bjh2:updbase "upd/version.txt?t=" (itoa (getvar "MILLISECS")))))
  (if (null txt)
    (progn
      (princ "\n无法连接更新服务器（检查网络，或从下载页取离线小更新包）。")
      (princ (strcat "\n更新地址：" bjh2:updbase))
      (alert (strcat "检查更新：无法连接更新服务器。\n\n请检查网络后重试，"
                     "或从下载页获取离线更新包。\n\n更新地址：" bjh2:updbase))
      nil
    )
    (progn
      (setq lines (bjh2:split txt))
      (setq srvver (if lines (car lines) ""))
      (setq flist (cdr lines))
      (if (= srvver bjh2:appver)
        (progn
          (princ (strcat "\n已是最新版本 v" bjh2:appver "。"))
          (bjh2:ensure-ps)
          (alert (strcat "检查更新：当前已是最新版本 v" bjh2:appver "。"))
          T
        )
        (progn
          (princ (strcat "\n发现新版本 v" srvver "，开始更新（仅脚本，约 200KB）..."))
          (setq n 0 succ 0)
          (foreach fn flist
            (setq n (1+ n))
            (setq dst
              (if (wcmatch (strcase fn) "*.LSP")
                (strcat (bjh2:plugdir) "\\" fn)
                (strcat (bjh2:engdir) "\\" fn)))
            (if (bjh2:httpfile (strcat bjh2:updbase "upd/files/" fn "?t=" (itoa (getvar "MILLISECS"))) dst)
              (setq succ (1+ succ)))
            (princ (strcat "\n  [" (itoa n) "/" (itoa (length flist)) "] " fn
                           (if (bjh2:exists dst) "  ok" "  失败")))
          )
          (bjh2:sync-support)
          (bjh2:ensure-ps)
          (setq msg (strcat "更新完成：" (itoa succ) "/" (itoa n) " 个文件。\n\n"
                            "新版本 v" srvver " 已生效。"))
          (princ (strcat "\n" msg))
          (bjh2:reload)
          (princ "\n新版本已生效，引擎脚本下次套料即用。")
          (alert msg)
          T
        )
      )
    )
  )
)

(defun c:BJHUPD ()
  (princ "\n==== 钣金汇 在线更新 ====")
  (bjh2:update-flow)
  (princ)
)

;; ------------------------------------------------------------
;;  设置面板
;; ------------------------------------------------------------
;; 常用板材规格下拉
(defun bjh2:onsheet ( / v)
  (setq v (get_tile "sheetsize"))
  (cond
    ((= v "0") (set_tile "board_w" "1220") (set_tile "board_h" "2440"))
    ((= v "1") (set_tile "board_w" "1500") (set_tile "board_h" "3000"))
    ((= v "2") (set_tile "board_w" "1000") (set_tile "board_h" "2000"))
    ((= v "3") (set_tile "board_w" "2000") (set_tile "board_h" "4000"))
    ((= v "4") (set_tile "board_w" "1250") (set_tile "board_h" "2500"))
    (T nil)
  )
)
;; 拾取/添加：先提交当前行并记下覆盖，再关窗去拾取
(defun bjh2:onpick ()
  (bjh:onapply)
  (bjh:save-ovr)
  (done_dialog 10)
)
(defun bjh2:onok ( / w h g m an bu tk)
  (if (null bjh:types)
    (progn (alert "清单为空：请先点“拾取/添加零件”选择要套料的零件。") nil)
    (progn
      (bjh:onapply)
      (setq w (atof (get_tile "board_w")))
      (setq h (atof (get_tile "board_h")))
      (setq tk (atof (get_tile "board_t")))
      (setq g (atof (get_tile "gap")))
      (setq m (atof (get_tile "margin")))
      (setq an (atof (get_tile "angle")))
      (setq bu (atof (get_tile "budget")))
      (if (or (<= w 0) (<= h 0))
        (progn (alert "板材尺寸无效，请检查。") nil)
        (progn
          (setq bjh2:mw w bjh2:mh h bjh2:mt (if (> tk 0) tk 2.0) bjh2:mgap g bjh2:mmargin m
                bjh2:mangle (if (> an 0) an 15.0) bjh2:mbudget (if (> bu 0) bu 15.0)
                bjh2:mirror (= (get_tile "mirror") "1")
                bjh2:mcom (= (get_tile "common") "1")
                bjh:mt bjh2:mt)
          (bjh2:save-settings)
          T
        )
      )
    )
  )
)

;; ============================================================
;;  现代套料界面（本地浏览器窗口；由便携 Python 提供，仅本机回环）
;;  说明：LISP 写 ui_in.txt → 启动界面 → 轮询 ui_out.txt → 回填参数。
;;        全程 127.0.0.1 本机通信，不联网、不上传图纸。
;; ============================================================
(defun bjh2:pythonw ( / e)
  (setq e (bjh2:engfile))
  (if e
    (strcat (vl-filename-directory (vl-filename-directory e)) "\\python\\pythonw.exe")
    nil
  )
)

(defun bjh2:uipy () (strcat (bjh2:engdir) "\\bjh_ui.py"))

(defun bjh2:uiaval ( / py)
  (setq py (bjh2:pythonw))
  (and bjh2:engok
       (setq bjh2:pyw py)
       py (findfile py)
       (findfile (bjh2:uipy)))
)

(defun bjh2:uitmpdir ( / base d)
  (setq base (cond ((getenv "TEMP") (getenv "TEMP"))
                   ((getenv "TMP") (getenv "TMP"))
                   (T ".")))
  (setq d (strcat base "\\bjh_ui_" (itoa (fix (getvar "MILLISECS")))))
  (vl-mkdir d)
  (if (vl-file-directory-p d) d nil)
)

;; 外轮廓点表 → 归一化点串（0..1000，最多 240 点），供界面画缩略图
(defun bjh2:ringof (pts / n i mnx mny mxx mxy sw sh scl x y parts)
  (if (< (length pts) 3)
    nil
    (progn
      (setq mnx nil)
      (foreach p pts
        (if (null mnx)
          (setq mnx (car p) mny (cadr p) mxx (car p) mxy (cadr p))
          (setq mnx (min mnx (car p)) mny (min mny (cadr p))
                mxx (max mxx (car p)) mxy (max mxy (cadr p)))
        )
      )
      (setq sw (- mxx mnx) sh (- mxy mny))
      (if (< sw 1e-9) (setq sw 1.0))
      (if (< sh 1e-9) (setq sh 1.0))
      (setq scl (/ 1000.0 (max sw sh)))
      (setq parts nil n 0)
      (foreach p pts
        (if (< n 240)
          (progn
            (setq x (fix (+ 0.5 (* (- (car p) mnx) scl)))
                  y (fix (+ 0.5 (* (- (cadr p) mny) scl))))
            (setq parts (cons (strcat " " (itoa x) " " (itoa y)) parts))
            (setq n (1+ n))
          )
        )
      )
      (if parts (apply 'strcat (reverse parts)) "")
    )
  )
)

;; 兼容：由实体取轮廓
(defun bjh2:ringstr (ent)
  (bjh2:ringof (bjh:entpts ent))
)

;; 点表按外轮廓基准归一化到 0..1000（内孔与外形共用同一坐标系）
(defun bjh2:normstr (pts mnx mny scl / parts x y)
  (setq parts nil)
  (foreach p pts
    (setq x (fix (+ 0.5 (* (- (car p) mnx) scl)))
          y (fix (+ 0.5 (* (- (cadr p) mny) scl))))
    (setq parts (cons (strcat " " (itoa x) " " (itoa y)) parts))
  )
  (if parts (apply 'strcat (reverse parts)) "")
)

;; 写出界面初始状态
(defun bjh2:ui-open (path / f tries)
  ;; Windows 下 Python 正在读状态文件时，首次 open 可能瞬时失败，重试即可
  (setq tries 0 f nil)
  (while (and (null f) (< tries 100))
    (setq f (open path "w"))
    (if (null f)
      (vl-catch-all-apply (function (lambda () (command "_.delay" 20))))
    )
    (setq tries (1+ tries))
  )
  f
)

(defun bjh2:ui-write (mode types / f i ty w h cnt q m tv ring mat holeN inst
                       opts orings bb mnx mny sw sh scl hr hlines hn sig ce out)
  ;; 先把整份状态算好再落盘，避免 Python 在计算期间读到“只有表头的半截状态”
  (setq bjh2:uirev (1+ bjh2:uirev))
  (setq out (list "VERSION 1"))
  (setq out (cons (strcat "REV " (itoa bjh2:uirev)) out))
  (setq out (cons (strcat "PICKING " (if bjh2:uipicking "1" "0")) out))
  (setq out (cons (strcat "APPVER " bjh2:appver) out))
  (setq out (cons (strcat "MODE " mode) out))
  (setq out (cons (strcat "TITLE " (if (= mode "true") "真形套料" "矩形快速套料")) out))
  (setq out (cons (strcat "BOARD " (bjh2:fmt bjh:mw) " " (bjh2:fmt bjh:mh) " " (bjh2:fmt bjh:mt)) out))
  (setq out (cons (strcat "GAP " (bjh2:fmt bjh:mgap)) out))
  (setq out (cons (strcat "MARGIN " (bjh2:fmt bjh:mmargin)) out))
  (if (= mode "true")
    (progn
      (setq out (cons (strcat "ANGLE " (bjh2:fmt (if bjh2:mangle bjh2:mangle 15.0))) out))
      (setq out (cons (strcat "BUDGET " (bjh2:fmt (if bjh2:mbudget bjh2:mbudget 15.0))) out))
    )
  )
  (setq out (cons (strcat "ROTATE " (if bjh:mrot "1" "0")) out))
  (setq out (cons (strcat "MIRROR " (if bjh2:mirror "1" "0")) out))
  (setq out (cons (strcat "COMMON " (if bjh:mcom "1" "0")) out))
  (foreach mat bjh:materials (setq out (cons (strcat "MATOPT " mat) out)))
  (foreach mat bjh2:sheets
    (if (/= mat "自定义") (setq out (cons (strcat "SHEET " mat) out)))
  )
  (setq i 0)
  (foreach ty types
    (setq w (nth 0 ty) h (nth 1 ty) cnt (nth 2 ty) inst (nth 3 ty))
    (setq q (nth i bjh:qty))
    (if (or (null q) (<= q 0)) (setq q cnt))
    (setq m (nth i bjh:pmat))
    (if (null m) (setq m (if bjh:mmat bjh:mmat "碳钢板")))
    (setq tv (nth i bjh:pthk))
    (if (or (null tv) (<= tv 0)) (setq tv (if (and bjh:mt (> bjh:mt 0)) bjh:mt 2.0)))
    (setq holeN (if (and inst (listp inst) (nth 8 inst)) (nth 8 inst) 0))
    (setq ring nil hlines nil sig (nth 4 ty))
    (setq ce (if sig (assoc sig bjh2:uicache) nil))
    (if ce
      (progn
        (setq ring (nth 1 ce) hlines (nth 2 ce))
        (if (> (nth 3 ce) holeN) (setq holeN (nth 3 ce)))
      )
      (if (and inst (listp inst))
        (progn
          (setq orings nil)
          (if (nth 7 inst)
            (setq opts (nth 7 inst))
            (progn
              (setq orings (vl-catch-all-apply 'bjh2:rings (list (car inst) 0)))
              (if (vl-catch-all-error-p orings) (setq orings nil))
              (setq orings (bjh2:sort-rings orings))
              (setq opts (car orings))
              (if (null opts)
                (progn
                  (setq opts (vl-catch-all-apply 'bjh:entpts (list (car inst))))
                  (if (vl-catch-all-error-p opts) (setq opts nil))
                )
              )
            )
          )
          (if (and opts (listp opts) (>= (length opts) 3))
            (progn
              (setq bb (bjh:ptsbbox opts))
              (setq mnx (car bb) mny (cadr bb)
                    sw (- (caddr bb) (car bb))
                    sh (- (cadddr bb) (cadr bb)))
              (if (< sw 1e-9) (setq sw 1.0))
              (if (< sh 1e-9) (setq sh 1.0))
              (setq scl (/ 1000.0 (max sw sh)))
              (setq ring (bjh2:normstr opts mnx mny scl))
              (if (and orings (> (length orings) 1))
                (foreach hr (cdr orings)
                  (setq hlines (cons (bjh2:normstr hr mnx mny scl) hlines))
                )
              )
              (if (or (null orings) (<= (length orings) 1))
                (foreach ho (nth 1 inst)
                  (setq hn (vl-catch-all-apply 'bjh2:rings (list ho 0)))
                  (if (vl-catch-all-error-p hn) (setq hn nil))
                  (foreach hr (bjh2:sort-rings hn)
                    (setq hlines (cons (bjh2:normstr hr mnx mny scl) hlines))
                  )
                )
              )
              (setq hlines (reverse hlines))
              (if (> (length hlines) holeN) (setq holeN (length hlines)))
              (if sig
                (setq bjh2:uicache (cons (list sig ring hlines holeN) bjh2:uicache)))
            )
          )
        )
      )
    )
    (setq out (cons (strcat "PART " (itoa i) " " (bjh2:fmt w) " " (bjh2:fmt h) " "
                            (itoa cnt) " " (itoa q) " " m " " (bjh2:fmt tv)
                            " " (itoa holeN)) out))
    (if ring (setq out (cons (strcat "RING " (itoa i) ring) out)))
    (foreach hn hlines
      (setq out (cons (strcat "HOLE " (itoa i) hn) out))
    )
    (setq i (1+ i))
  )
  (setq out (reverse out))
  (setq f (bjh2:ui-open bjh2:uistate))
  (if (null f)
    nil
    (progn
      (foreach ln out (write-line ln f))
      (close f)
      T
    )
  )
)
;; 读取界面结果并回填全局参数；返回动作字符串（RUN/PICK/CANCEL）
(defun bjh2:ui-apply ( / f line toks tag parts it i w h tk)
  (setq bjh2:ui-action nil parts nil)
  (setq f (open bjh2:uiout "r"))
  (if f
    (progn
      (while (setq line (read-line f))
        (setq toks (bjh2:tok line))
        (setq tag (if toks (strcase (car toks)) ""))
        (cond
          ((= tag "ACTION") (setq bjh2:ui-action (strcase (nth 1 toks))))
          ((= tag "BOARD")
            (if (and (nth 1 toks) (nth 2 toks) (nth 3 toks))
              (progn
                (setq w (atof (nth 1 toks)) h (atof (nth 2 toks)) tk (atof (nth 3 toks)))
                (setq bjh:mw w bjh:mh h bjh:mt tk bjh2:mw w bjh2:mh h bjh2:mt tk))))
          ((= tag "GAP")    (if (nth 1 toks) (setq w (atof (nth 1 toks)) bjh:mgap w bjh2:mgap w)))
          ((= tag "MARGIN") (if (nth 1 toks) (setq w (atof (nth 1 toks)) bjh:mmargin w bjh2:mmargin w)))
          ((= tag "ANGLE")  (if (nth 1 toks) (setq bjh2:mangle (atof (nth 1 toks)))))
          ((= tag "BUDGET") (if (nth 1 toks) (setq bjh2:mbudget (atof (nth 1 toks)))))
          ((= tag "ROTATE") (setq bjh:mrot (= (nth 1 toks) "1")))
          ((= tag "MIRROR") (setq bjh2:mirror (= (nth 1 toks) "1")))
          ((= tag "COMMON") (setq w (nth 1 toks) bjh:mcom (= w "1") bjh2:mcom (= w "1")))
          ((= tag "PART")
            (if (and (nth 1 toks) (nth 2 toks))
              (setq parts (cons (list (atoi (nth 1 toks)) (atoi (nth 2 toks))
                                      (if (nth 3 toks) (nth 3 toks) "碳钢板")
                                      (if (nth 4 toks) (atof (nth 4 toks)) 0.0)) parts))))
        )
      )
      (close f)
      (setq parts (reverse parts))
      (setq i 0)
      (foreach ty bjh:types
        (setq it (assoc i parts))
        (if it
          (progn
            (setq bjh:qty  (bjh:setnth bjh:qty i (nth 1 it)))
            (setq bjh:pmat (bjh:setnth bjh:pmat i (nth 2 it)))
            (setq bjh:pthk (bjh:setnth bjh:pthk i (nth 3 it)))
          )
        )
        (setq i (1+ i))
      )
      (if (member bjh2:ui-action '("RUN" "PICK"))
        (cond
          ((= bjh2:uimode "true") (bjh2:save-settings))
          (T (bjh:save-settings) (bjh:save-ovr))
        )
      )
    )
  )
  bjh2:ui-action
)

(defun bjh2:poll (path timeout / t0 go)
  (setq t0 (getvar "MILLISECS") go T)
  (while (and go (< (- (getvar "MILLISECS") t0) timeout))
    (if (findfile path)
      (setq go nil)
      (vl-catch-all-apply (function (lambda () (command "_.delay" 120))))
    )
  )
  (findfile path)
)

;; 打开现代界面并等待操作；返回 1=开始套料 10=去拾取 0=取消 -1=界面不可用
(defun bjh2:ui-session (mode types / d act)
  (setq bjh2:uimode mode)
  (setq d (if (and bjh2:uilive bjh2:uidir (vl-file-directory-p bjh2:uidir))
            bjh2:uidir
            (bjh2:uitmpdir)))
  (if (null d)
    -1
    (progn
      (setq bjh2:uidir d
            bjh2:uisdir d
            bjh2:uistate (strcat d "\\ui_in.txt")
            bjh2:uiout (strcat d "\\ui_out.txt"))
      (cond
        ((null (bjh2:ui-write mode types)) -1)
        (T
          (if (findfile bjh2:uiout) (vl-file-delete bjh2:uiout))
          (setq act "")
          (while (not (member act '("RUN" "PICK" "PICKBOX" "CANCEL")))
            (if (not bjh2:uilive)
              (progn
                (startapp bjh2:pyw (strcat "\"" (bjh2:uipy) "\" \"" d "\""))
                (setq bjh2:uilive T)
              )
            )
            (if (null (bjh2:poll bjh2:uiout 240000))
              (progn
                (setq bjh2:uilive nil)
                (alert (strcat "套料界面未响应。\n\n"
                               "请确认安装的是完整版（含本地引擎），"
                               "并允许弹出本地窗口后重试。"))
                (setq act "CANCEL")
              )
              (progn
                (setq act (bjh2:ui-apply))
                (cond
                  ((= act "UPDATE")
                    (setq bjh2:uilive nil)
                    (bjh2:update-flow)
                    (if (findfile bjh2:uiout) (vl-file-delete bjh2:uiout))
                  )
                  ((member act '("RUN" "PICK" "PICKBOX")) nil)
                  (T (setq act "CANCEL"))
                )
              )
            )
          )
          (if (not (member act '("PICK" "PICKBOX"))) (setq bjh2:uilive nil))
          (cond
            ((= act "PICK") 10)
            ((= act "PICKBOX") 11)
            ((= act "RUN") 1)
            (T 0)
          )
        )
      )
    )
  )
)

(defun bjh2:dlg (types / tf f dclid ok)
  (setq bjh:types types)
  (bjh:init-attrs types)
  (setq bjh:cur 0)
  ;; 参数初值：优先上次记忆，其次默认
  (if bjh2:saved
    (setq bjh2:mw (nth 0 bjh2:saved) bjh2:mh (nth 1 bjh2:saved) bjh2:mt (nth 2 bjh2:saved)
          bjh2:mgap (nth 3 bjh2:saved) bjh2:mmargin (nth 4 bjh2:saved)
          bjh2:mangle (nth 5 bjh2:saved) bjh2:mbudget (nth 6 bjh2:saved)
          bjh2:mirror (nth 7 bjh2:saved) bjh2:mcom (nth 8 bjh2:saved))
    (setq bjh2:mw 1220.0 bjh2:mh 2440.0 bjh2:mt 2.0 bjh2:mgap 2.0 bjh2:mmargin 3.0
          bjh2:mangle 5.0 bjh2:mbudget 15.0 bjh2:mirror T bjh2:mcom nil)
  )
  ;; 旧版默认值升级：老用户没动过参数时，120 秒太慢，降到 15 秒出结果
  (if (and (equal bjh2:mgap 5.0 1e-6) (equal bjh2:mmargin 8.0 1e-6)
           (equal bjh2:mangle 15.0 1e-6) (equal bjh2:mbudget 60.0 1e-6))
    (setq bjh2:mgap 2.0 bjh2:mmargin 3.0 bjh2:mangle 5.0 bjh2:mbudget 15.0)
  )
  (if (and (equal bjh2:mgap 2.0 1e-6) (equal bjh2:mmargin 3.0 1e-6)
           (equal bjh2:mangle 5.0 1e-6) (equal bjh2:mbudget 120.0 1e-6))
    (setq bjh2:mbudget 15.0)
  )
  (setq bjh:mw bjh2:mw bjh:mh bjh2:mh bjh:mt bjh2:mt bjh:mgap bjh2:mgap
        bjh:mmargin bjh2:mmargin bjh:mcom bjh2:mcom)
  ;; 首选本地现代界面（不可用或失败时自动回退旧对话框）
  (if (and (bjh2:uiaval)
           (setq ok (bjh2:ui-session "true" types))
           (>= ok 0))
    ok
    (progn
  (setq tf (vl-filename-mktemp "bjh2dcl" nil ".dcl"))
  (setq f (open tf "w"))
  (write-line (strcat "bjh2_dlg : dialog { label = \"钣金汇 · 真形套料 v" bjh2:appver "   （本地引擎 · 图纸不外发）\";") f)
  (write-line "  : row {" f)
  (write-line "    : column {" f)
  (write-line "      : boxed_column { label = \"① 零件清单\";" f)
  (write-line "        : text { key = \"hdr\"; label = \"编号 / 尺寸 / 数量 / 材料 / 板厚    ——— 选一行，在下方改后点“应用到本行”\"; }" f)
  (write-line "        : list_box { key = \"lst\"; height = 12; width = 50; }" f)
  (write-line "        : row {" f)
  (write-line "          : edit_box { key = \"qty\"; label = \"数量\"; edit_width = 5; }" f)
  (write-line "          : popup_list { key = \"pmat\"; label = \"材料\"; width = 12; }" f)
  (write-line "          : edit_box { key = \"pthk\"; label = \"板厚\"; edit_width = 5; }" f)
  (write-line "        }" f)
  (write-line "        : row {" f)
  (write-line "          : button { key = \"apply\"; label = \"应用到本行\"; }" f)
  (write-line "          : button { key = \"refresh\"; label = \"刷新预览\"; }" f)
  (write-line "          : button { key = \"pick\"; label = \"＋ 拾取 / 添加零件\"; }" f)
  (write-line "        }" f)
  (write-line "      }" f)
  (write-line "    }" f)
  (write-line "    : column {" f)
  (write-line "      : boxed_column { label = \"② 零件预览\";" f)
  (write-line "        : image { key = \"prev\"; width = 40; height = 10; }" f)
  (write-line "      }" f)
  (write-line "      : boxed_column { label = \"③ 板材\";" f)
  (write-line "        : popup_list { key = \"sheetsize\"; label = \"常用规格\"; width = 18; }" f)
  (write-line "        : edit_box { key = \"board_w\"; label = \"宽 mm\"; edit_width = 8; }" f)
  (write-line "        : edit_box { key = \"board_h\"; label = \"高 mm\"; edit_width = 8; }" f)
  (write-line "        : edit_box { key = \"board_t\"; label = \"厚 mm\"; edit_width = 8; }" f)
  (write-line "      }" f)
  (write-line "      : boxed_column { label = \"④ 排版参数\";" f)
  (write-line "        : edit_box { key = \"gap\"; label = \"零件间距 mm\"; edit_width = 8; }" f)
  (write-line "        : edit_box { key = \"margin\"; label = \"板材边距 mm\"; edit_width = 8; }" f)
  (write-line "        : edit_box { key = \"angle\"; label = \"旋转角步长 度\"; edit_width = 8; }" f)
  (write-line "        : edit_box { key = \"budget\"; label = \"计算时间 秒\"; edit_width = 8; }" f)
  (write-line "        : toggle { key = \"mirror\"; label = \"允许翻转镜像\"; }" f)
  (write-line "        : toggle { key = \"common\"; label = \"真共边切割（零间距，共边合并）\"; }" f)
  (write-line "      }" f)
  (write-line "    }" f)
  (write-line "  }" f)
  (write-line "  : row {" f)
  (write-line "    : spacer { width = 32; }" f)
  (write-line "    : button { key = \"accept\"; label = \"开始真形套料\"; is_default = true; width = 18; }" f)
  (write-line "    : button { key = \"upd\"; label = \"检查更新\"; }" f)
  (write-line "    : button { key = \"cancel\"; label = \"取消\"; is_cancel = true; }" f)
  (write-line "  }" f)
  (write-line "}" f)
  (close f)
  (setq dclid (load_dialog tf))
  (setq ok 0)
  (if (< dclid 0)
    (progn
      (princ "\n提示：本环境不支持对话框，已改用默认参数（按图中数量排版）。")
      (setq bjh2:mw 1220.0 bjh2:mh 2440.0 bjh2:mt 2.0 bjh2:mgap 2.0 bjh2:mmargin 3.0
            bjh2:mangle 5.0 bjh2:mbudget 15.0 bjh2:mirror T bjh2:mcom nil bjh2:mkerf 0.0
            bjh:cur 0)
      (setq ok 1)
    )
    (progn
      (if (new_dialog "bjh2_dlg" dclid)
        (progn
          (if bjh2:saved
            (progn
              (set_tile "board_w" (rtos (nth 0 bjh2:saved) 2 1))
              (set_tile "board_h" (rtos (nth 1 bjh2:saved) 2 1))
              (set_tile "board_t" (rtos (nth 2 bjh2:saved) 2 1))
              (set_tile "gap" (rtos (nth 3 bjh2:saved) 2 1))
              (set_tile "margin" (rtos (nth 4 bjh2:saved) 2 1))
              (set_tile "angle" (rtos (nth 5 bjh2:saved) 2 1))
              (set_tile "budget" (rtos (nth 6 bjh2:saved) 2 1))
              (set_tile "mirror" (if (nth 7 bjh2:saved) "1" "0"))
              (set_tile "common" (if (nth 8 bjh2:saved) "1" "0"))
            )
            (progn
              (set_tile "board_w" "1220")
              (set_tile "board_h" "2440")
              (set_tile "board_t" "2")
              (set_tile "gap" "5")
              (set_tile "margin" "8")
              (set_tile "angle" "15")
              (set_tile "budget" "15")
              (set_tile "mirror" "1")
              (set_tile "common" "0")
            )
          )
          (start_list "sheetsize")
          (foreach s bjh2:sheets (add_list s))
          (end_list)
          (set_tile "sheetsize" "5")
          (start_list "pmat")
          (foreach m bjh:materials (add_list m))
          (end_list)
          (bjh:fill-list "lst" (bjh:items))
          (if bjh:qty
            (progn (set_tile "lst" "0") (bjh:onlist "0"))
          )
          (action_tile "lst" "(bjh:onlist $value)")
          (action_tile "apply" "(bjh:onapply)")
          (action_tile "refresh" "(bjh:onprev)")
          (action_tile "sheetsize" "(bjh2:onsheet)")
          (action_tile "pick" "(bjh2:onpick)")
          (action_tile "accept" "(if (bjh2:onok) (done_dialog 1))")
          (action_tile "upd" "(done_dialog 2)")
          (action_tile "cancel" "(done_dialog 0)")
          (bjh:preview "prev")
          (setq ok (start_dialog))
        )
        (progn
          (princ "\n对话框定义有误，已取消。")
          (setq ok 0)
        )
      )
      (unload_dialog dclid)
    )
  )
  (if (and tf (findfile tf)) (vl-file-delete tf))
  ok
      )
    )
  )

;; ------------------------------------------------------------
;;  主命令
;; ------------------------------------------------------------
;; 删除临时文件（不存在也不报错）
(defun bjh2:rm (p)
  (if (and p (= (type p) 'STR))
    (vl-catch-all-apply 'vl-file-delete (list p)))
)
;; 材料分组累加：groups 为 ((材料 . items) ...)，items 为 ((实例 . 数量) ...)
(defun bjh2:grp-add (groups mat item / found out)
  (setq found nil out nil)
  (foreach g groups
    (if (equal (car g) mat)
      (progn (setq found T)
             (setq out (append out (list (cons (car g) (append (cdr g) (list item)))))))
      (setq out (append out (list g)))
    )
  )
  (if (not found) (setq out (append out (list (cons mat (list item))))))
  out
)

;; 取包含指定实体的零件（只扫描该实体包围盒范围，速度可控）
(defun bjh2:part-at-1 (ent / obj mn mx p1 p2 ss parts found inst)
  (setq obj (vl-catch-all-apply 'vlax-ename->vla-object (list ent)))
  (if (vl-catch-all-error-p obj)
    nil
    (progn
      (setq mn nil mx nil)
      (vl-catch-all-apply 'vla-getboundingbox (list obj 'mn 'mx))
      (if (or (null mn) (null mx))
        nil
        (progn
          (setq p1 (vlax-safearray->list mn) p2 (vlax-safearray->list mx))
          (setq p1 (list (- (car p1) 1.0) (- (cadr p1) 1.0) 0.0)
                p2 (list (+ (car p2) 1.0) (+ (cadr p2) 1.0) 0.0))
          (setq ss (ssget "_W" p1 p2
                          '((0 . "LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE,ARC,LINE,SPLINE,REGION,INSERT"))))
          (if (null ss) (setq ss (ssadd)))
          (if (not (ssmemb ent ss)) (ssadd ent ss))
          (setq parts (bjh:sort-parts (bjh:group ss)))
          (setq found nil)
          (foreach inst parts
            (if (and (null found)
                     (or (equal ent (car inst))
                         (member ent (nth 1 inst))))
              (setq found (list inst))
            )
          )
          found
        )
      )
    )
  )
)

;; 安全包装：任何几何异常都只当作「未识别」，不让整次拾取中断
(defun bjh2:part-at (ent / r)
  (setq r (vl-catch-all-apply 'bjh2:part-at-1 (list ent)))
  (if (vl-catch-all-error-p r) nil r)
)

;; 连续点选：每点一个零件就刷新面板（不关窗）
(defun bjh2:pick-live-1 ( / sel ent one go added)
  (setq added 0 go T)
  (while go
    (setq sel (entsel "\n点选零件外轮廓（可连续点选，回车结束）："))
    (if (null sel)
      (setq go nil)
      (progn
        (setq ent (car sel))
        (setq one (bjh2:part-at ent))
        (if one
          (progn
            (setq bjh:acc (append bjh:acc one) added (1+ added))
            (setq bjh:types (bjh:mkgtypes (bjh:sort-parts bjh:acc)))
            (if bjh2:uistate (bjh2:ui-write bjh2:uimode bjh:types))
            (princ (strcat "\n已加入 " (itoa added) " 个零件（面板已刷新）。"))
          )
          (princ "\n该对象无法识别为零件，请点选闭合外轮廓；多段线/散线环也可以。")
        )
      )
    )
  )
  added
)

;; Esc 或几何异常时也要复位拾取状态，避免面板一直悬浮在 CAD 之上
(defun bjh2:pick-live ( / r)
  (setq bjh2:uipicking T)
  (if bjh2:uistate (bjh2:ui-write bjh2:uimode bjh:types))
  (setq r (vl-catch-all-apply 'bjh2:pick-live-1 nil))
  (setq bjh2:uipicking nil)
  (setq bjh:types (bjh:mkgtypes (bjh:sort-parts bjh:acc)))
  (if bjh2:uistate (bjh2:ui-write bjh2:uimode bjh:types))
  (if (vl-catch-all-error-p r) 0 r)
)

(defun bjh2:pick-box-1 ( / ss parts)
  (princ "\n框选要加入清单的零件（回车或右键结束）：")
  (setq ss (ssget '((0 . "LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE,ARC,LINE,SPLINE,REGION,INSERT"))))
  (if ss
    (progn
      (setq parts (vl-catch-all-apply 'bjh:group (list ss)))
      (if (vl-catch-all-error-p parts) (setq parts nil))
      (setq parts (bjh:sort-parts parts))
      (if parts
        (setq bjh:acc (append bjh:acc parts))
        (princ "\n未识别到有效零件（加密块/代理对象请先 EXPLODE）。")
      )
    )
    (princ "\n未选择零件。")
  )
)

;; 框选添加：选完一次性回填并刷新
(defun bjh2:pick-box ( / r)
  (setq bjh2:uipicking T)
  (if bjh2:uistate (bjh2:ui-write bjh2:uimode bjh:types))
  (setq r (vl-catch-all-apply 'bjh2:pick-box-1 nil))
  (setq bjh2:uipicking nil)
  (setq bjh:types (bjh:mkgtypes (bjh:sort-parts bjh:acc)))
  (if bjh2:uistate (bjh2:ui-write bjh2:uimode bjh:types))
  (if (vl-catch-all-error-p r)
    (princ "\n已结束拾取。")
    (princ (strcat "\n清单现有 " (itoa (length bjh:acc)) " 个零件。"))
  )
)

(defun c:BJH2 ( / ss parts bat inp outp res maxR minY ox0 oy0 dr go
                 groups items i mat ty ts tp sumArea util v pf savedLen)
  (bjh:gate)
  (bjh:pushsys)
  (princ (strcat "\n==== 钣金汇 · 真形套料 v" bjh2:appver "（本地引擎，图纸不外发）===="))
  (setq bjh2:uicache nil bjh2:uirev 0)
  (setq bat (bjh2:engfile))
  (if (null bat)
    (progn
      (alert (strcat "未找到本地套料引擎。\n\n请先安装“钣金汇 真形引擎包”，"
                     "或下载后解压到：\n%LOCALAPPDATA%\\BanjinHui\\nest\\\n\n"
                     "（本项目 bjh_nest.lsp 同目录下的 nest\\engine\\run_nest.bat 也可）。\n\n"
                     "未安装引擎时可使用命令 BJH（矩形快速套料）。"))
      (princ "\n未找到引擎，已中止。")
    )
    (progn
      ;; 起始清单：若命令前已选中对象，先纳入清单
      (setq bjh:acc nil)
      (setq ss (vl-catch-all-apply 'ssget (list "_I")))
      (if (and ss (not (vl-catch-all-error-p ss)) (> (sslength ss) 0))
        (progn
          (setq parts (bjh:sort-parts (bjh:group ss)))
          (if parts (setq bjh:acc (append bjh:acc parts)))
        )
      )
      (setq go T)
      (while go
        (setq bjh:types (bjh:mkgtypes (bjh:sort-parts bjh:acc)))
        (setq dr (bjh2:dlg bjh:types))
        (cond
          ((= dr 10) (bjh2:pick-live))
          ((= dr 11) (bjh2:pick-box))
          ((= dr 2) (bjh2:update-flow))
          ((= dr 1)
            (progn
              ;; 按材料分组（每零件材料/板厚独立）
              (setq groups nil i 0)
              (foreach ty bjh:types
                (setq mat (if (nth i bjh:pmat) (nth i bjh:pmat) "碳钢板"))
                (setq groups (bjh2:grp-add groups mat (cons (nth 3 ty) (nth i bjh:qty))))
                (setq i (1+ i))
              )
              ;; 绘制起点：原图右侧
              (setq maxR nil minY nil)
              (foreach pf bjh:acc
                (setq v (+ (nth 2 pf) (nth 4 pf)))
                (if (or (null maxR) (> v maxR)) (setq maxR v))
                (if (or (null minY) (< (nth 3 pf) minY)) (setq minY (nth 3 pf)))
              )
              (setq ox0 (+ (if maxR maxR 0.0) 200.0) oy0 (if minY minY 0.0))
              (setq ts 0 tp 0 sumArea 0.0 savedLen 0.0 i 0)
              (foreach ty bjh:types
                (setq sumArea (+ sumArea (* (nth i bjh:qty) (nth 6 ty))))
                (setq i (1+ i))
              )
              (foreach grp groups
                (setq mat (car grp) items (cdr grp))
                (setq inp (vl-filename-mktemp "bjh2in" nil ".bjh"))
                (setq outp (vl-filename-mktemp "bjh2out" nil ".nest"))
                (princ (strcat "\n正在排版材料：" mat
                               "（与网站同一套求解内核，最省料；零件越多/越异形耗时越长，"
                               "请稍候不要关闭 AutoCAD）..."))
                (if (and (bjh2:write-in inp items) (bjh2:run bat inp outp))
                  (progn
                    (setq res (bjh2:draw outp ox0 oy0))
                    (if res
                      (progn
                        (setq ts (+ ts (nth 0 res)) tp (+ tp (nth 2 res)))
                        (princ (strcat "\n  " mat "：用板 " (itoa (nth 0 res))
                                       " 张，放置 " (itoa (nth 2 res)) "/" (itoa (nth 3 res))
                                       " 件，利用率 " (rtos (* 100.0 (nth 1 res)) 2 1) "%"))
                        (if (and bjh2:mcom (> (nth 8 res) 0.0))
                          (progn
                            (setq savedLen (+ savedLen (nth 8 res)))
                            (princ (strcat "，共边省切割 " (rtos (nth 8 res) 2 0) " mm（"
                                           (rtos (* 100.0 (nth 9 res)) 2 1) "%）"))
                          )
                        )
                        (if (and (nth 10 res) (< (nth 10 res) 0.9))
                          (princ (strcat "；当前数量理论上限 "
                                         (rtos (* 100.0 (nth 10 res)) 2 1)
                                         "%，凑到90%需 " (itoa (nth 11 res))
                                         " 件、95%需 " (itoa (nth 12 res)) " 件"))
                        )
                        (setq ox0 (+ ox0 (* (nth 0 res) (+ bjh2:mw 200.0))))
                      )
                    )
                  )
                )
                (bjh2:rm inp)
                (bjh2:rm outp)
                (if outp (bjh2:rm (strcat outp ".json")))
                (setq inp nil outp nil)
              )
              (setq util
                    (if (> ts 0)
                      (* 100.0
                         (/ sumArea
                            (* ts
                               (max 1.0 (- bjh2:mw (* 2.0 bjh2:mmargin)))
                               (max 1.0 (- bjh2:mh (* 2.0 bjh2:mmargin))))))
                      0.0))
              (setq bjh:mw bjh2:mw bjh:mh bjh2:mh)
              (princ (strcat "\n真形套料完成：使用板材 " (itoa ts) " 张，放置 " (itoa tp) " 件"))
              (princ (strcat "\n材料利用率约 " (rtos util 2 1) " %"))
              (if (> savedLen 0.0)
                (princ (strcat "\n共边切割共省切割路径约 " (rtos savedLen 2 0)
                               " mm（已按共边路径出图到 BJH_CUT）"))
              )
              (bjh:report util ts tp)
              (princ "\n结果已画到图层 BJH_NEST/BJH_CUT，板料框在 BJH_SHEET（原图保留不动）。")
              (setq go nil)
            )
          )
          (T (princ "\n已取消。") (setq go nil))
        )
      )
    )
  )
  (bjh:popsys)
  (princ)
)

(bjh2:load-settings)
(bjh2:load-upd)
(setq bjh2:engok (if (bjh2:engfile) T nil))
(setq bjh2:loaded T)
(princ (strcat "\n钣金汇 真形套料 BJH2 v" bjh2:appver " 已加载。引擎："))
(princ (if bjh2:engok "已就绪" "未安装（可用 BJH 矩形套料）"))
(princ "。输入 BJ 打开工具箱，或 BJHUPD 在线更新。")
(princ)