图层快捷工具

黑洞—杜明智 · 发表于 2013-3-10 00:15:22

本帖最后由黑洞—杜明智于 2013-3-13 13:38 编辑

经过一段时间的学习，终于弄出个小东西来，来明经回馈一下，很多知识都是明经学来的。
一个图层内复制，移动，删除的小工具。
听从楼下建议附上源码，作为一个新手来供大家批评指导。（英文水平限制，用了大量的拼音

）

//dcl.dcl
dcl_settings:default_dcl_settings {audit_level = 3;}
chlayer : dialog {
label = "图层对象操作";
: row {
: boxed_radio_column {
label = "执行操作";
key="Guolv";
: radio_button {
label = "转层(&1)";
key = "Change";
value = "1";
}
: radio_button {
label = "复制(&2)";
key = "Copy";
value = "0";
}
: radio_button {
label = "移动(&3)";
key = "Move";
value = "0";
}
: radio_button {
label = "删除(&4)";
key = "Delete";
value = "0";
}
}
////////////////////////
: column {
: boxed_column {
label = "图层设置";
:row{
:button{
label="源图层<";
key="YuanTuCeng";
width=8;
fixed_width=true;
}
:popup_list {
key="YTC";
edit_width =14;
fixed_width=true;
list="0" ;
}
}
:row{
:button{
label="目标层<";
key="MuBiaoCeng";
width=8;
fixed_width=true;
}
:popup_list {
key="MBTC";
edit_width =14;
fixed_width=true;
list="0" ;
}
}
}
: boxed_column {
label="操作范围";
: toggle {
label = " 对源图层<全部对象>操作";
key = "All";
value = "0";
}
}
}
///////////////////////
}
: boxed_column {
: concatenation {
: text_part {
label = "使用帮助:";
width=9;
fixed_width=true;
}
: text_part {
label = "QQ:307170606!";
key = "DuiXiang";
width=22;
fixed_width=true;
}
: text_part {
label = "";
key = "CaoZuo";
width=12;
fixed_width=true;
}
}
}
ok_cancel;
}

//dcl.dcl 
dcl_settings:default_dcl_settings {audit_level = 3;} 
chlayer : dialog { 
  label = "图层对象操作"; 
    : row { 
    : boxed_radio_column { 
      label = "执行操作"; 
       key="Guolv"; 
        : radio_button { 
                label = "转层(&1)"; 
                key = "Change"; 
                value = "1"; 
            }             
            : radio_button { 
                label = "复制(&2)"; 
                key = "Copy"; 
                value = "0"; 
            } 
            : radio_button { 
                label = "移动(&3)"; 
                key = "Move"; 
                value = "0"; 
            } 
            : radio_button { 
               label = "删除(&4)"; 
               key = "Delete"; 
               value = "0"; 
            } 
             
          } 
    //////////////////////// 
    : column { 
     : boxed_column { 
        label = "图层设置"; 
    :row{ 
      :button{ 
        label="源图层<"; 
        key="YuanTuCeng"; 
        width=8; 
        fixed_width=true; 
      } 
      :popup_list { 
        key="YTC"; 
        edit_width =14; 
        fixed_width=true; 
        list="0" ; 
      } 
       
    } 
    :row{ 
      :button{ 
        label="目标层<"; 
        key="MuBiaoCeng"; 
        width=8; 
        fixed_width=true; 
      } 
      :popup_list { 
        key="MBTC"; 
        edit_width =14; 
        fixed_width=true; 
        list="0" ; 
      } 
    } 
    } 
    : boxed_column { 
      label="操作范围"; 
      : toggle { 
                label = " 对源图层<全部对象>操作"; 
                key = "All"; 
                value = "0"; 
                
      }   
    } 
    } 
    /////////////////////// 
  } 
  : boxed_column { 
    : concatenation { 
    : text_part { 
                        label = "使用帮助:"; 
                        width=9; 
                        fixed_width=true; 
                } 
                : text_part { 
                        label = "QQ:307170606!"; 
                        key = "DuiXiang"; 
                        width=22; 
                        fixed_width=true; 
                } 
                : text_part { 
                        label = ""; 
                        key = "CaoZuo"; 
                        width=12; 
                        fixed_width=true; 
                } 
        } 
        } 
  ok_cancel; 
}

;;utils.lsp
(vl-load-com)
(setq *AObject* (vlax-get-Acad-Object))
(setq *ADocument* (vla-get-ActiveDocument *AObject*))
(setq *ModelSpace* (vla-get-ModelSpace *ADocument*))

