;;;=====================================================================
;;; HATCH FLOW - AutoLISP 填充图案收藏夹插件 (AutoCAD)
;;;
;;; 命令: HS   打开 Hatch Flow 面板
;;;
;;; 功能:
;;;   - 收藏常用填充图案 (名称/比例/角度/颜色/分组)
;;;   - 新增收藏 (手动输入图案名) 或从图形中已有的填充对象拾取参数
;;;   - 上移 / 下移 手动排序，可用分组名给收藏项分类显示
;;;   - 重置默认收藏
;;;   - 原生颜色选择器 (acad_colordlg)
;;;   - 应用到选择集 / 拾取内部点两种填充方式，填充完成后自动结束命令
;;;   - 收藏数据持久化保存在 %APPDATA%\HatchFlow\bookmarks.dat
;;;   - DCL 对话框在运行时自动生成，只需加载这一个 .lsp 文件
;;;
;;; 使用方法:
;;;   1. APPLOAD 加载本文件
;;;   2. 输入 HS 回车
;;;=====================================================================

(vl-load-com)

;; ---------------------------------------------------------------
;; 存储路径
;; ---------------------------------------------------------------
(setq *hb-data-dir* (strcat (getenv "APPDATA") "\\HatchFlow"))
(if (not (vl-file-directory-p *hb-data-dir*))
  (vl-mkdir *hb-data-dir*)
)
(setq *hb-data-file* (strcat *hb-data-dir* "\\bookmarks.dat"))
(setq *hb-dcl-file*  (strcat *hb-data-dir* "\\hatch_flow.dcl"))

;; ---------------------------------------------------------------
;; 会话状态
;; ---------------------------------------------------------------
;; 每个收藏项结构: (名称 图案 比例 角度 颜色索引 分组)
(setq *hb-bookmarks* nil)
(setq *hb-cur-index* nil)
(setq *hb-cur-scale* "100")
(setq *hb-cur-angle* "0")
(setq *hb-cur-color* 8)       ;; 默认颜色索引 8

;; ---------------------------------------------------------------
;; 默认收藏项 (仅首次运行 / 重置时使用)
;; ---------------------------------------------------------------
(defun hb:defaults ()
  (list
    (list "ANSI31 - 通用"     "ANSI31"  100.0 0.0 8 "")
    (list "EARTH - 地面"      "EARTH"   100.0 0.0 8 "")
    (list "AR-CONC - 混凝土"  "AR-CONC" 100.0 0.0 8 "")
    (list "NET - 网格"        "NET"     100.0 0.0 8 "")
    (list "GRASS - 草地/景观" "GRASS"   100.0 0.0 8 "")
  )
)

;; ---------------------------------------------------------------
;; 数据持久化 (含旧版本数据迁移: 5 元素 -> 6 元素，补分组字段)
;; ---------------------------------------------------------------
(defun hb:normalize-bookmark (bm)
  (if (< (length bm) 6)
    (append bm (list ""))
    bm
  )
)

