Break multiple polylines with each other

[eng_mohamedmustafa]

Hi >>> please help me in this .... after some search on the forum i find this lisp (break lines, polylines) for entire drawing.

(defun c:bmcut (/ _pts d cutter e pts pts2 p1 p2)
  (defun _pts (ent)
    (mapcar 'cdr (vl-remove-if-not '(lambda (x)
		(member (car x) '(10 11))) ent)))                       
  (setq d (getdist "\nEnter Gap distance: "))
  (princ "\nSelect Cutter lines:")
  (setq cutter (ssget (setq fl '((-4 . "<OR")
                        (-4 . "<AND")
                        (0 . "LWPOLYLINE")
                        (90 . 2)
                        (-4 . "AND>")
                        (0 . "LINE")
                        (-4 . "OR>")
                       ))
               )
  )
  (repeat (setq i (sslength cutter))
    (setq e (ssname cutter (setq i (1- i))))
    (setq pts (_pts (entget e)))
    (if (and (setq cut-ee (ssget "_F" pts fl))
             (ssdel e cut-ee)
        )
      (repeat (setq n (sslength cut-ee))
        (Setq en (ssname cut-ee (setq n (1- n))))
        (setq pts2 (_pts (entget en)))
        (setq bpt (inters (Car pts) (cadr pts) (car pts2) (cadr pts2)))
        (setq p1 (polar bpt (angle (car pts2) (cadr pts2)) (* d 0.5)))
        (setq p2 (polar bpt (angle (cadr pts2) (car pts2)) (* d 0.5)))
        (command "_break" en "_non" p1 "_non" p2)
      )
    )
  )
)

but i want some edits please >>>

1- this lisp for only vertical and horizontal poly lines only +++ ... that means if i have polyline path with (s) shape for example the lisp ignore to select the path so i want the lisp to select any shape of polyline routing

2- if i have huge drawing with multiple polylines routing i want to select entire drawing and set my gap ... then the lisp compare between the no. of polylines of the intersecting polylines and the greater the no. of polylines will cut and break the fewer the no. of polylines that intersecting with them with my specific gap

3- (optional) i want to insert spline or brackets at breaked polylines

thanks and hope to help

[ronjonp]

If you can accept a different graphic maybe this will work for you. 😃

[john.uhden]

I'm sorry, but this just seems too easy, though I haven't put any keys to any code...

1.  Create a selection set of the cutting lines/plines (ss1).

2.  Create a selection set of all the other lines/plines to be broken (ss2).

3.  Iterate through ss1 to find all intersections with each of ss2 using vla-intersectwith extendnone.

4.  Break the intersections of ss2 as you see fit.

5.  Keep adding the broken pieces to ss2, via (ssadd (entnext (entlast)) ss2).

6.  Keep iterating through ss1 until no more intersections are found.

Yeah, I'm probably way off, but at least I responded with something.

Motto #1 - You gotta start somewhere.

[eng_mohamedmustafa]

already i test this before but when i submit to project consultant, he reject my drawings and he want the case i explain in my post

thanks

[CADaSchtroumpf]

---

@john.uhden  a écrit :

I'm sorry, but this just seems too easy, though I haven't put any keys to any code...

1.  Create a selection set of the cutting lines/plines (ss1).

2.  Create a selection set of all the other lines/plines to be broken (ss2).

3.  Iterate through ss1 to find all intersections with each of ss2 using vla-intersectwith extendnone.

4.  Break the intersections of ss2 as you see fit.

5.  Keep adding the broken pieces to ss2, via (ssadd (entnext (entlast)) ss2).

6.  Keep iterating through ss1 until no more intersections are found.

Yeah, I'm probably way off, but at least I responded with something.

Motto #1 - You gotta start somewhere.

---

@john.uhden 

Sorry John but I didn't understand all the subtleties of your message (I'm French...).
Of course I can cut all the polylines, I know how to do...
I give you the example code.
I don't use the "_BREAK" command, why?
Because I am using Autocad Map and the "_BREAK" command causes the Object Data to be lost at the second part of the cut polyline, which is very annoying.
AutoDesk forgot about this for Object Data, while for XData this is not the case; the data is kept for the two severed parts.
So this code is inspired by the technique I use for Autocad Map (The one I deliver does not keep the ODs, but I could have done it)

[eng_mohamedmustafa]

Hi ... this lisp break both set of polylines with 0 gap ... i want the lisp to ask me for breaking gap and to break one set only at intersecting points as per attached images

[john.uhden]

@CADaSchtroumpf 

I have an idea I just tried an it works.

Use the LENGTHEN command.

No error checking, but it should retain your OD and XD:

(defun @break ( / Gap pick e1 e2 obj1 obj2 Lt D D1 D2 P Begin End)
(initget 7)
(setq Gap (getdist "\nGap distance: "))
(setq pick (entsel "\nSelect curve at point to break: "))
(setq e1 (car pick))
(setq P (cadr pick))
(setq obj1 (vlax-ename->vla-object e1))
(setq obj2 (vla-copy obj1))
(vlax-put obj2 'Color 3) ; just to see the difference
(setq Lt (vlax-get obj1 'Length))
(setq Begin (vlax-curve-getpointatdist obj1 0.0))
(setq End (vlax-curve-getpointatdist obj1 Lt))
(setq P (vlax-curve-getclosestpointto obj1 P))
(setq e2 (vlax-vla-object->ename obj2))
(setq D (vlax-curve-getdistatpoint obj1 P))
(setq D1 (- D (* 0.5 Gap)))
(setq D2 (- Lt D (* 0.5 Gap)))
(setq P1 (vlax-curve-getpointatdist obj1 D1))
(setq P2 (vlax-curve-getpointatdist obj2 D2))
(vl-cmdf "_.lengthen" "_Total" D2 (list e1 Begin) "")
(vl-cmdf "_.lengthen" "_Total" D1 (list e2 End) "")
)

[eng_mohamedmustafa]

Hi

this lisp ask me to choose single polyline .... no option for selecting all entire drawing ...

[john.uhden]

@eng_mohamedmustafa

So sorry.

I intended only to show a method for breaking without using the BREAK command.

I can put together what you want, but my real work must come first.

[john.uhden]

@eng_mohamedmustafa 

I have it working.  Just need to clean it up a little.

Do you want to have cutting plines/lines breaking other cutting plines/lines (except themselves)?

That would reduce the input to one (1) selection set consisting of both lines and/or plines.

[john.uhden]

Blast it all!  I wanted to give myself a "like" but that's not allowed for modest people. 😁

Note that we used to have to include <SEG> but emoticons have taken over. 👾

[Kent1Cooper]

Not there yet....  Take another look at the drawing attached at Message 6, and the images snipped from it at Messages 18 & 25.

[CADaSchtroumpf]

@eng_mohamedmustafa 

A little progress
It's not perfect but it no longer intersects all the polylines.
I can't see how to fix the gap in my code because it's getting complicated.
But once the polylines are cut a manual stretching of the polylines with the gap can be done.
I don't think I can go any further, but if it allows you, that's already good...

(vl-load-com)
(defun add_vtx (obj add_pt ent_name / sw ew nw bulg)
  (vla-GetWidth obj (fix add_pt) 'sw 'ew)
  (vla-addVertex
    obj
    (1+ (fix add_pt))
    (vlax-make-variant
      (vlax-safearray-fill
        (vlax-make-safearray vlax-vbdouble (cons 0 1))
          (list
            (car (trans (vlax-curve-getpointatparam obj add_pt) 0 ent_name))
            (cadr (trans (vlax-curve-getpointatparam obj add_pt) 0 ent_name))
          )
      )
    )
  )
  (setq
    nw
    (*
      (/
        (- ew sw)
        (- (vlax-curve-getdistatparam obj (1+ (fix add_pt))) (vlax-curve-getdistatparam obj (fix add_pt)))
      )
      (- (vlax-curve-getdistatparam obj add_pt) (vlax-curve-getdistatparam obj (fix add_pt)))
    )
    bulg (atan (vla-GetBulge obj (fix add_pt)))
  )
  (vla-SetBulge obj
    (fix add_pt)
    (/
      (sin (* 4 bulg (- add_pt (fix add_pt)) 0.25))
      (cos (* 4 bulg (- add_pt (fix add_pt)) 0.25))
    )
  )
  (vla-SetBulge obj
    (1+ (fix add_pt))
    (/
      (sin (* 4 bulg (- (1+ (fix add_pt)) add_pt) 0.25))
      (cos (* 4 bulg (- (1+ (fix add_pt)) add_pt) 0.25))
    )
  )
  (vla-SetWidth obj
    (fix add_pt)
    sw
    (+ nw sw)
  )
  (vla-SetWidth obj
    (1+ (fix add_pt))
    (+ nw sw)
    ew
  )
  (vla-update obj)
)
(defun cut@point (ss lst_pt / n obj dxf_10 pt_brk l_tst lst_sort lst_brk dxf_obj dxf_43 dxf_38 dxf_39 dxf_10 dxf_40 dxf_41 dxf_42 dxf_210 ltmp lst_tmp where count)
  (repeat (setq n (sslength ss))
    (setq
      ename (ssname ss (setq n (1- n)))
      obj (vlax-ename->vla-object ename)
      dxf_10 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ename)))
    )
    (foreach el (mapcar '(lambda (x) (trans x 0 ename)) lst_pt)
      (setq
        pt_brk (trans (vlax-curve-getClosestPointTo ename (trans el ename 0) nil) 0 ename)
        l_tst (vl-member-if '(lambda (x) (and (equal (car x) (car pt_brk) 1E-08) (equal (cadr x) (cadr pt_brk) 1E-08))) dxf_10)
      )
      (if
        (and
          (equal pt_brk el 1E-08)
          (not (eq (length l_tst) 1))
          (not (eq (length l_tst) (length dxf_10)))
        )
        (progn
          (setq lst_brk (cons pt_brk lst_brk))
          (if (zerop (length l_tst))
            (add_vtx obj (vlax-curve-getparamatpoint ename (trans pt_brk ename 0)) ename)
          )
        )
      )
    )
    (setq
      lst_sort (mapcar '(lambda (x) (list (vlax-curve-GetDistAtPoint ename (trans x ename 0)) (list (car x) (cadr x)))) lst_brk)
      lst_brk (reverse (mapcar 'cadr (mapcar '(lambda (x) (assoc x lst_sort)) (vl-sort (mapcar 'car lst_sort) '<))))
      dxf_obj (entget ename)
    )
    (if (cdr (assoc 43 dxf_obj))
      (setq dxf_43 (cdr (assoc 43 dxf_obj)))
      (setq dxf_43 0.0)
    )
    (if (cdr (assoc 38 dxf_obj))
      (setq dxf_38 (cdr (assoc 38 dxf_obj)))
      (setq dxf_38 0.0)
    )
    (if (cdr (assoc 39 dxf_obj))
      (setq dxf_39 (cdr (assoc 39 dxf_obj)))
      (setq dxf_39 0.0)
    )
    (setq
      dxf_10 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) dxf_obj))
      dxf_40 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 40)) dxf_obj))
      dxf_41 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 41)) dxf_obj))
      dxf_42 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 42)) dxf_obj))
      dxf_210 (cdr (assoc 210 dxf_obj))
    )
    (if (not (zerop (boole 1 (cdr (assoc 70 dxf_obj)) 1)))
      (setq
        dxf_10 (append dxf_10 (list (car dxf_10)))
        dxf_40 (append dxf_40 (list (car dxf_40)))
        dxf_41 (append dxf_41 (list (car dxf_41)))
        dxf_42 (append dxf_42 (list (car dxf_42)))
      )
    )
    (repeat (1+ (length lst_brk))
      (setq
        ltmp nil
        lst_tmp (vl-member-if '(lambda (x) (and (equal (car x) (caar lst_brk) 1E-08) (equal (cadr x) (cadar lst_brk) 1E-08))) dxf_10)
        where (if lst_tmp (vl-position (car lst_tmp) dxf_10) 0)
      )
      (repeat (setq count (- (length dxf_10) where))
        (setq ltmp (cons (mapcar '(lambda (x y) (cons y (nth where x))) (list dxf_10 dxf_40 dxf_41 dxf_42) (list 10 40 41 42)) ltmp))
        (setq where (1+ where))
      )
      (entmake
        (append
          (list
            (cons 0 "LWPOLYLINE")
            (cons 100 "AcDbEntity")
            (assoc 67 dxf_obj)
            (assoc 410 dxf_obj)
            (assoc 8 dxf_obj)
            (if (assoc 62 dxf_obj) (assoc 62 dxf_obj) (cons 62 256))
            (if (assoc 6 dxf_obj) (assoc 6 dxf_obj) (cons 6 "BYLAYER"))
            (if (assoc 370 dxf_obj) (assoc 370 dxf_obj) (cons 370 -1))
            (cons 100 "AcDbPolyline")
            (cons 90 (length ltmp))
            (cons 70 (boole 1 (cdr (assoc 70 dxf_obj)) 128))
            (cons 38 dxf_38)
            (cons 39 dxf_39)
          )
          (apply 'append (reverse ltmp))
          (list (cons 210 dxf_210))
        )
      )
      (repeat (1- count)
        (setq
          dxf_10 (reverse (cdr (reverse dxf_10)))
          dxf_40 (reverse (cdr (reverse dxf_40)))
          dxf_41 (reverse (cdr (reverse dxf_41)))
          dxf_42 (reverse (cdr (reverse dxf_42)))
        )
      )
      (setq lst_brk (cdr lst_brk) ltmp nil)
    )
    (ssdel ename js)
    (entdel ename)
    (ssadd (entlast) js)
  )
)
(defun c:break_lwpoly ( / js js_b AcDoc Space gap n e_name obj nam_lay nb tmp_name tmp_obj vrt_pt pt lst_pt ss_tmp c_ent perim)
  (vl-load-com)
  (princ "\nSelect polylines to cut")
  (setq js (ssget '((0 . "LWPOLYLINE"))))
  (princ "\nSelect cutting polylines")
  (setq js_b (ssget '((0 . "LWPOLYLINE"))))
  (cond
    ((and js js_b)
      (setq
        AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
        Space
        (if (= 1 (getvar "CVPORT"))
          (vla-get-PaperSpace AcDoc)
          (vla-get-ModelSpace AcDoc)
        )
      )
;     (initget 6)
;     (setq gap (getdist "\nDistance for gap? <50.0>: "))
;     (if (not gap) (setq gap 50.0))
      (repeat (setq n (sslength js))
        (setq e_name (ssname js (setq n (1- n))))
        (cond
          (e_name
            (setq
              obj (vlax-ename->vla-object e_name)
              nam_lay (assoc 8 (entget e_name))
              lst_pt nil
            )
            (repeat (setq nb (sslength js_b))
              (setq tmp_name (ssname js_b (setq nb (1- nb))))
              (cond
                (tmp_name
                  (setq
                    tmp_obj (vlax-ename->vla-object tmp_name)
                    vrt_pt (vlax-variant-value (vla-IntersectWith obj tmp_obj 0))
                  )
                  (if (>= (vlax-safearray-get-u-bound vrt_pt 1) 0)
                    (progn
                      (setq pt (vlax-safearray->list vrt_pt))
                      (if pt
                        (if (> (length pt) 3)
                          (repeat (/ (length pt) 3)
                            (setq lst_pt (cons (list (car pt) (cadr pt) (caddr pt)) lst_pt) pt (cdddr pt))
                          )
                          (setq lst_pt (cons pt lst_pt))
                        )
                      )
                    )
                  )
                )
              )
            )
            (if (and lst_pt (listp lst_pt))
              (cut@point js lst_pt)
            )
          )
        )
      )
      (setq ss_tmp (ssget "_X" (list '(0 . "LWPOLYLINE") nam_lay)))
      (cond
        (ss_tmp
          (repeat (setq n (sslength ss_tmp))
            (setq
              c_ent (ssname ss_tmp (setq n (1- n)))
              perim (vlax-curve-getDistAtParam c_ent (vlax-curve-getEndParam c_ent))
            )
;           (if (<= perim gap)
            (if (<= perim (+ 30.0 1E-8))
              (entdel c_ent)
            )
          )
        )
      )
    )
  )
  (prin1)
)

[john.uhden]

@Kent1Cooper 

This isn't what he wanted?

[Kent1Cooper]

---

@john.uhden wrote:

This isn't what he wanted?

---

Those magenta parts are not just different widths or lineweights, but groups of multiple closely-spaced Polylines, sometimes groups in both directions.  The gap in breaking whichever you break would need to be figured somehow around the group, not just one, and ensuring all those in one direction get broken but none in the other, not to mention determining which set to break when there are multiples in both directions [see item 2 in Message 1] seems very daunting, if even possible.

[john.uhden]

@Kent1Cooper

Look again at my snip.  The gaps span across the multiple plines, which also answers my own question as to what my code would do with gap distances exceeding what is left of a line/pline.  Just lucky on that I guess 'cause I was just hoping, not testing.  Haven't tested arcs or splines or ellipses.

[Kent1Cooper]

In your snip, it looks like the gaps in those single objects that are broken around a group are not centered around the group, but around one object in it, mostly but not always apparently at one edge of it.  And there's no breaking where group crosses group, as in their sample drawing -- that to me seems like one of the biggest challenges in the whole difficult operation.  Not that I have a solution to offer....

[john.uhden]

@Kent1Cooper 

I took it that he wanted one group to break another, not itself.

Yes, I have imperfections where several cutters near one another are crossed by a victim, but I really don't feel like pursuing perfection at this time.

Here's what I have to offer, which supersedes my offering of decades past:

(defun c:MultiBreak ( / *error* Doc cmd gap ss1 ss2 list1 list2 n @ss2list @group @break @e2o)

  ;; v1.00 (12-01-2022) John F. Uhden
  ;; Routine takes a selection set of Lines/Plines as cutting edges,
  ;; and a second selection set of Lines/Plines and breaks them with a 
  ;; user-defined gap where each of the 2nd set intersects each of the 1st.

  (gc)
  (prompt "\nMultiBreak v1.0 (c)2022, John F. Uhden")
 
  (defun *error* (err)
    (setvar "cmdecho" cmd)
    (vla-endundomark Doc)
    (cond
      ((not err))
      ((wcmatch (strcase err) "*CANCEL*,*QUIT*")
        (vl-exit-with-error "\r                                              ")
      )
      (1 (vl-exit-with-error (strcat "\r*ERROR*: " err)))
    )
    (princ)
  )
  ;;-------------------------------------------
  ;; Initialize drawing and program variables:
  ;;
  (setq Doc (vlax-get (vlax-get-acad-object) 'Activedocument)
        cmd (getvar "cmdecho")
  )
  (vla-endundomark Doc)
  (vla-startundomark Doc)
  (setvar "cmdecho" 0)
  (command "_.expert" (getvar "expert")) ;; dummy command

  (setq @e2o vlax-ename->vla-object)
  (defun @ss2list (ss / i list)
    (repeat (setq i (sslength ss))
      (setq list (cons (ssname ss (setq i (1- i))) list))
    )
  )
  ;; Function to group a list of items into a list of
  ;; multiple lists, each of length N, e.g.
  ;; '(A B C D E F G H I) -> '((A B C)(D E F)(G H I))
  (defun @group (lst n / item new)
    (foreach element (reverse lst)
      (setq item (cons element item))
      (if (= (length item) n)
        (setq new (cons item new) item nil)
      )
    )
    new
  )
  (defun @break (pick / e1 e2 obj1 obj2 -Lt -D -D1 -D2 -P -Begin -End)
    (setq e1 (car pick))
    (setq P (cadr pick))
    (setq obj1 (vlax-ename->vla-object e1))
    (setq obj2 (vla-copy obj1))
    (vlax-put obj2 'Color 3) ; just to see the difference
    (setq Lt (vlax-get obj1 'Length))
    (setq Begin (vlax-curve-getpointatdist obj1 0.0))
    (setq End (vlax-curve-getpointatdist obj1 Lt))
    (setq P (vlax-curve-getclosestpointto obj1 P))
    (setq e2 (vlax-vla-object->ename obj2))
    (setq D (vlax-curve-getdistatpoint obj1 P))
    (setq D1 (max 0.1 (- D (* 0.5 Gap)))) ;; had to cheat to avoid failure
    (setq D2 (max 0.1 (- Lt D (* 0.5 Gap)))) ;; had to cheat to avoid failure
    (vl-cmdf "_.lengthen" "_Total" D2 (list e1 Begin) "")
    (vl-cmdf "_.lengthen" "_Total" D1 (list e2 End) "")
    e2
  )
  (if (setq gap (vl-bb-ref '*BreakGap*))
    (progn
      (initget 4)
      (if (setq Gap (getdist (STRCAT "\nGap distance <" (rtos gap) ">: ")))
        (vl-bb-set '*BreakGap* Gap)
        (setq Gap (vl-bb-ref '*BreakGap*))
      )
    )
    (progn
      (initget 5)
      (setq Gap (getdist "\nGap distance: "))
      (vl-bb-set '*BreakGap* Gap)
    )
  )
  (and
    (princ "\nSelect breaking plines/lines: ")
    (setq ss1 (ssget '((0 . "LINE,LWPOLYLINE"))))
    (princ "\nSelect plines/lines to break: ")
    (setq ss2 (ssget '((0 . "LINE,LWPOLYLINE"))))
    (setq list1 (@ss2list ss1) list2 (@ss2list ss2))
    (setq n (length list2))
    (setq e (entlast) elast e)
    (OR (while (setq e (entnext e))(setq elast e)) 1)
    (foreach e1 list1
      (foreach e2 list2
        (and
          (setq ints (vlax-invoke (@e2o e1) 'intersectwith (@e2o e2) acextendnone))
          (foreach int (@group ints 3)
            (setq new (@break (list e2 int)))
            (setq list2 (cons new list2))
          )
        )
      )
    )
  )
  (princ (strcat "\nBroke " (itoa n) " curve objects into " (itoa (length list2)) " pieces."))
  (*error* nil)
)
(defun c:MBreak ()(c:MultiBreak))
(defun c:MB ()(c:MultiBreak))

[Sea-Haven]

My take on this and have used this before, is image post 18 a lot of hor lines trimmed to a lot of vert lines.

Ok step 1 drag line over hor lines.

step2 drag line over ver lines.

step 3 sort order of hor lines keeping entity name in list left to right

step4 same but ver lines top to bottom.

If the lines are parallel makes this much easier can set the Xmin Xmax for the break 

Using intersect 1st hor line with 1st and last ver line plus offset then break.

Repeat for all hor lines.

Will try to find what I did before.

[eng_mohamedmustafa]

unfortunately ... i try a lot of lisps ... and solutions ... all of them not working as i need ... have anyone another solutions or another lisp to break all polylines at ones???

[john.uhden]

@eng_mohamedmustafa 

Those parallel cutting lines/plines offer a problem beyond my simple solution.

Any chance those parallel things can be turned into one polyline with a width?  If so, my solution could be embellished to handle them.