求一个可以直接块里图元的图层程序

zxj168 · 发表于 2012-10-17 21:37:54

要求就是直接块里图元的图层
( 选中块程序让我选择我想要放到的图层颜色线型保持不变)
希望各位大师出手!

chpmould · 发表于 2012-10-17 22:44:22

我猜LZ是想将选择块的所有图元层修改到指定层吧...

zxj168 · 发表于 2012-10-17 23:34:50

是呀字打少了

xyp1964 · 发表于 2012-10-18 07:40:37

本帖最后由 xyp1964 于 2014-3-4 18:01 编辑

haitun518 · 发表于 2012-10-19 23:53:06

改换图层，含对块的处理

zxj168 · 发表于 2012-10-20 13:16:12

是不是这个程序很难怎么没人出手呢？

zxj168 · 发表于 2012-10-20 13:17:27

还是3币少了？

USER2128 · 发表于 2012-10-22 09:24:11

haitun518 发表于 2012-10-19 23:53
改换图层，含对块的处理

程序调试了一下，稍作了修改。
应用时请将俩文件放置于CAD可搜索的路径中。

;;; changelayer.lsp
(defun getdata_ly()
(setq n1 (get_tile "oldly_list"))
(setq n2 (get_tile "newly_list"))
(setq oldlayer (nth (atoi n1) layername))
(setq newlayer (nth (atoi n2) layername))
)
(defun getdata_set()
(setq flag_cl (get_tile "change_cl"))
(setq flag_lt (get_tile "change_lt"))
(setq flag_lw (get_tile "change_lw"))
(setq flag_ly (get_tile "clean_ly"))
)
(defun setdata_set()
(set_tile "change_cl" flag_cl)
(set_tile "change_lt" flag_lt)
(set_tile "change_lw" flag_lw)
(set_tile "clean_ly" flag_ly)
)
(defun dialog_ly()
(setq flag_cl "1"
flag_lt "1"
flag_lw "1"
flag_ly "1")
; (setq path (findfile "acad.exe"))
; (setq path (substr path 1 (- (strlen path) 8)))
; (setq path (strcat path "LISP\\changelayer"))
(setq path (findfile "changelayer.dcl"))
(setq id (load_dialog path)) ;装入对话框文件
(if (< id 0) (exit))
(if (not (new_dialog "changelayer" id))(exit)) ;初始化对话框
(start_list "oldly_list") ;开始处理图层列表
(mapcar 'add_list layername)
(end_list) ;图层列表处理完毕
(start_list "newly_list") ;开始处理图层列表
(mapcar 'add_list layername)
(end_list) ;图层列表处理完毕
(action_tile "oldly_list" "(set_tile "linetype1" (viewlt $value))(set_tile "linewidth1" (viewlw $value))")
(action_tile "newly_list" "(set_tile "linetype2" (viewlt $value))(set_tile "linewidth2" (viewlw $value))")
(action_tile "set_ly" "(dialog_set)")
(action_tile "accept" "(getdata_ly)(done_dialog 1)")
(action_tile "cancel" "(done_dialog 0)")
(setq std (start_dialog))
(unload_dialog id)
)
(defun viewlt(num / lst lt ltn)
(setq lst (entget (tblobjname "LAYER" (nth (atoi num) layername))))
(setq lt (cdr (assoc 6 lst)))
(setq ltn (strcat "线型:" lt))
)
(defun viewlw(num / lst lw lwn)
(setq lst (entget (tblobjname "LAYER" (nth (atoi num) layername))))
(setq lw (cdr (assoc 370 lst)))
(if (= lw -3)
(setq lw "默认")
(setq lw (strcat (rtos (/ lw 100.0) 2 2) "mm"))
)
(setq lwn (strcat "线宽:" lw))
)
(defun dialog_set()
(if (not (new_dialog "setfunction" id))(exit))
(setdata_set)
(action_tile "accept" "(getdata_set)(done_dialog 1)")
(action_tile "cancel" "(done_dialog 0)")
(start_dialog)
)
(defun change_clltlw(obj_lst)
(if (and (= flag_cl "1") (setq old_cl (assoc 62 obj_lst))) ;强制对象颜色ByLayer
(progn
(setq new_cl (cons '62 256))
(setq obj_lst (subst new_cl old_cl obj_lst))
(entmod obj_lst)
)
)
(if (and (= flag_lt "1") (setq old_lt (assoc 6 obj_lst))) ;强制对象线型ByLayer
(progn
(setq new_lt (cons '6 "ByLayer"))
(setq obj_lst (subst new_lt old_lt obj_lst))
(entmod obj_lst)
)
)
(if (and (= flag_lw "1") (setq old_lw (assoc 370 obj_lst))) ;强制对象线宽ByLayer
(progn
(setq new_lw (cons '370 -1))
(setq obj_lst (subst new_lw old_lw obj_lst))
(entmod obj_lst)
)
)
)
;;;===============================================
;;;院长的程序（已去除其中的伪代码），留作之后的程序扩展用。
;; xyp-SS2LayerList 选择集图层表 (xyp-SS2LayerList (ssget))
(defun xyp-SS2LayerList (ss / i lst s1 la)
(setq i -1
lst '())
(while (setq s1 (ssname ss (setq i (1+ i))))
(setq la (cdr (assoc 8 (entget s1))))
(if (not (member la lst))
(setq lst (cons la lst))
)
)
(vl-sort lst '<)
)
;;;===============================================
(defun change_ly()
(setq num 0)
(setq new_ly (cons '8 newlayer)) ;构造新图层子表
(setq old_ly (cons '8 oldlayer)) ;构造旧图层子表
;;; 选择要改变图层的图元(包括图块，但不包括块中块)
(setq old_ent (ssget "X" (list old_ly)))
(if old_ent (setq len (sslength old_ent)) (setq len 0))
(setq i 0)
(while (< i len)
(setq ent (ssname old_ent i)) ;得到第一个图元名
(setq elt (entget ent)) ;得到一个图元表
(setq elt (subst new_ly old_ly elt)) ;图层替换
(entmod elt) ;回送图元表
(change_clltlw elt)
(setq num (1+ num))
(setq i (1+ i))
)
;;; 改变一般图块中的图元(包括块中块)
(setq blk_lst (tblnext "block" t))
(while blk_lst
(setq nam_blk (cdr (assoc 2 blk_lst)))
(if (= (substr nam_blk 1 1) "*")
(progn
(setq unb_ent (ssget "X" '((0 . "insert"))))
(if unb_ent (setq len (sslength unb_ent)) (setq len 0))
(setq i 0)
(while (< i len)
(setq unb_et (ssname unb_ent i))
(setq unb_lt (entget unb_et))
(if (= nam_blk (cdr (assoc 2 unb_lt)))
(progn
(command "explode" unb_et)
(command "purge" "b" nam_blk "y" "y")
)
)
(setq i (1+ i))
)
)
)
(setq blk_ent (cdr (assoc -2 blk_lst))) ;得到块表所含图元入口
(while blk_ent
(setq lst (entget blk_ent)) ;得到图块中子图元的图元表
(if (= oldlayer (cdr (assoc 8 lst))) ;判断该图元是否为要改变的图层
(progn
(setq lst (subst new_ly old_ly lst)) ;图层替换
(entmod lst) ;回送图元表
)
)
(change_clltlw lst)
(setq blk_ent (entnext blk_ent))
)
(setq blk_lst (tblnext "block"))
)
;;; 改变属性图块中的图元
(setq int_ent (ssget "X" (list (cons '0 "INSERT"))))
(if int_ent (setq len (sslength int_ent)) (setq len 0))
(setq i 0)
(while (< i len)
(setq int_et (ssname int_ent i))
(setq int_et (entnext int_et))
(if int_et
(progn
(setq int_lt (entget int_et))
(if (= (cdr (assoc 0 int_lt)) "ATTRIB")
(while (/= (cdr (assoc 0 int_lt)) "SEQEND")
(if (= oldlayer (cdr (assoc 8 int_lt)))
(progn
(setq int_lt (subst new_ly old_ly int_lt))
(entmod int_lt)
)
)
(change_clltlw int_lt)
(setq int_et (entnext int_et))
(setq int_lt (entget int_et))
)
)
)
)
(setq i (+ i 1))
)
(princ "\n完成转换 ")
(princ num)
(princ " 个对象\n")
(if (= flag_ly "1") (command "purge" "la" oldlayer "n"))
(command "regenall") ;重新生成
)
(defun C:changelayer()
(setvar "cmdecho" 0) ;关闭命令函数运行时回显提示和输入
(setq layername '())
(setq lay_lst (tblnext "layer" t))
(while lay_lst
(setq layername (cons (cdr (assoc 2 lay_lst)) layername))
(setq lay_lst (tblnext "layer"))
)
(setq layername (acad_strlsort layername)) ;对图层名排序
(dialog_ly)
(if (and (/= newlayer oldlayer) (= std 1))
(progn
(princ (strcat "\n图层自: " oldlayer "\t转换到: " newlayer))
(change_ly)
)
)
(princ)
)

;;; changelayer.lsp 
(defun getdata_ly() 
  (setq n1 (get_tile "oldly_list")) 
  (setq n2 (get_tile "newly_list")) 
  (setq oldlayer (nth (atoi n1) layername)) 
  (setq newlayer (nth (atoi n2) layername)) 
  ) 
 
(defun getdata_set() 
  (setq flag_cl (get_tile "change_cl")) 
  (setq flag_lt (get_tile "change_lt")) 
  (setq flag_lw (get_tile "change_lw")) 
  (setq flag_ly (get_tile "clean_ly")) 
  ) 
 
(defun setdata_set() 
  (set_tile "change_cl" flag_cl) 
  (set_tile "change_lt" flag_lt) 
  (set_tile "change_lw" flag_lw) 
  (set_tile "clean_ly"  flag_ly) 
  ) 
 
(defun dialog_ly() 
  (setq flag_cl "1" 
        flag_lt "1" 
        flag_lw "1" 
        flag_ly "1") 
;  (setq path (findfile "acad.exe")) 
;  (setq path (substr path 1 (- (strlen path) 8))) 
;  (setq path (strcat path "LISP\\changelayer")) 
  (setq path (findfile "changelayer.dcl")) 
  (setq id (load_dialog path))                               ;装入对话框文件 
  (if (< id 0) (exit)) 
  (if (not (new_dialog "changelayer" id))(exit))             ;初始化对话框 
  (start_list "oldly_list")                                  ;开始处理图层列表 
  (mapcar 'add_list layername) 
  (end_list)                                                 ;图层列表处理完毕 
  (start_list "newly_list")                                  ;开始处理图层列表 
  (mapcar 'add_list layername) 
  (end_list)                                                 ;图层列表处理完毕 
  (action_tile "oldly_list" "(set_tile "linetype1" (viewlt $value))(set_tile "linewidth1" (viewlw $value))") 
  (action_tile "newly_list" "(set_tile "linetype2" (viewlt $value))(set_tile "linewidth2" (viewlw $value))") 
  (action_tile "set_ly" "(dialog_set)") 
  (action_tile "accept" "(getdata_ly)(done_dialog 1)") 
  (action_tile "cancel" "(done_dialog 0)") 
  (setq std (start_dialog)) 
  (unload_dialog id) 
  ) 
 
(defun viewlt(num / lst lt ltn) 
  (setq lst (entget (tblobjname "LAYER" (nth (atoi num) layername)))) 
  (setq lt (cdr (assoc 6 lst))) 
  (setq ltn (strcat "线型:" lt)) 
  ) 
 
(defun viewlw(num / lst lw lwn) 
  (setq lst (entget (tblobjname "LAYER" (nth (atoi num) layername)))) 
  (setq lw (cdr (assoc 370 lst))) 
  (if (= lw -3) 
    (setq lw "默认") 
    (setq lw (strcat (rtos (/ lw 100.0) 2 2) "mm")) 
    ) 
  (setq lwn (strcat "线宽:" lw)) 
  ) 
 
(defun dialog_set() 
  (if (not (new_dialog "setfunction" id))(exit)) 
  (setdata_set) 
  (action_tile "accept" "(getdata_set)(done_dialog 1)") 
  (action_tile "cancel" "(done_dialog 0)") 
  (start_dialog) 
  ) 
 
(defun change_clltlw(obj_lst) 
  (if (and (= flag_cl "1") (setq old_cl (assoc 62 obj_lst)))  ;强制对象颜色ByLayer 
    (progn 
      (setq new_cl (cons '62 256)) 
      (setq obj_lst (subst new_cl old_cl obj_lst)) 
      (entmod obj_lst) 
      ) 
    ) 
  (if (and (= flag_lt "1") (setq old_lt (assoc 6 obj_lst)))   ;强制对象线型ByLayer 
    (progn 
      (setq new_lt (cons '6 "ByLayer")) 
      (setq obj_lst (subst new_lt old_lt obj_lst)) 
      (entmod obj_lst) 
      ) 
    ) 
  (if (and (= flag_lw "1") (setq old_lw (assoc 370 obj_lst))) ;强制对象线宽ByLayer 
    (progn 
      (setq new_lw (cons '370 -1)) 
      (setq obj_lst (subst new_lw old_lw obj_lst)) 
      (entmod obj_lst) 
      ) 
    ) 
  ) 
;;;=============================================== 
;;;院长的程序（已去除其中的伪代码），留作之后的程序扩展用。 
;; xyp-SS2LayerList 选择集图层表 (xyp-SS2LayerList (ssget)) 
(defun xyp-SS2LayerList (ss / i lst s1 la) 
  (setq i   -1 
        lst '()) 
  (while (setq s1 (ssname ss (setq i (1+ i)))) 
    (setq la (cdr (assoc 8 (entget s1)))) 
    (if (not (member la lst)) 
      (setq lst (cons la lst)) 
      ) 
    ) 
  (vl-sort lst '<) 
  ) 
;;;=============================================== 
(defun change_ly() 
  (setq num 0) 
  (setq new_ly (cons '8 newlayer))                             ;构造新图层子表 
  (setq old_ly (cons '8 oldlayer))                             ;构造旧图层子表 
   
;;; 选择要改变图层的图元(包括图块，但不包括块中块) 
  (setq old_ent (ssget "X" (list old_ly))) 
  (if old_ent (setq len (sslength old_ent)) (setq len 0)) 
  (setq i 0) 
  (while (
    (setq ent (ssname old_ent i))                             ;得到第一个图元名 
    (setq elt (entget ent))                                     ;得到一个图元表 
    (setq elt (subst new_ly old_ly elt))                     ;图层替换 
    (entmod elt)                                             ;回送图元表 
    (change_clltlw elt) 
    (setq num (1+ num)) 
    (setq i (1+ i)) 
    ) 
   
;;; 改变一般图块中的图元(包括块中块) 
  (setq blk_lst (tblnext "block" t)) 
  (while blk_lst 
    (setq nam_blk (cdr (assoc 2 blk_lst))) 
    (if (= (substr nam_blk 1 1) "*") 
      (progn 
        (setq unb_ent (ssget "X" '((0 . "insert")))) 
        (if unb_ent (setq len (sslength unb_ent)) (setq len 0)) 
        (setq i 0) 
        (while (
          (setq unb_et (ssname unb_ent i)) 
          (setq unb_lt (entget unb_et)) 
          (if (= nam_blk (cdr (assoc 2 unb_lt))) 
            (progn 
              (command "explode" unb_et) 
              (command "purge" "b" nam_blk "y" "y") 
              ) 
            ) 
          (setq i (1+ i)) 
          ) 
        ) 
      ) 
    (setq blk_ent (cdr (assoc -2 blk_lst)))                  ;得到块表所含图元入口 
    (while blk_ent 
      (setq lst (entget blk_ent))                            ;得到图块中子图元的图元表 
      (if (= oldlayer (cdr (assoc 8 lst)))                   ;判断该图元是否为要改变的图层 
        (progn 
          (setq lst (subst new_ly old_ly lst))               ;图层替换 
          (entmod lst)                                       ;回送图元表 
          ) 
        ) 
      (change_clltlw lst) 
      (setq blk_ent (entnext blk_ent)) 
      ) 
    (setq blk_lst (tblnext "block")) 
    ) 
;;; 改变属性图块中的图元 
  (setq int_ent (ssget "X" (list (cons '0 "INSERT")))) 
  (if int_ent (setq len (sslength int_ent)) (setq len 0)) 
  (setq i 0) 
  (while (
    (setq int_et (ssname int_ent i)) 
    (setq int_et (entnext int_et)) 
    (if int_et 
      (progn 
        (setq int_lt (entget int_et)) 
        (if (= (cdr (assoc 0 int_lt)) "ATTRIB") 
          (while (/= (cdr (assoc 0 int_lt)) "SEQEND") 
            (if (= oldlayer (cdr (assoc 8 int_lt))) 
              (progn 
                (setq int_lt (subst new_ly old_ly int_lt)) 
                (entmod int_lt) 
                ) 
              ) 
            (change_clltlw int_lt) 
            (setq int_et (entnext int_et)) 
            (setq int_lt (entget int_et)) 
            ) 
          ) 
        ) 
      ) 
    (setq i (+ i 1)) 
    ) 
   
  (princ "\n完成转换 ") 
  (princ num) 
  (princ " 个对象\n") 
  (if (= flag_ly "1") (command "purge" "la" oldlayer "n")) 
  (command "regenall")                                       ;重新生成 
  ) 
 
(defun C:changelayer() 
  (setvar "cmdecho" 0)                                        ;关闭命令函数运行时回显提示和输入 
  (setq layername '()) 
  (setq lay_lst (tblnext "layer" t)) 
  (while lay_lst 
    (setq layername (cons (cdr (assoc 2 lay_lst)) layername)) 
    (setq lay_lst (tblnext "layer")) 
    ) 
  (setq layername (acad_strlsort layername))                  ;对图层名排序 
  (dialog_ly) 
  (if (and (/= newlayer oldlayer) (= std 1)) 
    (progn 
      (princ (strcat "\n图层自: " oldlayer "\t转换到: " newlayer)) 
      (change_ly) 
      ) 
    ) 
  (princ) 
  )

存为文件名: changelayer.dcl

//定义转换图层的对话框
changelayer:dialog{
label= "图层转换";
:row{
:list_box
{label="转换自";
key="oldly_list";
width=20;
height=12;
}
:list_box
{label="转换到";
key="newly_list";
width=20;
height=12;
}
}
:row{
:text{key="linetype1";width=20;value="线型:";}
:text{key="linetype2";width=20;value="线型:";}
}
:row{
:text{key="linewidth1";width=20;value="线宽:";}
:text{key="linewidth2";width=20;value="线宽:";}
}
:row{
:button{alignment=centered;fixed_width=true;width=10;label="设置...";key="set_ly";}
ok_cancel;
}
}
//定义设置的对话框
setfunction:dialog{
label= "设置";
:column{
:toggle{label="强制对象颜色为ByLayer";key="change_cl";}
:toggle{label="强制对象线型为ByLayer";key="change_lt";}
:toggle{label="强制对象线宽为ByLayer";key="change_lw";}
:toggle{label="清理多余的图层";key="clean_ly";}
:text{label="";}
}
ok_cancel;
}

//定义转换图层的对话框 
changelayer:dialog{ 
  label= "图层转换"; 
  :row{ 
      :list_box 
           {label="转换自"; 
           key="oldly_list"; 
           width=20; 
           height=12; 
           } 
      :list_box 
           {label="转换到"; 
           key="newly_list"; 
           width=20; 
           height=12; 
           } 
      } 
  :row{ 
      :text{key="linetype1";width=20;value="线型:";} 
      :text{key="linetype2";width=20;value="线型:";} 
      } 
  :row{ 
      :text{key="linewidth1";width=20;value="线宽:";} 
      :text{key="linewidth2";width=20;value="线宽:";} 
      } 
  :row{ 
      :button{alignment=centered;fixed_width=true;width=10;label="设置...";key="set_ly";} 
      ok_cancel; 
      } 
} 
 
//定义设置的对话框 
setfunction:dialog{ 
  label= "设置"; 
  :column{ 
         :toggle{label="强制对象颜色为ByLayer";key="change_cl";} 
         :toggle{label="强制对象线型为ByLayer";key="change_lt";} 
         :toggle{label="强制对象线宽为ByLayer";key="change_lw";} 
         :toggle{label="清理多余的图层";key="clean_ly";} 
         :text{label="";} 
         } 
  ok_cancel; 
}

alin · 发表于 2012-10-23 10:17:37

用到dosLib，请先加载 http://download.rhino3d.com/download.asp?id=doslib

[url=http://download.rhino3d.com/download.asp?id=doslib][/url]

zhangzl · 发表于 2012-12-31 09:49:49

好思路啊，不过具体怎么用，还要仔细考虑下，会改变好多习惯的，是恶习改掉还是成为变态

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

求一个可以直接块里图元的图层程序

点评

相关帖子

本帖子中包含更多资源

点评

本帖子中包含更多资源

点评

点评

本帖子中包含更多资源

浏览过的版块