(defun hb:load-bookmarks ( / f)
  (if (findfile *hb-data-file*)
    (progn
      (setq f (open *hb-data-file* "r"))
      (setq *hb-bookmarks* (read (read-line f)))
      (close f)
      (setq *hb-bookmarks* (mapcar 'hb:normalize-bookmark *hb-bookmarks*))
    )
    (progn
      (setq *hb-bookmarks* (hb:defaults))
      (hb:save-bookmarks)
    )
  )
)

(defun hb:save-bookmarks ( / f)
  (setq f (open *hb-data-file* "w"))
  (write-line (vl-prin1-to-string *hb-bookmarks*) f)
  (close f)
)

;; ---------------------------------------------------------------
;; 生成 DCL 对话框定义文件
;; ---------------------------------------------------------------
(defun hb:write-dcl ( / lines f)
  (setq lines
    (list
      "hatch_bookmark : dialog {"
      "  label = \"Hatch Flow - 填充图案收藏夹\";"
      "  spacer;"
      "  : list_box { key = \"bmlist\"; label = \"已收藏图案:\"; height = 10; width = 45; }"
      "  spacer;"
      "  : row {"
      "    : edit_box { key = \"scale_edit\"; label = \"比例:\"; edit_width = 8; }"
      "    : edit_box { key = \"angle_edit\"; label = \"角度:\"; edit_width = 8; }"
      "  }"
      "  : row {"
      "    : button { key = \"color_btn\"; label = \"颜色...\"; width = 12; }"
      "    : text   { key = \"color_preview\"; label = \"当前颜色: 随层\"; width = 28; }"
      "  }"
      "  spacer;"
      "  : row {"
      "    : button { key = \"add_btn\";  label = \"新增\";       width = 10; }"
      "    : button { key = \"pick_btn\"; label = \"从图形拾取\"; width = 18; }"
      "    : button { key = \"del_btn\";  label = \"删除\";       width = 10; }"
      "  }"
      "  : row {"
      "    : button { key = \"up_btn\";    label = \"上移\";     width = 10; }"
      "    : button { key = \"down_btn\";  label = \"下移\";     width = 10; }"
      "    : button { key = \"reset_btn\"; label = \"重置默认\"; width = 12; }"
      "  }"
      "  spacer;"
      "  : row {"
      "    : button { key = \"apply_btn\";   label = \"应用到选择集\"; is_default = true; width = 16; }"
      "    : button { key = \"applypt_btn\"; label = \"拾取点填充\";   width = 16; }"
      "  }"
      "  spacer;"
      "  : button { key = \"close_btn\"; label = \"关闭\"; is_cancel = true; width = 12; }"
      "}"
    )
  )
  (setq f (open *hb-dcl-file* "w"))
  (foreach l lines (write-line l f))
  (close f)
)

;; ---------------------------------------------------------------
;; 辅助函数
;; ---------------------------------------------------------------
(defun hb:color-name (idx)
  (cond
    ((= idx 256) "随层")
    ((= idx 0)   "随块")
    ((= idx 1)   "红")
    ((= idx 2)   "黄")
    ((= idx 3)   "绿")
    ((= idx 4)   "青")
    ((= idx 5)   "蓝")
    ((= idx 6)   "洋红")
    ((= idx 7)   "白/黑")
    (t (strcat "颜色索引 " (itoa idx)))
  )
)

(defun hb:update-color-preview ()
  (set_tile "color_preview" (strcat "当前颜色: " (hb:color-name *hb-cur-color*)))
)

(defun hb:display-name (bm)
  (if (/= (nth 5 bm) "")
    (strcat "[" (nth 5 bm) "] " (car bm))
    (car bm)
  )
)

;; 交换列表中两个索引位置的元素，返回新列表 (不修改原列表)
(defun hb:swap-index (lst i j / result k item)
  (setq result nil k 0)
  (foreach item lst
    (cond
      ((= k i) (setq result (append result (list (nth j lst)))))
      ((= k j) (setq result (append result (list (nth i lst)))))
      (t (setq result (append result (list item))))
    )
    (setq k (1+ k))
  )
  result
)

(defun hb:load-fields-from-bookmark (idx / bm)
  (setq bm (nth idx *hb-bookmarks*))
  (setq *hb-cur-scale* (rtos (nth 2 bm) 2 4))
  (setq *hb-cur-angle* (rtos (nth 3 bm) 2 2))
  (setq *hb-cur-color* (nth 4 bm))
  (set_tile "scale_edit" *hb-cur-scale*)
  (set_tile "angle_edit" *hb-cur-angle*)
  (hb:update-color-preview)
)

(defun hb:populate-list ( / bm)
  (start_list "bmlist")
  (foreach bm *hb-bookmarks* (add_list (hb:display-name bm)))
  (end_list)
  (if (null *hb-bookmarks*)
    (setq *hb-cur-index* nil)
    (progn
      (if (or (null *hb-cur-index*) (>= *hb-cur-index* (length *hb-bookmarks*)))
        (setq *hb-cur-index* 0)
      )
      (set_tile "bmlist" (itoa *hb-cur-index*))
      (hb:load-fields-from-bookmark *hb-cur-index*)
    )
  )
)

;; ---------------------------------------------------------------
;; DCL 回调 (对话框打开状态下直接执行，无需关闭对话框)
;; ---------------------------------------------------------------
(defun hb:on-select (val)
  (setq *hb-cur-index* (atoi val))
  (hb:load-fields-from-bookmark *hb-cur-index*)
)

(defun hb:on-color ( / newcol)
  (setq newcol (acad_colordlg *hb-cur-color*))
  (if newcol
    (progn
      (setq *hb-cur-color* newcol)
      (hb:update-color-preview)
    )
  )
)

(defun hb:on-delete ()
  (if (and *hb-cur-index* *hb-bookmarks*)
    (progn
      (setq *hb-bookmarks* (vl-remove (nth *hb-cur-index* *hb-bookmarks*) *hb-bookmarks*))
      (hb:save-bookmarks)
      (setq *hb-cur-index* nil)
      (hb:populate-list)
    )
  )
)

(defun hb:move-up ()
  (if (and *hb-cur-index* (> *hb-cur-index* 0))
    (progn
      (setq *hb-bookmarks* (hb:swap-index *hb-bookmarks* *hb-cur-index* (1- *hb-cur-index*)))
      (setq *hb-cur-index* (1- *hb-cur-index*))
      (hb:save-bookmarks)
      (hb:populate-list)
    )
  )
)

(defun hb:move-down ()
  (if (and *hb-cur-index* (< *hb-cur-index* (1- (length *hb-bookmarks*))))
    (progn
      (setq *hb-bookmarks* (hb:swap-index *hb-bookmarks* *hb-cur-index* (1+ *hb-cur-index*)))
      (setq *hb-cur-index* (1+ *hb-cur-index*))
      (hb:save-bookmarks)
      (hb:populate-list)
    )
  )
)

(defun hb:reset-defaults ()
  (setq *hb-bookmarks* (hb:defaults))
  (setq *hb-cur-index* nil)
  (hb:save-bookmarks)
  (hb:populate-list)
)

(defun hb:capture-fields ()
  (setq *hb-cur-scale* (get_tile "scale_edit"))
  (setq *hb-cur-angle* (get_tile "angle_edit"))
)

;; ---------------------------------------------------------------
;; 需要屏幕/命令行交互的操作 (对话框关闭后执行)
;; ---------------------------------------------------------------
(defun hb:add-bookmark ( / pname bname grp sc an)
  (setq pname (getstring T "\n输入填充图案名称 (例如 ANSI31): "))
  (if (and pname (/= pname ""))
    (progn
      (setq bname (getstring T "\n输入收藏名称: "))
      (if (or (null bname) (= bname "")) (setq bname pname))
      (setq grp (getstring T "\n输入分组名称 (可选，直接回车跳过): "))
      (if (null grp) (setq grp ""))
      (setq sc (atof *hb-cur-scale*))
      (setq an (atof *hb-cur-angle*))
      (if (<= sc 0.0) (setq sc 1.0))
      (setq *hb-bookmarks*
        (append *hb-bookmarks* (list (list bname pname sc an *hb-cur-color* grp)))
      )
      (hb:save-bookmarks)
      (setq *hb-cur-index* (1- (length *hb-bookmarks*)))
    )
  )
)

(defun hb:pick-bookmark ( / es ent edata pname sc an col bname grp)
  (setq es (entsel "\n选择一个图案填充对象，以复制其图案、比例、角度和颜色: "))
  (if es
    (progn
      (setq ent (car es))
      (setq edata (entget ent))
      (if (= (cdr (assoc 0 edata)) "HATCH")
        (progn
          (setq pname (cdr (assoc 2 edata)))
          (setq sc  (if (assoc 41 edata) (cdr (assoc 41 edata)) 1.0))
          (setq an  (if (assoc 52 edata) (cdr (assoc 52 edata)) 0.0))
          (setq col (if (assoc 62 edata) (cdr (assoc 62 edata)) 256))
          (setq bname (getstring T (strcat "\n为图案 " pname " 输入收藏名称: ")))
          (if (or (null bname) (= bname "")) (setq bname pname))
          (setq grp (getstring T "\n输入分组名称 (可选，直接回车跳过): "))
          (if (null grp) (setq grp ""))
          (setq *hb-bookmarks*
            (append *hb-bookmarks* (list (list bname pname sc an col grp)))
          )
          (hb:save-bookmarks)
          (setq *hb-cur-index* (1- (length *hb-bookmarks*)))
        )
        (alert "所选对象不是图案填充。")
      )
    )
  )
)

(defun hb:validate-selection ()
  (if (null *hb-cur-index*)
    (progn (alert "请先选择一个收藏项。") nil)
    T
  )
)

;; 返回 (图案名 比例 角度)，基于当前选中收藏项及面板上的比例/角度输入框
(defun hb:current-params ( / bm sc an)
  (setq bm (nth *hb-cur-index* *hb-bookmarks*))
  (setq sc (atof *hb-cur-scale*))
  (setq an (atof *hb-cur-angle*))
  (if (<= sc 0.0) (setq sc 1.0))
  (list (nth 1 bm) sc an)
)

(defun hb:colorize-last-hatch ( / newhatch)
  (setq newhatch (entlast))
  (if (and newhatch (= (cdr (assoc 0 (entget newhatch))) "HATCH"))
    (vl-catch-all-apply
      'vla-put-color
      (list (vlax-ename->vla-object newhatch) *hb-cur-color*)
    )
  )
)

(defun hb:apply-hatch ( / params pname sc an ss)
  (if (hb:validate-selection)
    (progn
      (setq params (hb:current-params))
      (setq pname (nth 0 params) sc (nth 1 params) an (nth 2 params))
      (prompt "\n选择填充边界对象: ")
      (setq ss (ssget))
      (if ss
        (progn
          (command "_.-HATCH" "_P" pname (rtos sc 2 4) (rtos an 2 2) "_S" ss "" "")
          (hb:colorize-last-hatch)
        )
        (prompt "\n未选择对象 - 未应用填充。")
      )
    )
  )
)

(defun hb:apply-hatch-pick ( / params pname sc an pt)
  (if (hb:validate-selection)
    (progn
      (setq params (hb:current-params))
      (setq pname (nth 0 params) sc (nth 1 params) an (nth 2 params))
      (command "_.-HATCH" "_P" pname (rtos sc 2 4) (rtos an 2 2))
      (prompt "\n请在图形中依次拾取内部点，全部拾取完毕后按回车结束: ")
      (while (setq pt (getpoint "\n拾取内部点: "))
        (command pt)
      )
      (command "")
      (hb:colorize-last-hatch)
    )
  )
)

;; ---------------------------------------------------------------
;; 主命令
;; ---------------------------------------------------------------
(defun c:HS ( / dcl_id action)
  (hb:load-bookmarks)
  (hb:write-dcl)
  (setq action 2)
  (while (= action 2)
    (setq dcl_id (load_dialog *hb-dcl-file*))
    (if (not (new_dialog "hatch_bookmark" dcl_id))
      (progn
        (alert "无法加载 Hatch Flow 对话框。")
        (setq action 0)
      )
      (progn
        (hb:populate-list)
        (action_tile "bmlist"      "(hb:on-select $value)")
        (action_tile "color_btn"   "(hb:on-color)")
        (action_tile "add_btn"     "(hb:capture-fields)(done_dialog 3)")
        (action_tile "pick_btn"    "(hb:capture-fields)(done_dialog 4)")
        (action_tile "del_btn"     "(hb:on-delete)")
        (action_tile "up_btn"      "(hb:move-up)")
        (action_tile "down_btn"    "(hb:move-down)")
        (action_tile "reset_btn"   "(hb:reset-defaults)")
        (action_tile "apply_btn"   "(hb:capture-fields)(done_dialog 5)")
        (action_tile "applypt_btn" "(hb:capture-fields)(done_dialog 6)")
        (action_tile "close_btn"   "(done_dialog 0)")
        (setq action (start_dialog))
      )
    )
    (if dcl_id (unload_dialog dcl_id))
    (cond
      ((= action 3) (hb:add-bookmark)      (setq action 2))
      ((= action 4) (hb:pick-bookmark)     (setq action 2))
      ((= action 5) (hb:apply-hatch)       (setq action 0))
      ((= action 6) (hb:apply-hatch-pick)  (setq action 0))
      (t (setq action 0))
    )
  )
  (princ)
)

(princ "\nHatch Flow 已加载。输入 HS 打开面板。")
(princ)