属性块--材料替换

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 的代码没人会给你看的。除了我，因为我是来水经验的