图层快捷工具
本帖最后由 黑洞—杜明智 于 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;
}
;;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 )
(setqdialogLoaded 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-forX1
(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")))
;;
(setqYTC_i(get_tile "YTC")
MBTC_i (get_tile "MBTC")
)
;;
(setqYTC_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))
(setqytc3 (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))
(setqmbtc3 (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)
)
为什么下载不了呢 想法不错，界面也挺靓，可惜是一个编译过的文件！楼主可否放出源码，便于大家交流。 想法不错，界面也挺靓，可惜是一个编译过的文件！楼主可否放出源码，便于大家交流。 USER2128 发表于 2013-3-11 18:14 static/image/common/back.gif
想法不错，界面也挺靓，可惜是一个编译过的文件！楼主可否放出源码，便于大家交流。
源码附上，多多指导哈 这个应该不错
下载的人多 顶的人少啊 太实用了,这个图层工具. xuesfh007 发表于 2013-5-7 15:13 static/image/common/back.gif
为什么下载不了呢
测试正常，检查一下网络。
显示
抱歉，只有特定用户可以下载本站附件 没有下载权限啊