按图层打断直线的程序，待优化

半听可乐 · 发表于 2013-1-6 22:58:06

本帖最后由半听可乐于 2013-1-11 09:18 编辑

求这样的功能：比如有图层a、图层b、图层c、图层d、图层e，按先后顺序选取各图层中一条直线（选择的先后顺序为图层a、图层b、图层c、图层d、图层e），然后框选需要处理的范围，然后范围内所有相交的直线被打断，规则是a层上的直线打断b、c、d、e层上的直线，b层上的直线打断c、d、e层上的直线，依次类推，打断间距默认200，可以设置

提供一个类似的程序如下：
使用步骤为：1.依次选图层（a、b、c、d）--2.框选范围--3.选图层e--4.a、b、c、d图层上的直线打断e
希望社区的那些热心的朋友能一如既往的帮助我，小弟在此拜谢！
(DEFUN C:ttt()
 (SETVAR "CMDECHO" 0)
 (setvar "osnapcoord" 2)
 (setvar "osmode" 0)
 (PROMPT "\n相交直线打断")
 (setq a 0 b 0 c 0 d 0 x 1 n 0 tol 0)
 (princ "\n设置打断长度<")
 (if(null dis)(setq dis 300) (setq dis2 dis))
 (princ dis)
 (setq dis (getreal ">:"))
 (if(null dis) (setq dis dis2))
 (setq dis1 (/ dis 2))
 (PROMPT "\n依次逐个选择上面的直线所在图层,1次选择不超过20个图层:")
 (setq ss2 (ssget '((0 . "LINE"))))
 (if (ssname ss2 0) (progn (SETQ l1 (CDR (ASSOC 8 (ENTGET (ssname ss2 0))))) (setq d (1+ d))) (setq l1 "ttwenchuandizhen"))
 (if (ssname ss2 1) (progn (SETQ l2 (CDR (ASSOC 8 (ENTGET (ssname ss2 1))))) (setq d (1+ d))) (setq l2 "ttwenchuandizhen"))
 (if (ssname ss2 2) (progn (SETQ l3 (CDR (ASSOC 8 (ENTGET (ssname ss2 2))))) (setq d (1+ d))) (setq l3 "ttwenchuandizhen"))
 (if (ssname ss2 3) (progn (SETQ l4 (CDR (ASSOC 8 (ENTGET (ssname ss2 3))))) (setq d (1+ d))) (setq l4 "ttwenchuandizhen"))
 (if (ssname ss2 4) (progn (SETQ l5 (CDR (ASSOC 8 (ENTGET (ssname ss2 4))))) (setq d (1+ d))) (setq l5 "ttwenchuandizhen"))
 (if (ssname ss2 5) (progn (SETQ l6 (CDR (ASSOC 8 (ENTGET (ssname ss2 5))))) (setq d (1+ d))) (setq l6 "ttwenchuandizhen"))
 (if (ssname ss2 6) (progn (SETQ l7 (CDR (ASSOC 8 (ENTGET (ssname ss2 6))))) (setq d (1+ d))) (setq l7 "ttwenchuandizhen"))
 (if (ssname ss2 7) (progn (SETQ l8 (CDR (ASSOC 8 (ENTGET (ssname ss2 7))))) (setq d (1+ d))) (setq l8 "ttwenchuandizhen"))
 (if (ssname ss2 8) (progn (SETQ l9 (CDR (ASSOC 8 (ENTGET (ssname ss2 8))))) (setq d (1+ d))) (setq l9 "ttwenchuandizhen"))
 (if (ssname ss2 9) (progn (SETQ l10 (CDR (ASSOC 8 (ENTGET (ssname ss2 9))))) (setq d (1+ d))) (setq l10 "ttwenchuandizhen"))
 (if (ssname ss2 10) (progn (SETQ l11 (CDR (ASSOC 8 (ENTGET (ssname ss2 10))))) (setq d (1+ d))) (setq l11 "ttwenchuandizhen"))
 (if (ssname ss2 11) (progn (SETQ l12 (CDR (ASSOC 8 (ENTGET (ssname ss2 11))))) (setq d (1+ d))) (setq l12 "ttwenchuandizhen"))
 (if (ssname ss2 12) (progn (SETQ l13 (CDR (ASSOC 8 (ENTGET (ssname ss2 12))))) (setq d (1+ d))) (setq l13 "ttwenchuandizhen"))
 (if (ssname ss2 13) (progn (SETQ l14 (CDR (ASSOC 8 (ENTGET (ssname ss2 13))))) (setq d (1+ d))) (setq l14 "ttwenchuandizhen"))
 (if (ssname ss2 14) (progn (SETQ l15 (CDR (ASSOC 8 (ENTGET (ssname ss2 14))))) (setq d (1+ d))) (setq l15 "ttwenchuandizhen"))
 (if (ssname ss2 15) (progn (SETQ l16 (CDR (ASSOC 8 (ENTGET (ssname ss2 15))))) (setq d (1+ d))) (setq l16 "ttwenchuandizhen"))
 (if (ssname ss2 16) (progn (SETQ l17 (CDR (ASSOC 8 (ENTGET (ssname ss2 16))))) (setq d (1+ d))) (setq l17 "ttwenchuandizhen"))
 (if (ssname ss2 17) (progn (SETQ l18 (CDR (ASSOC 8 (ENTGET (ssname ss2 17))))) (setq d (1+ d))) (setq l18 "ttwenchuandizhen"))
 (if (ssname ss2 18) (progn (SETQ l19 (CDR (ASSOC 8 (ENTGET (ssname ss2 18))))) (setq d (1+ d))) (setq l19 "ttwenchuandizhen"))
 (if (ssname ss2 19) (progn (SETQ l20 (CDR (ASSOC 8 (ENTGET (ssname ss2 19))))) (setq d (1+ d))) (setq l20 "ttwenchuandizhen"))
 (if (ssname ss2 20) (progn (SETQ l21 (CDR (ASSOC 8 (ENTGET (ssname ss2 20))))) (setq d (1+ d))))
 (if (> d 20) (quit))
 (princ "\n共计选择了")
 (princ d)
 (princ "个图层")
 (setq ss1 (ssget (list (cons 0 "LINE") (cons -4 "<or") (cons 8 l1) (cons 8 l2) (cons 8 l3) (cons 8 l4)
(cons 8 l5) (cons 8 l6) (cons 8 l7) (cons 8 l8) (cons 8 l9) (cons 8 l10) (cons 8 l11) (cons 8 l12) (cons 8 l13)
(cons 8 l14) (cons 8 l15) (cons 8 l16) (cons 8 l17) (cons 8 l18) (cons 8 l19) (cons 8 l20) (cons -4 "or>"))))
 (while (= nil (setq l0 (entsel "\n选择下面的直线所在图层: "))))
 (setq l0 (car l0))
 (setq l0 (entget l0))
 (setq l0 (cdr (assoc 8 l0)))
(while (/= x nil)
 (setq ss3 (ssget "X" (list (cons 8 l0) (cons -4 "<or") (cons 0 "LINE") (cons -4 "or>"))))
 (setq x nil)
 (princ "\n循环第")
 (setq n (1+ n))
 (princ n)
 (princ "次")
(while
 (< a (sslength ss1))
 (setq ent1 (entget (ssname ss1 a)))
 (setq ent2 (reverse (cdr (reverse (cdr (assoc 10 ent1))))))
 (setq ent3 (reverse (cdr (reverse (cdr (assoc 11 ent1))))))

(while
 (< b (sslength ss3))
 (setq s1 (ssname ss3 b))
 (setq ent4 (entget s1))
 (setq ent5 (reverse (cdr (reverse (cdr (assoc 10 ent4))))))
 (setq ent6 (reverse (cdr (reverse (cdr (assoc 11 ent4))))))
 (setq ent7 (angle ent5 ent6))
(if
 (setq ent8 (inters ent2 ent3 ent5 ent6))
(progn
 (setq tol (1+ tol))
 (setq x 1)
 (setq ent9 (polar ent8 ent7 dis1))
 (setq ent10 (polar ent8 (+ PI ent7) dis1))
 (setq ent11 (list s1 ent9))
 (command "break" ent11 ent10)
);progn
 );if
 (setq b (1+ b))
);while
 (setq b 0)
 (setq a (1+ a))
);while
 (setq a 0 b 0)
);while
 (princ "\n共计打断了")
 (princ tol)
 (princ "处。")
 (GC)
 (setvar "osmode" 3839)
 (SETVAR "CMDECHO" 1)
 (princ)
 );defun

004 · 发表于 2013-1-6 22:58:07

本帖最后由 004 于 2013-1-11 21:14 编辑

水平太次,费了不少时间,恳切希望得到大侠们的指点.

(defun c:tt (/ +ANG -ANG D E EL ELST EPT INT
INTLST LAY LAYLST LEN O1 O2 OE
ONEL ONELAY ONELL PT1 PT2 PTLST SS T1
T2 TWO X
)
;|求这样的功能：比如有图层a、图层b、图层c、图层d、图层e，
按先后顺序选取各图层中一条直线（选择的先后顺序为图层a、图层b、图层c、图层d、图层e），
然后框选需要处理的范围，然后范围内所有相交的直线被打断，规则是a层上的直线打断b、c、d、e层上的直线，
b层上的直线打断c、d、e层上的直线，依次类推，打断间距默认200，可以设置
提供一个类似的程序如下：
使用步骤为：1.依次选图层（a、b、c、d）--2.框选范围--3.选图层e--4.a、b、c、d图层上的直线打断e
|;;;wkq004 2013-01-11
;;参考;;画线打断于交点处 By Gu_xl 2012.12.11
(defun sjzl (e / EL LAY LAYL PT1 PT2)
(setq el (entget e))
(setq lay (cdr (assoc 8 el)))
(setq pt1 (cdr (assoc 10 el)))
(setq pt1 (list (car pt1) (cadr pt1)))
(setq pt2 (cdr (assoc 11 el)))
(setq pt2 (list (car pt2) (cadr pt2)))
(if (setq layl (assoc lay elst))
(if (not (member e (cadr layl)))
(setq
elst (subst (append layl (list (list e pt1 pt2))) layl elst)
)
)
(setq elst (cons (list lay (list e pt1 pt2)) elst)
laylst (cons lay laylst)
)
)
)
;;1.依次选图层（a、b、c、d）
(while (setq ept (entsel "\n选择直线,确定图层顺序->"))
(sjzl (car ept))
)
(if (cdr elst)
(progn
;;2.框选范围
(princ "\n框选范围:")
(setq ss
(ssget
(list
'(0 . "LINE")
(cons 8
(apply 'strcat
(mapcar '(lambda (x) (strcat x ",")) laylst)
)
)
)
)
)
(if ss
(repeat (setq len (sslength ss))
(sjzl (ssname ss (setq len (1- len))))
)
)
;|3.选图层e--4.a、b、c、d图层上的直线打断e
(if (setq ept (entsel "\n选择要被直接打断的直线->"))
(setq e (car ept)
el (entget e)
lay (cdr (assoc 8 el))
pt1 (cdr (assoc 10 el))
pt1 (list (car pt1) (cadr pt1))
pt2 (cdr (assoc 11 el))
pt2 (list (car pt2) (cadr pt2))
elst (cons (list lay (list e pt1 pt2)) elst)
)
)|;
;;程序部分
(if (null *d*)
(setq *d* 0)
)
(setq d (getdist (strcat "\n打断距离<" (rtos *d* 2 2) ">:")))
(if (null d)
(setq d *d*)
(setq *d* d)
)
(setq d (* 0.5 d))
(while (and (setq onell (car elst)) (setq elst (cdr elst)))
(progn
(setq onelay (car onell))
(setq onel (cdr onell))
(foreach one onel
(setq intlst '())
(setq oe (car one))
(setq o1 (cadr one))
(setq o2 (caddr one))
(foreach twoll elst
(foreach two (cdr twoll)
(setq t1 (cadr two))
(setq t2 (caddr two))
(setq int (inters t1 t2 o1 o2 T))
(if int
(setq intlst (cons int intlst))
)
)
)
(if intlst
(progn (entdel oe)
(setq intlst
(vl-sort intlst
(function
(lambda (a b)
(< (distance o1 a) (distance o1 b)) ;_mapcar apply改写
)
)
)
)
(setq one (car intlst))
(setq +ang (angle o1 o2))
(setq -ang (angle o2 o1))
(setq ptlst '())
(foreach two intlst
(if (> (distance one two) *d*)
(entmake (list '(0 . "LINE")
(cons 8 onelay)
(cons 10 (polar one +ang d))
(cons 11 (polar two -ang d))
)
)
)
(setq one two)
)
(if (> (distance o1 (setq one (car intlst))) d)
(entmake (list '(0 . "LINE")
(cons 8 onelay)
(cons 10 o1)
(cons 11 (polar one -ang d))
)
)
)
(if (> (distance o2 (setq two (last intlst))) d)
(entmake (list '(0 . "LINE")
(cons 8 onelay)
(cons 10 (polar two +ang d))
(cons 11 o2)
)
)
)
)
)
)
)
)
)
)
(princ)
)

(defun c:tt (/           +ANG         -ANG  D     E           EL         ELST  EPT   INT 
             INTLST         LAY   LAYLST           LEN         O1    O2    OE 
             ONEL  ONELAY      ONELL PT1   PT2         PTLST SS    T1 
             T2           TWO         X 
            ) 
            ;|求这样的功能：比如有图层a、图层b、图层c、图层d、图层e， 
按先后顺序选取各图层中一条直线（选择的先后顺序为图层a、图层b、图层c、图层d、图层e）， 
然后框选需要处理的范围，然后范围内所有相交的直线被打断，规则是a层上的直线打断b、c、d、e层上的直线， 
b层上的直线打断c、d、e层上的直线，依次类推，打断间距默认200，可以设置 
 
提供一个类似的程序如下： 
使用步骤为：1.依次选图层（a、b、c、d）--2.框选范围--3.选图层e--4.a、b、c、d图层上的直线打断e 
|;;;wkq004 2013-01-11 
  ;;参考;;画线打断于交点处 By Gu_xl 2012.12.11 
  (defun sjzl (e / EL LAY LAYL PT1 PT2) 
    (setq el (entget e)) 
    (setq lay (cdr (assoc 8 el))) 
    (setq pt1 (cdr (assoc 10 el))) 
    (setq pt1 (list (car pt1) (cadr pt1))) 
    (setq pt2 (cdr (assoc 11 el))) 
    (setq pt2 (list (car pt2) (cadr pt2))) 
    (if        (setq layl (assoc lay elst)) 
      (if (not (member e (cadr layl))) 
        (setq 
          elst (subst (append layl (list (list e pt1 pt2))) layl elst) 
        ) 
      ) 
      (setq elst   (cons (list lay (list e pt1 pt2)) elst) 
            laylst (cons lay laylst) 
      ) 
    ) 
  ) 
  ;;1.依次选图层（a、b、c、d） 
  (while (setq ept (entsel "\n选择直线,确定图层顺序->")) 
    (sjzl (car ept)) 
  ) 
  (if (cdr elst) 
    (progn 
      ;;2.框选范围 
      (princ "\n框选范围:") 
      (setq ss 
             (ssget 
               (list 
                 '(0 . "LINE") 
                 (cons 8 
                       (apply 'strcat 
                              (mapcar '(lambda (x) (strcat x ",")) laylst) 
                       ) 
                 ) 
               ) 
             ) 
      ) 
      (if ss 
        (repeat        (setq len (sslength ss)) 
          (sjzl (ssname ss (setq len (1- len)))) 
        ) 
      ) 
      ;|3.选图层e--4.a、b、c、d图层上的直线打断e 
      (if (setq ept (entsel "\n选择要被直接打断的直线->")) 
        (setq e           (car ept) 
              el   (entget e) 
              lay  (cdr (assoc 8 el)) 
              pt1  (cdr (assoc 10 el)) 
              pt1  (list (car pt1) (cadr pt1)) 
              pt2  (cdr (assoc 11 el)) 
              pt2  (list (car pt2) (cadr pt2)) 
              elst (cons (list lay (list e pt1 pt2)) elst) 
        ) 
      )|; 
      ;;程序部分 
      (if (null *d*) 
        (setq *d* 0) 
      ) 
      (setq d (getdist (strcat "\n打断距离<" (rtos *d* 2 2) ">:"))) 
      (if (null d) 
        (setq d *d*) 
        (setq *d* d) 
      ) 
      (setq d (* 0.5 d)) 
      (while (and (setq onell (car elst)) (setq elst (cdr elst))) 
        (progn 
          (setq onelay (car onell)) 
          (setq onel (cdr onell)) 
          (foreach one onel 
            (setq intlst '()) 
            (setq oe (car one)) 
            (setq o1 (cadr one)) 
            (setq o2 (caddr one)) 
            (foreach twoll elst 
              (foreach two (cdr twoll) 
                (setq t1 (cadr two)) 
                (setq t2 (caddr two)) 
                (setq int (inters t1 t2 o1 o2 T)) 
                (if int 
                  (setq intlst (cons int intlst)) 
                ) 
              ) 
            ) 
            (if        intlst 
              (progn (entdel oe) 
                     (setq intlst 
                            (vl-sort intlst 
                                     (function 
                                       (lambda (a b) 
                                         (< (distance o1 a) (distance o1 b)) ;_mapcar apply改写 
                                       ) 
                                     ) 
                            ) 
                     ) 
                     (setq one (car intlst)) 
                     (setq +ang (angle o1 o2)) 
                     (setq -ang (angle o2 o1)) 
                     (setq ptlst '()) 
                     (foreach two intlst 
                       (if (> (distance one two) *d*) 
                         (entmake (list        '(0 . "LINE") 
                                        (cons 8 onelay) 
                                        (cons 10 (polar one +ang d)) 
                                        (cons 11 (polar two -ang d)) 
                                  ) 
                         ) 
                       ) 
                       (setq one two) 
                     ) 
                     (if (> (distance o1 (setq one (car intlst))) d) 
                       (entmake        (list '(0 . "LINE") 
                                      (cons 8 onelay) 
                                      (cons 10 o1) 
                                      (cons 11 (polar one -ang d)) 
                                ) 
                       ) 
                     ) 
                     (if (> (distance o2 (setq two (last intlst))) d) 
                       (entmake        (list '(0 . "LINE") 
                                      (cons 8 onelay) 
                                      (cons 10 (polar two +ang d)) 
                                      (cons 11 o2) 
                                ) 
                       ) 
                     ) 
              ) 
            ) 
          ) 
        ) 
      ) 
    ) 
  ) 
  (princ) 
)

crazylsp · 发表于 2013-1-7 10:09:00

直接一个层里打断不行哇？

半听可乐 · 发表于 2013-1-7 14:09:00

crazylsp 发表于 2013-1-7 10:09
直接一个层里打断不行哇？

同层直线不打断

半听可乐 · 发表于 2013-1-10 22:30:23

顶起来顶起来冒个泡

yxp · 发表于 2013-1-11 04:56:45

好乱的程序，看着头晕

004 · 发表于 2013-1-11 19:23:25

要求写的真好.

半听可乐 · 发表于 2013-1-11 20:46:18

004 发表于 2013-1-11 19:23
要求写的真好.

谢谢你的关注，希望“选择要被直接打断的直线”这一步不要出现，直接按开始选择的图层顺序自动断开，有劳继续帮忙

004 · 发表于 2013-1-11 20:52:51

直接注释掉这段if即可。

半听可乐 · 发表于 2013-1-11 20:55:57

004 发表于 2013-1-11 20:52
直接注释掉这段if即可。

惭愧，不会改~

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

按图层打断直线的程序，待优化

最佳答案

相关帖子

本帖子中包含更多资源