明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 2623|回复: 12

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

  [复制链接]
发表于 2012-10-17 21:37 | 显示全部楼层 |阅读模式
要求 就是直接块里图元的图层
( 选中块 程序让我选择我想要放到的图层 颜色 线型保持不变)
希望各位大师出手!

点评

我猜是英语老师教的!  发表于 2012-10-17 21:54
我猜楼主的语文是数学老师教的  发表于 2012-10-17 21:45
发表于 2012-10-17 22:44 | 显示全部楼层
我猜LZ是想将选择块的所有图元层修改到指定层吧...
 楼主| 发表于 2012-10-17 23:34 | 显示全部楼层
是呀 字打少了
发表于 2012-10-18 07:40 | 显示全部楼层
本帖最后由 xyp1964 于 2014-3-4 18:01 编辑




本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x

点评

有点贵  发表于 2012-10-23 14:30
TT ; 错误: no function definition: CMDLA0 错误了 不知道怎么回事 我的是09版的cad  发表于 2012-10-18 22:10
发表于 2012-10-19 23:53 | 显示全部楼层
改换图层,含对块的处理

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x

点评

命令: changelayer; 错误: quit / exit abort 有错误 请修正一下  发表于 2012-10-20 19:53
 楼主| 发表于 2012-10-20 13:16 来自手机 | 显示全部楼层
是不是这个程序很难 怎么没人出手呢?
 楼主| 发表于 2012-10-20 13:17 来自手机 | 显示全部楼层
还是3币少了?
发表于 2012-10-22 09:24 | 显示全部楼层
haitun518 发表于 2012-10-19 23:53
改换图层,含对块的处理

