属性块--材料替换

KO你

用腾讯元宝参考赫思的材料替换功能生成的代码，有不少问题，请大佬们完善
;;; 材料替换插件
(defun c:matreplace (/ *regpath* attdata dcl_id dcl_file fn dcl_cont
                      att_tags max_rows cur_row key_actions)
  ;; 注册表路径设置
  (setq *regpath* "HKEY_CURRENT_USER\\Software\\HSCAD\\MaterialReplace")

  ;; 获取当前图纸属性数据
  (setq attdata (get_block_attributes))

  ;; 动态生成DCL文件
  (setq dcl_file (strcat (vl-filename-mktemp) ".dcl")
        fn (open dcl_file "w"))

  ;; 构建DCL内容
  (setq dcl_cont (strcat
    "matrep : dialog { label = \"材料替换\";\n"
    "  : boxed_column { label = \"属性替换\";\n"
    "    : row {\n"
    "      : button { label = \"标记\"; width = 8; fixed_width = true; }\n"
    "      : button { label = \"当前值\"; width = 24; fixed_width = true; }\n"
    "      : button { label = \"新值\"; width = 24; fixed_width = true; }\n"
    "    }\n"
    "    spacer;\n"
    (progn
      (setq max_rows (length attdata) cur_row 0)
      (apply 'strcat
        (mapcar '(lambda (x)
                  (setq cur_row (1+ cur_row))
                  (strcat
                    ": row {\n"
                    "  : toggle { key = \"chk_" (itoa cur_row) "\"; value = 1; }\n"
                    "  : text { label = \"" (car x) "\"; width = 8; }\n"
                    "  : edit_box { key = \"cur_" (itoa cur_row) "\"; width = 24; edit_width = 20; }\n"
                    "  : edit_box { key = \"new_" (itoa cur_row) "\"; width = 24; edit_width = 20; }\n"
                    "}\n"))
                attdata)))
    "    spacer;\n"
    "    : row {\n"
    "      : text { label = \"复选框用于匹配图块，进行替换操作，未勾选的标记不会替换\"; }\n"
    "    }\n"
    "  }\n"
    "  spacer;\n"
    "  : row {\n"
    "    : button { label = \"选择替换\"; key = \"sel_replace\"; }\n"
    "    : button { label = \"全图替换\"; key = \"all_replace\"; }\n"
    "    : button { label = \"修改\"; key = \"modify\"; mnemonic = \"M\"; }\n"
    "    : button { label = \"关闭\"; key = \"cancel\"; is_cancel = true; }\n"
    "  }\n"
    "}"))

  (write-line dcl_cont fn)
  (close fn)

  ;; 加载对话框
  (setq dcl_id (load_dialog dcl_file))
  (if (not (new_dialog "matrep" dcl_id)) (exit))

  ;; 初始化控件数据
  (setq cur_row 0)
  (foreach att attdata
    (setq cur_row (1+ cur_row))
    (set_tile (strcat "chk_" (itoa cur_row)) "1")
    (set_tile (strcat "cur_" (itoa cur_row)) (cadr att))
    (set_tile (strcat "new_" (itoa cur_row)) (cadr att)))

  ;; 定义按钮动作
  (setq key_actions '(
    ("sel_replace" . (lambda () (alert "选择替换功能")))
    ("all_replace" . (lambda () (process_replace attdata t)))
    ("modify" . (lambda () (process_replace attdata nil)))
    ("cancel" . (lambda () (done_dialog 0)))))

  (foreach pair key_actions
    (action_tile (car pair)
      (strcat "(progn " (vl-prin1-to-string (cdr pair)) "(done_dialog 1))")))

  ;; 处理快捷键Ctrl+Enter
  (action_tile "new_1" "(if (= (getvar 'LASTPROMPT) \"Ctrl+Enter\") (done_dialog 2))")

  ;; 显示对话框
  (setq dcl_ret (start_dialog))
  (unload_dialog dcl_id)
  (vl-file-delete dcl_file)

  ;; 处理返回结果
  (cond
    ((= dcl_ret 2) (process_replace attdata nil))  ; Ctrl+Enter
    ((= dcl_ret 1) (princ "\n操作已取消"))
    (t (princ "\n未执行任何操作")))

  (princ))

;;; 获取块属性数据
(defun get_block_attributes (/ ss blk atts result)
  (if (setq ss (ssget "_X" '((0 . "INSERT"))))
    (progn
      (vlax-for blk (vla-get-ActiveSelectionSet
                     (vla-get-ActiveDocument (vlax-get-acad-object)))
        (if (> (vla-get-Count (vla-get-Attributes blk)) 0)
          (progn
            (vlax-for att (vla-get-Attributes blk)
              (setq result (cons (list (vla-get-TagString att)
                                       (vla-get-TextString att))
                                 result))))))
      (reverse result))
    (progn
      (alert "未找到任何包含属性的图块！")
      (exit))))

;;; 执行替换操作
(defun process_replace (attdata all_flag / ss blk att row_num)
  (setq row_num 0)
  (foreach att_row attdata
    (setq row_num (1+ row_num))
    (if (or all_flag (= (get_tile (strcat "chk_" (itoa row_num))) "1"))
      (progn
        (setq new_val (get_tile (strcat "new_" (itoa row_num))))
        (if (ssget "_X" '((0 . "INSERT")))
          (vlax-for blk (vla-get-ActiveSelectionSet
                         (vla-get-ActiveDocument (vlax-get-acad-object)))
            (vlax-for att (vla-get-Attributes blk)
              (if (eq (vla-get-TagString att) (car att_row))
                (vla-put-TextString att new_val))))))))
  (princ (strcat "\n成功更新 " (itoa row_num) " 个属性值！"))
  (princ))

;;; 错误处理
(defun *error* (msg)
  (if dcl_id (unload_dialog dcl_id))
  (if (findfile dcl_file) (vl-file-delete dcl_file))
  (princ (strcat "\n错误: " msg))
  (princ))

;;; 加载时初始化
(princ "\n材料替换插件已加载，输入 matreplace 启动。")
(princ)

MZ_li

AI 的代码没人会给你看的。除了我，因为我是来水经验的

qmqyqj

MZ_li 发表于 2025-5-6 09:16
AI 的代码没人会给你看的。除了我，因为我是来水经验的

俺也一样，我是来水经验的

shujh1989

MZ_li 发表于 2025-5-6 09:16
AI 的代码没人会给你看的。除了我，因为我是来水经验的

我觉得ai写得挺好的呀。我的插件都是ai写的，很复杂的功能都实现了。只是ai幻觉喜欢编造函数，改的时候有点头疼。马斯克的grok最好用，代码复制上去，要求说清楚，修改后的基本都能跑起来。楼主这个要求有点离谱，问题不说，文件也不上传，让人怎么看。

KO你

shujh1989 发表于 2025-5-7 15:08
我觉得ai写得挺好的呀。我的插件都是ai写的，很复杂的功能都实现了。只是ai幻觉喜欢编造函数，改的时候有 ...

其实就是赫思工具里的一个功能，平时如果改材料的话，因为所有标的材料都是一个属性块来的，里面有相同的值和不同的值的的情况下，找一个需要修改的，会识别出同名块，相同的标记值来修改。
举个例子，PT 是一个涂料编号   01 是序号   白色涂料是材料名称
  PT|01            PT|02
白色涂料    白色防水涂料
若设计变更需要改材料的序号01改成03，不可能整套图纸一个个挑出来改
这个功能就能识别出来相同的标记值的图块再去勾选需要修改替换的标记值

e719

俺也一样，我是来水经验的