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

可以的,学习了
页: [1] 2 3
查看完整版本: 图层颜色修改