图层颜色修改
本帖最后由 KO你 于 2019-2-13 17:13 编辑图层原有颜色与当前视口图层替代颜色修改 bylayer(VR)
求高手们编程对话框模式的源码提供学习
wudechao 发表于 2019-5-25 12:39
(defun c:vc (/ ss index lay ent ffg colour)
(setvar "cmdecho" 0)
(setq ffg (getvar "TILEMODE") ...
请教一下,如果图层替代颜色修改后,怎样才能改回来原有的随层颜色呢 lingduwx 发表于 2019-2-15 11:29
再加上修改图层名就更好了
快捷键de图层重命名
(defun c:de (/ *error*name name1 dclname tempname filen stream dcl_re dlg new)
(defun *error* ( msg )
(if (wcmatch (strcase msg t) "*break,*cancel*,*exit*")
(progn
(unload_dialog dcl_re)
(vl-file-delete dclname)
(princ "\nError:图层0不可更改!" )
)
)
)
(setvar "cmdecho" 0)
(setq key
(progn
(initget "D" )
(entsel "\n选择需改图层名的对象[改当前图层名(D)]:")
)
)
(cond
((= key "D")
(setq name (getvar "CLAYER")) ;获取当前图层
)
((= (type key) 'LIST)
(setq name (cdr (assoc 8 (entget (car key)))))
)
(t nil) ;什么也不做
)
(setq dclname
(cond
(
(setq tempname (vl-filename-mktemp "re-dcl-tmp.dcl") filen (open tempname "w"))
(foreach stream '(
"\n"
"RENAME:dialog {\n"
" label = \"图层重命名\" ;\n"
" :row {\n"
" :edit_box {\n"
" key = \"dcl_edit_name\" ;\n"
" width = 30 ;\n"
" }\n"
" }\n"
" :row {\n"
" :button {\n"
" key = \"btn_ok\" ;\n"
" label = \"确认\" ;\n"
" }\n"
" :button {\n"
" is_cancel = true ;\n"
" key = \"btn_cancle\" ;\n"
" label = \"取消\" ;\n"
" }\n"
" }\n"
"}\n"
)
(princ stream filen)
)
(close filen)
tempname
)
)
)
(setq dcl_re (load_dialog dclname))
(if (not (new_dialog "RENAME" dcl_re)) (exit))
(set_tile "dcl_edit_name" name)
(mode_tile "dcl_edit_name" 2)
(action_tile "dcl_edit_name" "(setq name1 $value)")
(action_tile "btn_ok"
"(if (= name \"0\")
(progn
(alert (strcat \"图层: \" name \" 不可更改!\"))
(exit)
)
)
(if (tblsearch \"layer\" name1)
(alert (strcat \"图层: \" name1 \" 已经存在.\"))
(if (not (snvalid name1))
(alert (strcat \"错误的图层名: \" name1))
(done_dialog 1)
)
)"
)
(setq dlg (start_dialog))
(cond
((= dlg 1)
(command "_.rename" "_layer" name name1)
(princ (strcat "\n图层 \"" name "\" 重命名为 \"" name1 "\""))
)
(t nil
)
)
(unload_dialog dcl_re)
(vl-file-delete dclname)
(prin1)
) ;; vpco 设置视口图层颜色 (vpco co颜色号 la图层名称)
;; (vpco 3 "0")
(defun vpco (co la) (command "vplayer" "c" co la "A" ""))
xyp1964 发表于 2019-2-13 13:32
请求:能发来全码吗 xyp1964 发表于 2019-2-13 13:32
VPlayer命令在2010以上版本才有 颜色c 这个选项 再加上修改图层名就更好了 “”图层重命名“”应该保留原来的图层只改修改的对象的图层吧 本帖最后由 1291500406 于 2019-4-14 22:38 编辑
(defun c:bb ()(setq yanse (acad_colordlg 1))(gtcys yanse)(princ))(defun gtcys (yanse / acaddoc acadobj en i lay layobj obj ss vlay vlay1)
(setq AcadObj (vlax-get-Acad-object)AcadDoc (vla-get-ActiveDocument AcadObj) LayObj (vla-get-layers AcadDoc))
(if (setq ss (ssget))(progn(setq i 0)(repeat (sslength ss)(setq en (ssname ss i) obj (vlax-ename->vla-object en) lay (vla-get-layer obj)vlay (vla-item LayObj lay))
(if (= (equal vlay vlay1) nil)(progn(vla-put-color vlay yanse)(setq vlay1 vlay)))(setq i (1+ i)))))(princ))
1291500406 发表于 2019-4-14 22:34
(defun c:bb ()(setq yanse (acad_colordlg 1))(gtcys yanse)(princ))(defun gtcys (yanse / acaddoc acado ...
快捷键cd改图层颜色
(defun c:cd()
(setvar "cmdecho" 0)
(setq lay(cdr (assoc 8 (entget (car (entsel "\n 请选取要修改颜色的图层对象:"))))))
;(setq ss (ssget))
;(if ss (progn
(setq colour (getstring "\n请输入颜色号<1-255>:"))
(command "-layer" "c" colour lay ""))
(setvar "cmdecho" 1)
(princ)
必强大师你的程序是修改图层颜色和我上面的差不多,这里说到的是替代图层的颜色修改,原有图层颜色不变,只是如何添加替代图层颜色 可以的,学习了