急求按顺序打断线条的程序！！！

theisland

最近做一个弧形建筑，要画好多弧形管线，出图在即，线条打断却成了难题（严重低估了这部分工作量啊！），之前在本论坛找到一个可以按照图层顺序依次打断线条的程序，可惜只能识别直线，对弧线没有任何办法，不知道哪位大侠愿意救救急啊？大概作用就是依次选择几个图层如A、B、C，然后框选范围，先选择的图层能打断后选择的全部图层，即A能打断B、C，B只能打断C，现在的问题是：
1.图元识别问题：希望能加入弧线，如果可能的话不妨也加入PL线
2.希望能内置默认的图层顺序，比如说A,  B，C，A的优先级最高，也可以选择在图中点选图层顺序

程序提示顺序：请选择图层顺序（右键默认内置顺序）---请框选需要打断的对象（仅指定图层上的直线、弧线、PL线）--确定
下面是一个仅对直线管用的程序，供参考：
http://bbs.mjtd.com/thread-99967-1-1.html

重新上传了附件dwg和截图，望穿秋水，亟待解脱，再次拜谢！

llsheng_73

1. (DEFUN C:TT(/ lys d c d e)
   
2.   (if(setq d(setlys)lys(cdr d))
   
3.     (progn
   
4.       (command"undo""be")
   
5.       (setvar'cmdecho 0)
   
6.       (setq d(cons 40(/(car d)2.)))
   
7.       (foreach a(intersof(ssget(list'(0 . "line,arc,lwpolyline")(cons 8(apply'strcat(mapcar'(lambda(x)(strcat","x))lys)))))lys)
   
8.         (foreach b(setq c(car a)a(vl-sort(cdr a)'(lambda(x y)(>(vlax-curve-getDistAtPoint c x)(vlax-curve-getDistAtPoint c y)))))
   
9.           (command"trim"(setq e(entmakex(list'(0 . "circle")(cons 10 b)d)))""(list c b)"")
   
10.           (entdel e)))
    
11.       (setvar'cmdecho 1)
    
12.       (command"undo""end")))
    
13.   )
    
14. (defun makedcl (str_lst / dclfile fileID dclHandle)
    
15.   (setq  dclfile(vl-filename-mktemp nil nil ".dcl")fileID(open dclfile "w"))
    
16.   (cond((= (type str_lst) 'str)(write-line str_lst fileID))
    
17.        ((= (type str_lst) 'list)(foreach n str_lst (write-line n fileID))))
    
18.   (close fileID)
    
19.   (setq dclHandle (load_dialog dclfile))
    
20.   (vl-file-delete dclfile)
    
21.   dclHandle)
    
22. (defun setlys(/ lys dcl setlys_move setlys_dl setlys_rd lays a l);;;by llsheng_73
    
23.   (Defun lays(/ snl sll)
    
24.   (SetQ sll (TblNext "layer" T))
    
25.   (While (SetQ snl (Cons (Cdr (Assoc 2 sll)) snl)sll (TblNext "layer" nil)))
    
26.   (vl-sort snl '<))
    
27.   (defun setlys_move(f);;;by llsheng_73
    
28.     (setq a(read(strcat "("(get_tile"LYS")")"))l(mapcar'(lambda(x)(nth x lys))a)
    
29.           lys(if f(append(setq a(append(reverse(cddr(member(car l)(reverse lys))))l))(vl-remove-if'(lambda(x)(member x a))lys))
    
30.                (append(setq a(append(vl-remove-if'(lambda(x)(member x l))(reverse(member(last l)(reverse lys))))
    
31.                                     (vl-remove'nil(cons(cadr(member(last l)lys))l))))(vl-remove-if'(lambda(x)(member x a))lys))))
    
32.     (start_list"LYS")(mapcar'add_list lys)(end_list)
    
33.     (set_tile"LYS"(setq a(mapcar'(lambda(x)(itoa(vl-position x lys)))l)
    
34.                         a(strcat(car a)(apply'strcat(mapcar'(lambda(x)(strcat" "x))(cdr a)))))))
    
35.   (defun setlys_dl()
    
36.     (start_list"LYS")(mapcar'add_list(setq a(read(strcat "("(get_tile"LYS")")"))
    
37.                                            l(mapcar'(lambda(x)(nth x lys))a)
    
38.                                            lys(vl-remove-if'(lambda(x)(member x l))lys)))(end_list))
    
39.   (defun setlys_rd()
    
40.     (setq d(vlax-ldata-get"myset""layers")
    
41.           lys(if d(cdr d)(lays))d(if d(car d)200))
    
42.     (set_tile"IN"(rtos d))
    
43.     (start_list"LYS")(mapcar'add_list LYS)(end_list))
    
44.   (setq dcl(makedcl'("SETLYS:dialog{label=\"设置图层顺序\";:edit_box{key=\"IN\";label=\"修剪距离\";}"
    
45.                      ":row{:list_box{key=\"LYS\";multiple_select=true;}"
    
46.                      ":column{:button{key=\"UP\";label=\"上移\";}:button{key=\"DN\";label=\"下移\";}"
    
47.                      ":button{key=\"DL\";label=\"移除\";}:button{key=\"RD\";label=\"重置\";} "
    
48.                      "spacer;:button{key=\"GO\";label=\"确定\";is_default=true;}"
    
49.                      ":button{key=\"ESC\";label=\"取消\";is_cancel=true;}}}}")))
    
50.   (new_dialog"SETLYS"dcl)
    
51.   (setlys_rd)
    
52.   (action_tile"UP""(setlys_move t)")
    
53.   (action_tile"DN""(setlys_move nil)")
    
54.   (action_tile"DL""(setlys_dl)")
    
55.   (action_tile"RD""(setlys_rd)")
    
56.   (action_tile"IN""(if(or(not(setq d(distof $value)))(<= d 0))(progn(alert\"修剪距离应该大于0\")(mode_tile\"IN\"2)))")
    
57.   (action_tile"GO""(done_dialog 1)")
    
58.   (if(=(start_dialog)1)(vlax-ldata-put"myset""layers"(cons d lys))))
    
59. (defun subtotal(lst m ns / myfun a b c);;;by llslheng_73
    
60.   (defun myfun(x)(list(nth ns x)))
    
61.   (foreach x lst
    
62.     (setq a(if(setq c(nth m x)b(assoc c a))
    
63.              (subst(append b(myfun x))b a)
    
64.              (append a(list(append(list c)(myfun x))))))))
    
65. (defun intersof(ss lys / a b c d e i pts);;;by llslheng_73
    
66.   (setq i 0)
    
67.   (repeat(1-(sslength ss))
    
68.     (repeat(sslength(setq i -1 a(ssname ss 0)d(cdr(assoc 8(entget a)))ss(ssdel a ss)))
    
69.       (if(and(setq i(1+ i) b(ssname ss i) e(cdr(assoc 8(entget b)))
    
70.                    c(if(/= e d)(apply'vla-IntersectWith(append(mapcar'vlax-ename->vla-object(list a b))'(0)))))
    
71.              (>(vlax-safearray-get-u-bound(setq c(vlax-variant-value c))1) 0))
    
72.         (setq pts(cons(list(vlax-safearray->list c)
    
73.                            (caar(vl-sort(list(list a d)(list b e))'(lambda(x y)(>(vl-position(last x)lys)(vl-position(last y)lys))))))pts)))))
    
74.   (subtotal pts 1 0))
    
75. (alert"依图层交点修剪，命令TT\n更多需求QQ275988734")

(DEFUN C:TT(/ lys d c d e)<br />   (if(setq d(setlys)lys(cdr d))<br />     (progn<br />       (command"undo""be")<br />       (setvar'cmdecho 0)<br />       (setq d(cons 40(/(car d)2.)))<br />       (foreach a(intersof(ssget(list'(0 . "line,arc,lwpolyline")(cons 8(apply'strcat(mapcar'(lambda(x)(strcat","x))lys)))))lys)<br />         (foreach b(setq c(car a)a(vl-sort(cdr a)'(lambda(x y)(>(vlax-curve-getDistAtPoint c x)(vlax-curve-getDistAtPoint c y)))))<br />           (command"trim"(setq e(entmakex(list'(0 . "circle")(cons 10 b)d)))""(list c b)"")<br />           (entdel e)))<br />       (setvar'cmdecho 1)<br />       (command"undo""end")))<br />   )<br /> (defun makedcl (str_lst / dclfile fileID dclHandle)<br />   (setq  dclfile(vl-filename-mktemp nil nil ".dcl")fileID(open dclfile "w"))<br />   (cond((= (type str_lst) 'str)(write-line str_lst fileID))<br />        ((= (type str_lst) 'list)(foreach n str_lst (write-line n fileID))))<br />   (close fileID)<br />   (setq dclHandle (load_dialog dclfile))<br />   (vl-file-delete dclfile)<br />   dclHandle)<br /> (defun setlys(/ lys dcl setlys_move setlys_dl setlys_rd lays a l);;;by llsheng_73<br />   (Defun lays(/ snl sll)<br />   (SetQ sll (TblNext "layer" T))<br />   (While (SetQ snl (Cons (Cdr (Assoc 2 sll)) snl)sll (TblNext "layer" nil)))<br />   (vl-sort snl '<))<br />   (defun setlys_move(f);;;by llsheng_73<br />     (setq a(read(strcat "("(get_tile"LYS")")"))l(mapcar'(lambda(x)(nth x lys))a)<br />           lys(if f(append(setq a(append(reverse(cddr(member(car l)(reverse lys))))l))(vl-remove-if'(lambda(x)(member x a))lys))<br />                (append(setq a(append(vl-remove-if'(lambda(x)(member x l))(reverse(member(last l)(reverse lys))))<br />                                     (vl-remove'nil(cons(cadr(member(last l)lys))l))))(vl-remove-if'(lambda(x)(member x a))lys))))<br />     (start_list"LYS")(mapcar'add_list lys)(end_list)<br />     (set_tile"LYS"(setq a(mapcar'(lambda(x)(itoa(vl-position x lys)))l)<br />                         a(strcat(car a)(apply'strcat(mapcar'(lambda(x)(strcat" "x))(cdr a)))))))<br />   (defun setlys_dl()<br />     (start_list"LYS")(mapcar'add_list(setq a(read(strcat "("(get_tile"LYS")")"))<br />                                            l(mapcar'(lambda(x)(nth x lys))a)<br />                                            lys(vl-remove-if'(lambda(x)(member x l))lys)))(end_list))<br />   (defun setlys_rd()<br />     (setq d(vlax-ldata-get"myset""layers")<br />           lys(if d(cdr d)(lays))d(if d(car d)200))<br />     (set_tile"IN"(rtos d))<br />     (start_list"LYS")(mapcar'add_list LYS)(end_list))<br />   (setq dcl(makedcl'("SETLYS:dialog{label=\"设置图层顺序\";:edit_box{key=\"IN\";label=\"修剪距离\";}"<br />                      ":row{:list_box{key=\"LYS\";multiple_select=true;}"<br />                      ":column{:button{key=\"UP\";label=\"上移\";}:button{key=\"DN\";label=\"下移\";}"<br />                      ":button{key=\"DL\";label=\"移除\";}:button{key=\"RD\";label=\"重置\";} "<br />                      "spacer;:button{key=\"GO\";label=\"确定\";is_default=true;}"<br />                      ":button{key=\"ESC\";label=\"取消\";is_cancel=true;}}}}")))<br />   (new_dialog"SETLYS"dcl)<br />   (setlys_rd)<br />   (action_tile"UP""(setlys_move t)")<br />   (action_tile"DN""(setlys_move nil)")<br />   (action_tile"DL""(setlys_dl)")<br />   (action_tile"RD""(setlys_rd)")<br />   (action_tile"IN""(if(or(not(setq d(distof $value)))(<= d 0))(progn(alert\"修剪距离应该大于0\")(mode_tile\"IN\"2)))")<br />   (action_tile"GO""(done_dialog 1)")<br />   (if(=(start_dialog)1)(vlax-ldata-put"myset""layers"(cons d lys))))<br /> (defun subtotal(lst m ns / myfun a b c);;;by llslheng_73<br />   (defun myfun(x)(list(nth ns x)))<br />   (foreach x lst<br />     (setq a(if(setq c(nth m x)b(assoc c a))<br />              (subst(append b(myfun x))b a)<br />              (append a(list(append(list c)(myfun x))))))))<br /> (defun intersof(ss lys / a b c d e i pts);;;by llslheng_73<br />   (setq i 0)<br />   (repeat(1-(sslength ss))<br />     (repeat(sslength(setq i -1 a(ssname ss 0)d(cdr(assoc 8(entget a)))ss(ssdel a ss)))<br />       (if(and(setq i(1+ i) b(ssname ss i) e(cdr(assoc 8(entget b)))<br />                    c(if(/= e d)(apply'vla-IntersectWith(append(mapcar'vlax-ename->vla-object(list a b))'(0)))))<br />              (>(vlax-safearray-get-u-bound(setq c(vlax-variant-value c))1) 0))<br />         (setq pts(cons(list(vlax-safearray->list c)<br />                            (caar(vl-sort(list(list a d)(list b e))'(lambda(x y)(>(vl-position(last x)lys)(vl-position(last y)lys))))))pts)))))<br />   (subtotal pts 1 0))<br /> (alert"依图层交点修剪，命令TT\n更多需求QQ275988734")

郁闷死了，上传不了图片也传不了附件，该死的IE11?
命令tt,用测试图测试没发现问题，可以调整图层顺序（但不是楼主要求的点选图元来决定顺序而是直接在对话框里边调整图层名列表的顺序）及定义剪切距离（要求大于0），这些数据会随图形一起保存，重新运行命令或者下次打开图形运行命令都会重新读取出来

xyp1964

;; tt(主次打断连半弧)
;;关键是找点的问题
;; 图层顺序：1、2、3、4

theisland

xyp1964 发表于 2015-8-29 10:40
;; tt(主次打断连半弧)
;;关键是找点的问题
;; 图层顺序：1、2、3、4

我想要的不是这种打断样式（虽然好看，但不符合制图规范），而是直接打断，两断点间距离默认200，并且可以手动输入，非常感谢你的热心回复    因为我这边图层很多，还希望能提供源码，便于自己整理图层顺序和添加，非常感谢！

theisland

上传附件了，请各位高手关注下，帮我救救急，谢谢大家了！

etoxp

貌似楼主的图并不是在所有交点均打断。

有些交点处打断，有些不打断；
有些交点处打断水平线，保留竖线；
有些交点处打断竖线，保留水平线。
有蛮复杂的，要批量实现恐怕很难。

至少楼主要能描述清楚“打断规则”。否则恐怕只能手动去一个个选交点。

如果一个个去选交点还算简单：
从“右上--->左下”框选，识别区分水平线与竖线。打断水平线，保留竖线。
从“右下--->左上”框选，识别区分水平线与竖线。打断竖线，保留水平线。

etoxp

打断规则不知道可不可以类似按这样描述：
有n个图层: lay1 lay2 lay3.......layn
lay1比lay2优先，因此lay1上的线与lay2上的线相交时，打断lay1上的线，保留lay2.
lay2比lay3优先，因此lay2上的线与lay3上的线相交时，打断lay2上的线，保留lay3.
……
当然你也可以定义特殊规则，譬如你规定：
虽然lay5比lay6优先，但仍保留lay5，打断lay6。

规则定义好并程序化后，可以用一个笨办法：
遍历(while)所有线，遍历某线与之相交的线，按规则打断，并收集好新生成的线。
新生成的线也要参与到后面的遍历当中……因些遍历对象的数目是动态增加的。
最后找不到可打断之处时终止程序。可以设一个最大循环次数，避免耗时太多或陷入死循环。

应该有更简单的办法……仅供参考。

theisland

etoxp 发表于 2015-8-29 13:49
打断规则不知道可不可以类似按这样描述：
有n个图层: lay1 lay2 lay3.......layn
lay1比lay2优先，因此la ...

我所谓的优先级高的图层，你可以理解为是菜刀；优先级低的，你可以理解是菜，菜刀切菜，这是我想要的效果

theisland

etoxp 发表于 2015-8-29 13:35
貌似楼主的图并不是在所有交点均打断。

有些交点处打断，有些不打断；

没你说的那么复杂，你好好看看呢，就是相当于一个直线型公司的管理架构，一级一级的往下管理（切断），上级可以对下级（任意层次的下级）的任何部门发出指令，但同级之间互不干涉

theisland

etoxp 发表于 2015-8-29 13:35
貌似楼主的图并不是在所有交点均打断。

有些交点处打断，有些不打断；

没你说的那么复杂，你好好看看呢，就是相当于一个直线型公司的管理架构，一级一级的往下管理（切断），上级可以对下级（任意层次的下级）的任何部门发出指令，但同级之间互不干涉