图层颜色修改

KO你 · 发表于 2019-2-13 13:06:17

本帖最后由 KO你于 2019-2-13 17:13 编辑

图层原有颜色与当前视口图层替代颜色修改 bylayer（VR）
求高手们编程对话框模式的源码提供学习

KO你 · 发表于 2019-5-25 16:17:54

wudechao 发表于 2019-5-25 12:39
(defun c:vc (/ ss index lay ent ffg colour)
(setvar "cmdecho" 0)
(setq ffg (getvar "TILEMODE") ...

请教一下，如果图层替代颜色修改后，怎样才能改回来原有的随层颜色呢

KO你 · 发表于 2019-2-16 16:13:38

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)
)

xyp1964 · 发表于 2019-2-13 13:32:34

;; vpco 设置视口图层颜色 (vpco co颜色号 la图层名称)
;; (vpco 3 "0")
(defun vpco (co la) (command "vplayer" "c" co la "A" ""))

KO你 · 发表于 2019-2-13 13:46:03

xyp1964 发表于 2019-2-13 13:32

请求：能发来全码吗

luqzcm · 发表于 2019-2-15 10:45:04

xyp1964 发表于 2019-2-13 13:32

VPlayer命令在2010以上版本才有颜色c 这个选项

lingduwx · 发表于 2019-2-15 11:29:41

再加上修改图层名就更好了

bai2000 · 发表于 2019-2-18 14:42:25

“”图层重命名“”应该保留原来的图层只改修改的对象的图层吧

1291500406 · 发表于 2019-4-14 22:34:37

本帖最后由 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))

KO你 · 发表于 2019-4-15 00:37:50

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)

必强大师你的程序是修改图层颜色和我上面的差不多，这里说到的是替代图层的颜色修改，原有图层颜色不变，只是如何添加替代图层颜色

纵横八方 · 发表于 2019-4-15 09:31:45

可以的，学习了

账号		自动登录	找回密码
密码			注册

[提问] 图层颜色修改

本帖子中包含更多资源