图层颜色修改

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

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

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

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

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

wudechao · 发表于 2019-5-25 12:39

本帖最后由 wudechao 于 2019-5-25 13:11 编辑

(defun c:vc (/ ss index lay ent ffg colour)
  (setvar "cmdecho" 0)
  (setq ffg (getvar "TILEMODE"))
  (if (= ffg 0)
(progn
   (command "_.MSPACE")
   (prompt "\n请选择改变颜色物体所在的图层<退出>:")
   (setq ss (ssget))
   (if (/= ss nil)
(progn
   (setq index 0)
   (setq colour (getint "请输入要变成的颜色号<1-255>比如：/1-红/2-黄/3-绿/4-青/5-蓝/6-粉/7-白/ <7>:"))
   (if (= colour nil)
      (setq colour 7)
   ) ;_ 结束if
   (repeat (sslength ss)
      (setq ent (ssname ss index))
      (setq lay (cdr (assoc 8 (entget ent))))
      (command "_.vplayer" "C" colour lay "" "")
      (setq index (+ index 1))
   );_ 结束repeat
);_ 结束progn
(progn
   (princ "\n未选到物体。")
);_ 结束progn
   );_ 结束if
);_ 结束progn
(progn
   (princ "\n请转到图纸空间再使用本命令。")
);_ 结束progn
  );_ 结束if
  (command "_.PSPACE")
  (setvar "cmdecho" 1)
  (princ)
)

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

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

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

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

请求：能发来全码吗

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

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

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

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

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

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

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

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

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

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

可以的，学习了

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

[提问] 图层颜色修改

本帖子中包含更多资源