程序调试了一下,稍作了修改。
应用时请将俩文件放置于CAD可搜索的路径中。
  1. ;;; changelayer.lsp
  2. (defun getdata_ly()
  3.   (setq n1 (get_tile "oldly_list"))
  4.   (setq n2 (get_tile "newly_list"))
  5.   (setq oldlayer (nth (atoi n1) layername))
  6.   (setq newlayer (nth (atoi n2) layername))
  7.   )

  8. (defun getdata_set()
  9.   (setq flag_cl (get_tile "change_cl"))
  10.   (setq flag_lt (get_tile "change_lt"))
  11.   (setq flag_lw (get_tile "change_lw"))
  12.   (setq flag_ly (get_tile "clean_ly"))
  13.   )

  14. (defun setdata_set()
  15.   (set_tile "change_cl" flag_cl)
  16.   (set_tile "change_lt" flag_lt)
  17.   (set_tile "change_lw" flag_lw)
  18.   (set_tile "clean_ly"  flag_ly)
  19.   )

  20. (defun dialog_ly()
  21.   (setq flag_cl "1"
  22.         flag_lt "1"
  23.         flag_lw "1"
  24.         flag_ly "1")
  25. ;  (setq path (findfile "acad.exe"))
  26. ;  (setq path (substr path 1 (- (strlen path) 8)))
  27. ;  (setq path (strcat path "LISP\\changelayer"))
  28.   (setq path (findfile "changelayer.dcl"))
  29.   (setq id (load_dialog path))                               ;装入对话框文件
  30.   (if (< id 0) (exit))
  31.   (if (not (new_dialog "changelayer" id))(exit))             ;初始化对话框
  32.   (start_list "oldly_list")                                  ;开始处理图层列表
  33.   (mapcar 'add_list layername)
  34.   (end_list)                                                 ;图层列表处理完毕
  35.   (start_list "newly_list")                                  ;开始处理图层列表
  36.   (mapcar 'add_list layername)
  37.   (end_list)                                                 ;图层列表处理完毕
  38.   (action_tile "oldly_list" "(set_tile "linetype1" (viewlt $value))(set_tile "linewidth1" (viewlw $value))")
  39.   (action_tile "newly_list" "(set_tile "linetype2" (viewlt $value))(set_tile "linewidth2" (viewlw $value))")
  40.   (action_tile "set_ly" "(dialog_set)")
  41.   (action_tile "accept" "(getdata_ly)(done_dialog 1)")
  42.   (action_tile "cancel" "(done_dialog 0)")
  43.   (setq std (start_dialog))
  44.   (unload_dialog id)
  45.   )

  46. (defun viewlt(num / lst lt ltn)
  47.   (setq lst (entget (tblobjname "LAYER" (nth (atoi num) layername))))
  48.   (setq lt (cdr (assoc 6 lst)))
  49.   (setq ltn (strcat "线型:" lt))
  50.   )

  51. (defun viewlw(num / lst lw lwn)
  52.   (setq lst (entget (tblobjname "LAYER" (nth (atoi num) layername))))
  53.   (setq lw (cdr (assoc 370 lst)))
  54.   (if (= lw -3)
  55.     (setq lw "默认")
  56.     (setq lw (strcat (rtos (/ lw 100.0) 2 2) "mm"))
  57.     )
  58.   (setq lwn (strcat "线宽:" lw))
  59.   )

  60. (defun dialog_set()
  61.   (if (not (new_dialog "setfunction" id))(exit))
  62.   (setdata_set)
  63.   (action_tile "accept" "(getdata_set)(done_dialog 1)")
  64.   (action_tile "cancel" "(done_dialog 0)")
  65.   (start_dialog)
  66.   )

  67. (defun change_clltlw(obj_lst)
  68.   (if (and (= flag_cl "1") (setq old_cl (assoc 62 obj_lst)))  ;强制对象颜色ByLayer
  69.     (progn
  70.       (setq new_cl (cons '62 256))
  71.       (setq obj_lst (subst new_cl old_cl obj_lst))
  72.       (entmod obj_lst)
  73.       )
  74.     )
  75.   (if (and (= flag_lt "1") (setq old_lt (assoc 6 obj_lst)))   ;强制对象线型ByLayer
  76.     (progn
  77.       (setq new_lt (cons '6 "ByLayer"))
  78.       (setq obj_lst (subst new_lt old_lt obj_lst))
  79.       (entmod obj_lst)
  80.       )
  81.     )
  82.   (if (and (= flag_lw "1") (setq old_lw (assoc 370 obj_lst))) ;强制对象线宽ByLayer
  83.     (progn
  84.       (setq new_lw (cons '370 -1))
  85.       (setq obj_lst (subst new_lw old_lw obj_lst))
  86.       (entmod obj_lst)
  87.       )
  88.     )
  89.   )
  90. ;;;===============================================
  91. ;;;院长的程序(已去除其中的伪代码),留作之后的程序扩展用。
  92. ;; xyp-SS2LayerList 选择集图层表 (xyp-SS2LayerList (ssget))
  93. (defun xyp-SS2LayerList (ss / i lst s1 la)
  94.   (setq i   -1
  95.         lst '())
  96.   (while (setq s1 (ssname ss (setq i (1+ i))))
  97.     (setq la (cdr (assoc 8 (entget s1))))
  98.     (if (not (member la lst))
  99.       (setq lst (cons la lst))
  100.       )
  101.     )
  102.   (vl-sort lst '<)
  103.   )
  104. ;;;===============================================
  105. (defun change_ly()
  106.   (setq num 0)
  107.   (setq new_ly (cons '8 newlayer))                             ;构造新图层子表
  108.   (setq old_ly (cons '8 oldlayer))                             ;构造旧图层子表
  109.   
  110. ;;; 选择要改变图层的图元(包括图块,但不包括块中块)
  111.   (setq old_ent (ssget "X" (list old_ly)))
  112.   (if old_ent (setq len (sslength old_ent)) (setq len 0))
  113.   (setq i 0)
  114.   (while (< i len)
  115.     (setq ent (ssname old_ent i))                             ;得到第一个图元名
  116.     (setq elt (entget ent))                                     ;得到一个图元表
  117.     (setq elt (subst new_ly old_ly elt))                     ;图层替换
  118.     (entmod elt)                                             ;回送图元表
  119.     (change_clltlw elt)
  120.     (setq num (1+ num))
  121.     (setq i (1+ i))
  122.     )
  123.   
  124. ;;; 改变一般图块中的图元(包括块中块)
  125.   (setq blk_lst (tblnext "block" t))
  126.   (while blk_lst
  127.     (setq nam_blk (cdr (assoc 2 blk_lst)))
  128.     (if (= (substr nam_blk 1 1) "*")
  129.       (progn
  130.         (setq unb_ent (ssget "X" '((0 . "insert"))))
  131.         (if unb_ent (setq len (sslength unb_ent)) (setq len 0))
  132.         (setq i 0)
  133.         (while (< i len)
  134.           (setq unb_et (ssname unb_ent i))
  135.           (setq unb_lt (entget unb_et))
  136.           (if (= nam_blk (cdr (assoc 2 unb_lt)))
  137.             (progn
  138.               (command "explode" unb_et)
  139.               (command "purge" "b" nam_blk "y" "y")
  140.               )
  141.             )
  142.           (setq i (1+ i))
  143.           )
  144.         )
  145.       )
  146.     (setq blk_ent (cdr (assoc -2 blk_lst)))                  ;得到块表所含图元入口
  147.     (while blk_ent
  148.       (setq lst (entget blk_ent))                            ;得到图块中子图元的图元表
  149.       (if (= oldlayer (cdr (assoc 8 lst)))                   ;判断该图元是否为要改变的图层
  150.         (progn
  151.           (setq lst (subst new_ly old_ly lst))               ;图层替换
  152.           (entmod lst)                                       ;回送图元表
  153.           )
  154.         )
  155.       (change_clltlw lst)
  156.       (setq blk_ent (entnext blk_ent))
  157.       )
  158.     (setq blk_lst (tblnext "block"))
  159.     )
  160. ;;; 改变属性图块中的图元
  161.   (setq int_ent (ssget "X" (list (cons '0 "INSERT"))))
  162.   (if int_ent (setq len (sslength int_ent)) (setq len 0))
  163.   (setq i 0)
  164.   (while (< i len)
  165.     (setq int_et (ssname int_ent i))
  166.     (setq int_et (entnext int_et))
  167.     (if int_et
  168.       (progn
  169.         (setq int_lt (entget int_et))
  170.         (if (= (cdr (assoc 0 int_lt)) "ATTRIB")
  171.           (while (/= (cdr (assoc 0 int_lt)) "SEQEND")
  172.             (if (= oldlayer (cdr (assoc 8 int_lt)))
  173.               (progn
  174.                 (setq int_lt (subst new_ly old_ly int_lt))
  175.                 (entmod int_lt)
  176.                 )
  177.               )
  178.             (change_clltlw int_lt)
  179.             (setq int_et (entnext int_et))
  180.             (setq int_lt (entget int_et))
  181.             )
  182.           )
  183.         )
  184.       )
  185.     (setq i (+ i 1))
  186.     )
  187.   
  188.   (princ "\n完成转换 ")
  189.   (princ num)
  190.   (princ " 个对象\n")
  191.   (if (= flag_ly "1") (command "purge" "la" oldlayer "n"))
  192.   (command "regenall")                                       ;重新生成
  193.   )

  194. (defun C:changelayer()
  195.   (setvar "cmdecho" 0)                                        ;关闭命令函数运行时回显提示和输入
  196.   (setq layername '())
  197.   (setq lay_lst (tblnext "layer" t))
  198.   (while lay_lst
  199.     (setq layername (cons (cdr (assoc 2 lay_lst)) layername))
  200.     (setq lay_lst (tblnext "layer"))
  201.     )
  202.   (setq layername (acad_strlsort layername))                  ;对图层名排序
  203.   (dialog_ly)
  204.   (if (and (/= newlayer oldlayer) (= std 1))
  205.     (progn
  206.       (princ (strcat "\n图层自: " oldlayer "\t转换到: " newlayer))
  207.       (change_ly)
  208.       )
  209.     )
  210.   (princ)
  211.   )
存为文件名: changelayer.dcl
  1. //定义转换图层的对话框
  2. changelayer:dialog{
  3.   label= "图层转换";
  4.   :row{
  5.       :list_box
  6.            {label="转换自";
  7.            key="oldly_list";
  8.            width=20;
  9.            height=12;
  10.            }
  11.       :list_box
  12.            {label="转换到";
  13.            key="newly_list";
  14.            width=20;
  15.            height=12;
  16.            }
  17.       }
  18.   :row{
  19.       :text{key="linetype1";width=20;value="线型:";}
  20.       :text{key="linetype2";width=20;value="线型:";}
  21.       }
  22.   :row{
  23.       :text{key="linewidth1";width=20;value="线宽:";}
  24.       :text{key="linewidth2";width=20;value="线宽:";}
  25.       }
  26.   :row{
  27.       :button{alignment=centered;fixed_width=true;width=10;label="设置...";key="set_ly";}
  28.       ok_cancel;
  29.       }
  30. }

  31. //定义设置的对话框
  32. setfunction:dialog{
  33.   label= "设置";
  34.   :column{
  35.          :toggle{label="强制对象颜色为ByLayer";key="change_cl";}
  36.          :toggle{label="强制对象线型为ByLayer";key="change_lt";}
  37.          :toggle{label="强制对象线宽为ByLayer";key="change_lw";}
  38.          :toggle{label="清理多余的图层";key="clean_ly";}
  39.          :text{label="";}
  40.          }
  41.   ok_cancel;
  42. }

点评

命令: changelayer ; 错误: 参数类型错误: stringp nil 还是一样有错误 请楼主再看一下 谢谢!  发表于 2012-10-22 22:09
发表于 2012-10-23 10:17 | 显示全部楼层
用到dosLib,请先加载 http://download.rhino3d.com/download.asp?id=doslib

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

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x
发表于 2012-12-31 09:49 | 显示全部楼层
好思路啊,不过具体怎么用,还要仔细考虑下,会改变好多习惯的,是恶习改掉还是成为变态
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-3-29 10:32 , Processed in 0.261122 second(s), 38 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表