不完美的修改标注颜色，界线，文字
我的本意是像输入E33后，弹出对话框可以选择修改标注对象的尺寸线、尺寸界线和文字颜色 可以选择是否修改和更改想要的颜色，没那个实力去写如果有那些大佬能修正加强，表示感谢！(defun C:E33 (/ ss i obj)
(vl-load-com)
(setvar "cmdecho" 1)
(setq ss (ssget '((0 . "dimension"))))
(if ss
(repeat (setq i (sslength ss))
(setq obj (vlax-ename->vla-object (ssname ss (setq i (1- i)))))
(vlax-put obj 'DimensionLineColor 1)
(vlax-put obj 'ExtensionLineColor 1)
(vlax-put obj 'TextColor 1)
)
)
(setvar "cmdecho" 0)
(princ)
)
试一下
1.对话框文件,保存成E33.dcl,放在"支持文件搜索路径"下面.
// E33.dcl - 对话框定义文件
E33_Dialog : dialog {
label = "修改标注颜色";
: column {
: row {
: text {
label = "尺寸线颜色:";
width = 25;
alignment = right;
}
: edit_box {
key = "dim_line_color";
edit_width = 10;
}
}
: row {
: text {
label = "尺寸界线颜色:";
width = 25;
alignment = right;
}
: edit_box {
key = "ext_line_color";
edit_width = 10;
}
}
: row {
: text {
label = "文字颜色:";
width = 25;
alignment = right;
}
: edit_box {
key = "text_color";
edit_width = 10;
}
}
}
ok_cancel;
}
2.E33.lsp
边界线颜色不显示在对话框,但可以正常设置,来个大手子分析一下怎么解决
(defun get-effective-color (vla-obj prop-name / raw-color layer-name layer-obj effective-color)
(setq effective-color "") ; 默认返回空字符串
(if (vlax-property-available-p vla-obj prop-name)
(progn
(setq raw-color (vlax-get-property vla-obj prop-name))
(cond
;; 如果颜色是 ByLayer (0) 或 ByBlock (256)
((or (= raw-color 0) (= raw-color 256))
(setq layer-name (vla-get-Layer vla-obj))
(setq layer-obj (vla-item (vla-get-Layers (vla-get-ActiveDocument (vlax-get-acad-object))) layer-name))
(setq effective-color (itoa (vla-get-Color layer-obj)))
)
;; 如果是其他指定的颜色
(t
(setq effective-color (itoa raw-color))
)
)
)
)
effective-color ; 返回最终的颜色字符串
)
(defun C:E33 (/ ss i ent vla-obj dcl_path dcl_id result
dim_color_str ext_color_str txt_color_str
dim_color ext_color txt_color
first_obj def_dim_clr def_ext_clr def_txt_clr)
(vl-load-com)
(setq dcl_path (findfile "E33.dcl"))
(if (not dcl_path)
(progn
(alert "错误: 找不到 E33.dcl 文件！")
(exit)
)
)
(prompt "\n选择要修改的标注对象: ")
(setq ss (ssget '((0 . "DIMENSION"))))
(if ss
(progn
(setq first_obj (vlax-ename->vla-object (ssname ss 0)))
;; 使用修正后的智能函数获取默认值
(setq def_dim_clr (get-effective-color first_obj "DimensionLineColor"))
(setq def_ext_clr (get-effective-color first_obj "ExtLine1Color"))
(setq def_txt_clr (get-effective-color first_obj "TextColor"))
(setq dcl_id (load_dialog dcl_path))
(if (not (new_dialog "E33_Dialog" dcl_id))
(progn (princ "\n错误: 无法初始化对话框。") (exit))
)
(set_tile "dim_line_color" def_dim_clr)
(set_tile "ext_line_color" def_ext_clr)
(set_tile "text_color" def_txt_clr)
(action_tile "accept"
"(progn
(setq dim_color_str (get_tile \"dim_line_color\"))
(setq ext_color_str (get_tile \"ext_line_color\"))
(setq txt_color_str (get_tile \"text_color\"))
(done_dialog 1)
)"
)
(action_tile "cancel" "(done_dialog 0)")
(setq result (start_dialog))
(unload_dialog dcl_id)
(if (= result 1)
(progn
(setq dim_color (if (and dim_color_str (/= dim_color_str "")) (atoi dim_color_str) nil))
(setq ext_color (if (and ext_color_str (/= ext_color_str "")) (atoi ext_color_str) nil))
(setq txt_color (if (and txt_color_str (/= txt_color_str "")) (atoi txt_color_str) nil))
(setq i 0)
(while (< i (sslength ss))
(setq ent (ssname ss i))
(setq vla-obj (vlax-ename->vla-object ent))
(if (and dim_color (vlax-property-available-p vla-obj "DimensionLineColor" T))
(vla-put-DimensionLineColor vla-obj dim_color)
)
(if (and ext_color (vlax-property-available-p vla-obj "ExtensionLineColor" T))
(vla-put-ExtensionLineColor vla-obj ext_color)
)
(if (and txt_color (vlax-property-available-p vla-obj "TextColor" T))
(vla-put-TextColor vla-obj txt_color)
)
(setq i (1+ i))
)
(princ (strcat "\n已成功处理 " (itoa (sslength ss)) " 个标注对象。"))
)
(princ "\n操作已取消。")
)
)
(princ "\n未选择任何标注对象。")
)
(princ)
)
(princ "\nE33 命令已加载。输入 E33 运行。")
(princ)
感谢分享。 (defun c:TT ( / ss i obj )
(or $tt$ (setq $tt$ 0))(setq $tt$ (acad_colordlg $tt$))
(if (setq ss (ssget '((0 . "dimension"))))
(repeat (setq i (sslength ss))
(setq obj (vlax-ename->vla-object (ssname ss (setq i (1- i)))))
(mapcar '(lambda (y) (vlax-put obj y $tt$))'(dimensionlinecolor extensionlinecolor textcolor))
)
)
(princ)
) maiko 发表于 2025-9-11 07:41
(defun c:TT ( / ss i obj )
(or $tt$ (setq $tt$ 0))(setq $tt$ (acad_colordlg $tt$))
(if (setq...
很丝滑， 但是没有选项比如这次只改标注文字颜色，其他不变呢
(vlax-put obj 'DimensionLineColor 1)改为 (vlax-put obj 'DimensionLineColor (acad_colordlg 1)) 后面两个以此类推 http://bbs.mjtd.com/thread-192924-1-1.html
ai写的 很丝滑:lol senry 发表于 2025-9-10 19:00
试一下
1.对话框文件,保存成E33.dcl,放在"支持文件搜索路径"下面.
啊，ai写的吗，很明显的错误啊
(setq def_ext_clr (get-effective-color first_obj "ExtensionLineColor"))
页:
[1]