;;io.lsp
(defun c:vc (/ Dlg_POS dcl_id std dialogLoaded dialogShow ss )
(setq dialogLoaded T
dialogShow T
)
(setq dcl_id (load_dialog "E:/2013/dcl.DCL"));;注意链接位置替换
(if (= -1 dcl_id)
(progn
(alert
" 无法加载对话框！"
)
(setq dialogLoaded nil)
)
)
(if (= nil guolv_str)
(setq guolv_str "Change")
)
(if (= nil YTC_str)
(setq YTC_str
(vla-get-name (vla-get-ActiveLayer *ADocument*))
YTC_i "0"
)
)
(if (= nil MBTC_str)
(setq MBTC_str
(vla-get-name (vla-get-ActiveLayer *ADocument*))
MBTC_i "0"
)
)
(if (= nil All_i)
(setq All_i 0)
)
(if (= nil Dlg_POS)
(setq Dlg_POS '(50 100))
)
;;;--------------------------------------------------------------------
(setq std 3)
(while (> std 2)
;; 初始化对话框
(dlg)
)
;;; ---------------------------------------------------
(unload_dialog dcl_id)
;;; ------------------------------------------------
(if (= 1 std)
(CHlayer_draw)
)
)
;;;_ 结束 defun---------
(defun dlg ()
;; 对话框放置屏幕左上角
(if (and dialogLoaded
(not (new_dialog "chlayer" dcl_id "" Dlg_POS))
)
(progn
(alert
" 无法显示对话框！" )
(setq dialogShow nil)
)
)
;;
(if (and dialogLoaded dialogShow)
(progn
(Set_tile "Guolv" guolv_str)
(setq TC_ls nil)
(vlax-for X1
(vlax-get
(vlax-get (vlax-get-acad-object) 'ActiveDocument)
'Layers
)
(setq TC_ls (cons (vlax-get X1 'Name) TC_ls))
)
(start_list "YTC" 3 0)
(mapcar 'add_list (reverse TC_ls))
(end_list)
;;
(start_list "MBTC" 3 0)
(mapcar 'add_list (reverse TC_ls))
(end_list)
;;
(Set_tile "YTC" YTC_i)
(Set_tile "MBTC" MBTC_i)
(Set_tile "All" (rtos All_i))
;;
(action_tile "Guolv" "(SETQ guolv_str $value)(text)")
(action_tile "All" "(SETQ All_i (atoi $value))(text)")
(action_tile "YuanTuCeng" "(getData)(setq Dlg_POS (done_dialog 3))")
(action_tile "MuBiaoCeng" "(getData)(setq Dlg_POS (done_dialog 4))")
(action_tile "accept" "(getData)(setq Dlg_POS (done_dialog 1))" )
(action_tile "cancel" "(setq Dlg_POS (done_dialog 0))")
;;
(setq std (start_dialog))
(cond
((= std 3) (get_YTC))
((= std 4) (get_MBTC))
)
)
)
)
;;;==================================;;;
;;;------定义从对话框中获取数据
;;;==================================;;;
(defun getData ()
;;
(setq guolv_str (get_tile "Guolv"))
(setq All_i (atoI (get_tile "All")))
;;
(setq YTC_i (get_tile "YTC")
MBTC_i (get_tile "MBTC")
)
;;
(setq YTC_str (nth (atoi YTC_i) (reverse TC_ls))
MBTC_str (nth (atoi MBTC_i) (reverse TC_ls))
)
)
;;;_ 结束
;;;==================================;;;
;;;-----定义图层列表要显示的图层
;;;==================================;;;
(defun get_YTC (/ ytc1 ytc2 ytc3)
(setq ytc1 nil)
(while (= ytc1 nil)
(SETQ ytc1 (car (entsel "\n请选择源图层对象：")))
)
(setq ytc2 (entget ytc1))
(setq ytc3 (cdr (assoc 8 ytc2)))
(setq YTC_i (rtos (vl-position ytc3 (reverse TC_ls))))
(princ "\n")
)
(defun get_MBTC (/ mbtc1 mbtc2 mbtc3)
(setq mbtc1 nil)
(while (= mbtc1 nil)
(SETQ mbtc1 (car (entsel "\n请选择目标图层对象：")))
)
(setq mbtc2 (entget mbtc1))
(setq mbtc3 (cdr (assoc 8 mbtc2)))
(setq MBTC_i (rtos (vl-position mbtc3 (reverse TC_ls))))
(princ "\n")
)
;;;_ 结束定义
(defun text ()
(set_tile "XinXi" "")
(if (= 1 All_i)(set_tile "DuiXiang" "将源图层上的<全部对象>")(set_tile "DuiXiang" "将源图层上的<被选对象>"))
(cond
((= guolv_str "Change") (set_tile "CaoZuo" "转层到目标层"))
((= guolv_str "Copy") (set_tile "CaoZuo" "复制到目标层"))
((= guolv_str "Move") (set_tile "CaoZuo" "在源图层移动"))
((= guolv_str "Delete") (set_tile "CaoZuo" "在源图层删除"))
)
)

;;io.lsp 
(defun c:vc (/ Dlg_POS dcl_id std dialogLoaded dialogShow ss ) 
  (setq  dialogLoaded T 
  dialogShow   T 
  ) 
  (setq dcl_id (load_dialog "E:/2013/dcl.DCL"));;注意链接位置替换 
  (if (= -1 dcl_id) 
    (progn 
      (alert 
  "         无法加载对话框 ！" 
      ) 
      (setq dialogLoaded nil) 
    ) 
  ) 
  (if (= nil guolv_str) 
    (setq guolv_str "Change") 
  ) 
  (if (= nil YTC_str) 
    (setq YTC_str 
     (vla-get-name (vla-get-ActiveLayer *ADocument*)) 
    YTC_i  "0" 
    ) 
  ) 
  (if (= nil MBTC_str) 
    (setq MBTC_str 
     (vla-get-name (vla-get-ActiveLayer *ADocument*)) 
    MBTC_i "0" 
    ) 
  ) 
  (if (= nil All_i) 
    (setq All_i 0) 
  ) 
  (if (= nil Dlg_POS) 
    (setq Dlg_POS '(50 100)) 
  ) 
;;;-------------------------------------------------------------------- 
  (setq std 3) 
  (while (> std 2) 
    ;; 初始化对话框 
    (dlg) 
  ) 
;;;  --------------------------------------------------- 
  (unload_dialog dcl_id) 
;;;  ------------------------------------------------ 
  (if (= 1 std) 
    (CHlayer_draw) 
  ) 
) 
;;;_ 结束 defun--------- 
 
(defun dlg () 
  ;; 对话框放置屏幕左上角 
  (if (and dialogLoaded 
     (not (new_dialog "chlayer" dcl_id "" Dlg_POS)) 
      ) 
    (progn 
      (alert 
  "         无法显示对话框 ！"      ) 
      (setq dialogShow nil) 
    ) 
  ) 
  ;; 
  (if (and dialogLoaded dialogShow) 
    (progn 
      (Set_tile "Guolv" guolv_str) 
      (setq TC_ls nil) 
      (vlax-for  X1 
       (vlax-get 
         (vlax-get (vlax-get-acad-object) 'ActiveDocument) 
         'Layers 
       ) 
  (setq TC_ls (cons (vlax-get X1 'Name) TC_ls)) 
      ) 
      (start_list "YTC" 3 0) 
      (mapcar 'add_list (reverse TC_ls)) 
      (end_list) 
      ;; 
      (start_list "MBTC" 3 0) 
      (mapcar 'add_list (reverse TC_ls)) 
      (end_list) 
      ;; 
      (Set_tile "YTC" YTC_i) 
      (Set_tile "MBTC" MBTC_i) 
      (Set_tile "All" (rtos All_i)) 
      ;; 
      (action_tile "Guolv" "(SETQ guolv_str $value)(text)") 
      (action_tile "All" "(SETQ All_i (atoi $value))(text)") 
     (action_tile "YuanTuCeng" "(getData)(setq Dlg_POS (done_dialog 3))")       
     (action_tile "MuBiaoCeng"  "(getData)(setq Dlg_POS (done_dialog 4))") 
     (action_tile "accept" "(getData)(setq Dlg_POS (done_dialog 1))" ) 
      (action_tile "cancel" "(setq Dlg_POS (done_dialog 0))") 
      ;; 
      (setq std (start_dialog)) 
      (cond 
  ((= std 3) (get_YTC)) 
  ((= std 4) (get_MBTC)) 
      ) 
    ) 
  ) 
) 
 
 
;;;==================================;;; 
;;;------定义从对话框中获取数据 
;;;==================================;;; 
(defun getData () 
  ;; 
  (setq guolv_str (get_tile "Guolv")) 
  (setq All_i (atoI (get_tile "All"))) 
  ;; 
  (setq  YTC_i  (get_tile "YTC") 
  MBTC_i (get_tile "MBTC") 
  ) 
  ;; 
  (setq  YTC_str  (nth (atoi YTC_i) (reverse TC_ls)) 
  MBTC_str (nth (atoi MBTC_i) (reverse TC_ls)) 
  ) 
) 
;;;_ 结束 
 
;;;==================================;;; 
;;;-----定义图层列表要显示的图层 
;;;==================================;;; 
 
(defun get_YTC (/ ytc1 ytc2 ytc3) 
  (setq ytc1 nil) 
  (while (= ytc1 nil) 
    (SETQ ytc1 (car (entsel "\n请选择源图层对象："))) 
  ) 
  (setq ytc2 (entget ytc1)) 
  (setq  ytc3 (cdr (assoc 8 ytc2))) 
  (setq YTC_i (rtos (vl-position ytc3 (reverse TC_ls)))) 
  (princ "\n") 
) 
(defun get_MBTC (/ mbtc1 mbtc2 mbtc3) 
  (setq mbtc1 nil) 
  (while (= mbtc1 nil) 
    (SETQ mbtc1 (car (entsel "\n请选择目标图层对象："))) 
  ) 
  (setq mbtc2 (entget mbtc1)) 
  (setq  mbtc3 (cdr (assoc 8 mbtc2))) 
  (setq MBTC_i (rtos (vl-position mbtc3 (reverse TC_ls)))) 
  (princ "\n") 
) 
;;;_ 结束定义 
 
(defun text () 
  (set_tile "XinXi" "") 
  (if (= 1 All_i)(set_tile "DuiXiang" "将源图层上的<全部对象>")(set_tile "DuiXiang" "将源图层上的<被选对象>")) 
  (cond 
    ((= guolv_str "Change") (set_tile "CaoZuo" "转层到目标层")) 
    ((= guolv_str "Copy") (set_tile "CaoZuo" "复制到目标层")) 
    ((= guolv_str "Move") (set_tile "CaoZuo" "在源图层移动")) 
    ((= guolv_str "Delete") (set_tile "CaoZuo" "在源图层删除")) 
  ) 
)

;;draw.LSP
(defun CHlayer_draw ()
(WHILE (= SS NIL)
(if (= 1 All_i)
(setq ss (ssget "X" (list (cons 8 YTC_str))))
(setq ss (ssget (list (cons 8 YTC_str))))
)
)
(cond
((= guolv_str "Change")
(vl-cmdf "_.change" ss "" "p" "la" MBTC_str "")
)
((= guolv_str "Copy")
(vl-cmdf "_.copy" ss "" "@" "@" "_.change" ss "" "p" "la" MBTC_str
"")
)
((= guolv_str "Move") (vl-cmdf "_.MOVE" ss ""))
((= guolv_str "Delete") (vl-cmdf "_.ERASE" ss ""))
)
(PRINC)
)

xuesfh007 · 发表于 2013-5-7 15:13:32

为什么下载不了呢

ajunseo · 发表于 2021-5-25 23:08:40

想法不错，界面也挺靓，可惜是一个编译过的文件！楼主可否放出源码，便于大家交流。

USER2128 · 发表于 2013-3-11 18:14:09

想法不错，界面也挺靓，可惜是一个编译过的文件！楼主可否放出源码，便于大家交流。

黑洞—杜明智 · 发表于 2013-3-13 13:40:10

USER2128 发表于 2013-3-11 18:14
想法不错，界面也挺靓，可惜是一个编译过的文件！楼主可否放出源码，便于大家交流。

源码附上，多多指导哈

有123 · 发表于 2013-4-28 00:30:49

这个应该不错

完整武器 · 发表于 2013-4-29 22:27:09

下载的人多顶的人少啊

ylzhaosjz · 发表于 2013-4-30 08:49:56

太实用了,这个图层工具.

黑洞—杜明智 · 发表于 2013-5-7 20:11:41

xuesfh007 发表于 2013-5-7 15:13
为什么下载不了呢

测试正常，检查一下网络。

xuesfh007 · 发表于 2013-5-8 18:24:48

显示

抱歉，只有特定用户可以下载本站附件

_稻_草_人_ · 发表于 2013-7-27 16:50:48

没有下载权限啊

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

[LISP资料] 图层快捷工具

本帖子中包含更多资源

评分

相关帖子

评分