polyline splitter autolisp command

GeryKnee · ‎01-17-2021

Hello to All

I need a code that splits a polyline that splits a polyline.

That's :::

1) Prompts for a splitter objects selection (polylines,lines)

2) Prompts for a polyline Object

3) The code uses those splitter objects wich have common points with the polyline vertices to split the polyline.

4) Deletes the Splitter Objects

Here are two examples:

Thanks,

Gery

CodeDing · ‎01-17-2021

@GeryKnee ,

For AutoCAD 2020 - Earlier, use the BREAK command.

I have mine set as a custom command to break at a single point:

(defun c:BBREAK ( / )
  (command "_.BREAK" pause "f" pause "non" (getvar 'LASTPOINT))
  (princ)
);defun

For AutoCAD 2021 - Current, use the BREAKATPOINT command.

Best,

~DD

GeryKnee · ‎01-17-2021

It's not exactly what i need, but it;s a solution.

Thanks.

CADaSchtroumpf · ‎01-18-2021

I may have a solution which is more for Map, but it must also work with vanilla lisp

It's cut a polyline with the intersection of other objects while keeping the Map OD or Xdata.

Try

(vl-load-com)
(defun add_vtx (obj add_pt ent_name / bulg)
  (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 bulg (vla-GetBulge obj (fix add_pt)))
  (vla-SetBulge obj
    (fix add_pt)
    (/
      (sin (/ (* 4 (atan bulg) (- add_pt (fix add_pt))) 4))
      (cos (/ (* 4 (atan bulg) (- add_pt (fix add_pt))) 4))
    )
  )
  (vla-SetBulge obj
    (1+ (fix add_pt))
    (/
      (sin (/ (* 4 (atan bulg) (- (1+ (fix add_pt)) add_pt)) 4))
      (cos (/ (* 4 (atan bulg) (- (1+ (fix add_pt)) add_pt)) 4))
    )
  )
  (vla-update obj)
)
(defun c:break_lw_withOD ( / js i js_b i ent obj nb tmp_name tmp_obj vrt_pt pt lst_pt dxf_obj xd_l dxf_43 dxf_38 dxf_39 dxf_10 dxf_40 dxf_41 dxf_42 dxf_39 dxf_210 n_vtx l nwent tbldef lst_data)
  (princ "\nSélection des LWPOLYLINE à couper")
  (setq js
    (ssget
      (list
        (cons 0 "LWPOLYLINE")
        (cons 67 (if (eq (getvar "CVPORT") 2) 0 1))
        (cons 410 (if (eq (getvar "CVPORT") 2) "Model" (getvar "CTAB")))
      )
    )
  )
  (princ "\nSélection des objets curvilignes coupant les polylignes")
  (setq js_b
    (ssget
      (list
        (cons 0 "LINE,ARC,SPLINE,LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE,XLINE,RAY,MPOLYGON")
        (cons 67 (if (eq (getvar "CVPORT") 2) 0 1))
        (cons 410 (if (eq (getvar "CVPORT") 2) "Model" (getvar "CTAB")))
      )
    )
  )
  (cond
    ((and js js_b)
      (repeat (setq i (sslength js))
        (setq
          ent (ssname js (setq i (1- i)))
          obj (vlax-ename->vla-object ent)
        )
        (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))
                    )
                  )
                )
              )
            )
          )
        )
        (setq dxf_10 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ent))))
        (if (and lst_pt (listp lst_pt))
          (foreach el lst_pt
            (if (not (member T (mapcar '(lambda (x) (equal (list (car el) (cadr el)) x 1E-8)) dxf_10)))
              (add_vtx obj (vlax-curve-getparamatpoint obj (vlax-curve-getClosestPointTo obj el)) ent)
            )
          )
        )
        (setq
          dxf_obj (entget ent (list "*"))
          xd_l (assoc -3 dxf_obj)
        )
        (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)))
          )
        )
        (setq lst_pt (reverse (mapcar '(lambda (x) (list (car (trans x 0 ent)) (cadr (trans x 0 ent)))) lst_pt)))
        (repeat (length lst_pt)
          (setq n_vtx -1 l nil)
          (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 (1+ (vl-position T (mapcar '(lambda (x) (equal x (car lst_pt) 1E-8)) dxf_10))))
                (cons 70 (boole 1 (cdr (assoc 70 dxf_obj)) 128))
                (cons 38 dxf_38)
                (cons 39 dxf_39)
              )
              (reverse
                (repeat (1+ (vl-position T (mapcar '(lambda (x) (equal x (car lst_pt) 1E-8)) dxf_10)))
                  (setq l
                    (append
                      (list
                        (cons 42 (nth (1+ n_vtx) dxf_42))
                        (cons 41 (nth (1+ n_vtx) dxf_41))
                        (cons 40 (nth (1+ n_vtx) dxf_40))
                        (cons 10 (nth (setq n_vtx (1+ n_vtx)) dxf_10))
                      )
                      l
                    )
                  )
                )
              )
              (list (assoc 210 dxf_obj))
              (if xd_l (list xd_l) '())
            )
          )
          (repeat n_vtx
            (setq dxf_10 (cdr dxf_10) dxf_40 (cdr dxf_40) dxf_41 (cdr dxf_41) dxf_42 (cdr dxf_42))
          )
          (setq lst_pt (cdr lst_pt) lst_data nil nwent (entlast))
          (if
            (or
              (numberp (vl-string-search "Map 3D" (vla-get-caption (vlax-get-acad-object))))
              (numberp (vl-string-search "Civil 3D" (vla-get-caption (vlax-get-acad-object))))
            )
            (progn
              (foreach n (ade_odgettables ent)
                (setq tbldef (ade_odtabledefn n))
                (setq lst_data
                  (cons
                    (mapcar
                      '(lambda (fld / tmp_rec numrec)
                        (setq numrec (ade_odrecordqty ent n))
                        (cons
                          n
                          (while (not (zerop numrec))
                            (setq numrec (1- numrec))
                            (if (zerop numrec)
                              (if tmp_rec
                                (cons fld (list (cons (ade_odgetfield ent n fld numrec) tmp_rec)))
                                (cons fld (ade_odgetfield ent n fld numrec))
                              )
                              (setq tmp_rec (cons (ade_odgetfield ent n fld numrec) tmp_rec))
                            )
                          )
                        )
                      )
                      (mapcar 'cdar (cdaddr tbldef))
                    )
                    lst_data
                  )
                )
              )
              (cond
                (lst_data
                  (mapcar
                    '(lambda (x / ct)
                      (while (< (ade_odrecordqty nwent (caar x)) (ade_odrecordqty ent (caar x)))
                        (ade_odaddrecord nwent (caar x))
                      )
                      (foreach el (mapcar 'cdr x)
                        (if (listp (cdr el))
                          (progn
                            (setq ct -1)
                            (mapcar
                              '(lambda (y / )
                                (ade_odsetfield nwent (caar x) (car el) (setq ct (1+ ct)) y)
                              )
                              (cadr el)
                            )
                          )
                          (ade_odsetfield nwent (caar x) (car el) 0 (cdr el))
                        )
                      )
                    )
                    lst_data
                  )
                )
              )
            )
          )
        )
        (setq n_vtx -1 l nil)
        (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 dxf_10))
              (cons 70 (boole 1 (cdr (assoc 70 dxf_obj)) 128))
              (cons 38 dxf_38)
              (cons 39 dxf_39)
            )
            (reverse
            (repeat (length dxf_10)
              (setq l
                (append
                  (list
                    (cons 42 (nth (1+ n_vtx) dxf_42))
                    (cons 41 (nth (1+ n_vtx) dxf_41))
                    (cons 40 (nth (1+ n_vtx) dxf_40))
                    (cons 10 (nth (setq n_vtx (1+ n_vtx)) dxf_10))
                  )
                  l
                )
              )
            )
            )
            (list (assoc 210 dxf_obj))
            (if xd_l (list xd_l) '())
          )
        )
        (setq lst_data nil nwent (entlast))
        (if
          (or
            (numberp (vl-string-search "Map 3D" (vla-get-caption (vlax-get-acad-object))))
            (numberp (vl-string-search "Civil 3D" (vla-get-caption (vlax-get-acad-object))))
          )
          (progn
            (foreach n (ade_odgettables ent)
              (setq tbldef (ade_odtabledefn n))
              (setq lst_data
                (cons
                  (mapcar
                    '(lambda (fld / tmp_rec numrec)
                      (setq numrec (ade_odrecordqty ent n))
                      (cons
                        n
                        (while (not (zerop numrec))
                          (setq numrec (1- numrec))
                          (if (zerop numrec)
                            (if tmp_rec
                              (cons fld (list (cons (ade_odgetfield ent n fld numrec) tmp_rec)))
                              (cons fld (ade_odgetfield ent n fld numrec))
                            )
                            (setq tmp_rec (cons (ade_odgetfield ent n fld numrec) tmp_rec))
                          )
                        )
                      )
                    )
                    (mapcar 'cdar (cdaddr tbldef))
                  )
                  lst_data
                )
              )
            )
            (cond
              (lst_data
                (mapcar
                  '(lambda (x / ct)
                    (while (< (ade_odrecordqty nwent (caar x)) (ade_odrecordqty ent (caar x)))
                      (ade_odaddrecord nwent (caar x))
                    )
                    (foreach el (mapcar 'cdr x)
                      (if (listp (cdr el))
                        (progn
                          (setq ct -1)
                          (mapcar
                            '(lambda (y / )
                              (ade_odsetfield nwent (caar x) (car el) (setq ct (1+ ct)) y)
                            )
                            (cadr el)
                          )
                        )
                        (ade_odsetfield nwent (caar x) (car el) 0 (cdr el))
                      )
                    )
                  )
                  lst_data
                )
              )
            )
          )
        )
        (entdel ent)
      )
      (print (sslength js)) (princ " LWpolyligne(s) coupée(s) aux points d'intersection  avec ses Object Datas.")
    )
  )
  (prin1)
)

Kent1Cooper · ‎01-18-2021

@GeryKnee wrote:

....

3) The code uses those splitter objects wich have common points with the polyline vertices to split the polyline.

....

Clarify something:

Does the splitter object need to have an endpoint or [if it's a Polyline] a vertex at the same location as a vertex in the one that is to be split? What if some place in mid-segment in a splitter Polyline, or in the middle of a splitter Line or Arc or something, crosses at a vertex in the one to be split? Should it be split there?

Kent Cooper, AIA

GeryKnee · ‎01-18-2021

Yes, that's working perbectly

Thank you Very Much

Gery.

GeryKnee · ‎01-18-2021

Dear Kent.

1. YES The splitter object need to have an endpoint or [if it's a Polyline] a vertex at the same location as a vertex in the one that is to be split.

2. If some place in mid-segment in a splitter Polyline, or in the middle of a splitter Line or Arc or something, crosses at a vertex in the one to be split , NO SPLIT WILL OCCURE THERE.

3. The Objects those can be Spliteeres (according to above), after SPLIT (BREAK) have to be deleted (created just to split).

NoreExamples :::

Thank you very much.

Gery.

GeryKnee · ‎01-18-2021

One More example

ronjonp · ‎01-18-2021

@GeryKnee Here's another one for fun 🍻

(defun c:foo (/ a b c e el l1 l2 n r s)
  ;; RJP » 2021-01-18
  ;; Splits a polyline with other polylines that share a common vertex
  (cond	((and (setq e (car (entsel "\nPick polyline to split: ")))
	      (= "LWPOLYLINE" (cdr (assoc 0 (setq el (entget e)))))
	      (not (vla-getboundingbox (vlax-ename->vla-object e) 'a 'b))
	      (mapcar 'set '(a b) (mapcar 'vlax-safearray->list (list a b)))
	      (setq s (ssdel e (ssget "_C" a b '((0 . "LWPOLYLINE")))))
	      (> (sslength s) 0)
	 )
	 (foreach p (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
	   (setq c (cons (vl-remove-if '(lambda (x) (/= 10 (car x))) (entget p)) c))
	 )
	 (setq c (apply 'append c))
	 (setq l1 (reverse (cdr (member (assoc 10 el) (reverse el)))))
	 (setq l1 (append (subst '(70 . 0) (assoc 70 l1) l1)))
	 (setq l2 (reverse (cdr (reverse (member (assoc 10 el) el)))))
	 (and (= 1 (logand 1 (cdr (assoc 70 el)))) (setq l2 (append l2 (list (assoc 10 el)))))
	 (setq n 0)
	 (foreach p l2
	   (if (vl-some '(lambda (x) (equal p x 1e-8)) c)
	     (progn (setq r (cons p r))
		    (entmake (append l1 (reverse r) (list (cons 62 (setq n (1+ n))))))
		    (setq r (list p))
	     )
	     (setq r (cons p r))
	   )
	 )
	 (entmake (append l1 (reverse r) (list (cons 62 (setq n (1+ n))))))
	)
  )
  (princ)
)
(vl-load-com)

GeryKnee · ‎01-19-2021

Yes,

That's nearly what i thought about.

It's very good that automatically searches for the splitters.

Would be better if ::::

A) splitters are POLYLINES or LINES

B) Polyline doesn't change properties (color,layer,width...). (I Showed them with diffrerent color in examples ,

just to separate their view).

C) splitters automatically delete after code execution.

CADaSchtroumpf · ‎01-20-2021

Has the excellent ronjonp code which is exactly designed to meet your requests, it can be modified as well to execute requests A B C.
ronjonp might have a better suggestion.

(vl-load-com)
(defun c:foo (/ a b c e el l1 l2 n r s)
  ;; RJP » 2021-01-18
  ;; Splits a polyline with other polylines that share a common vertex
  (cond	((and (setq e (car (entsel "\nPick polyline to split: ")))
	      (= "LWPOLYLINE" (cdr (assoc 0 (setq el (entget e)))))
	      (not (vla-getboundingbox (vlax-ename->vla-object e) 'a 'b))
	      (mapcar 'set '(a b) (mapcar 'vlax-safearray->list (list a b)))
	      (setq s (ssdel e (ssget "_C" a b '((0 . "LWPOLYLINE,LINE")))))
	      (> (sslength s) 0)
	 )
	 (foreach p (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
	   (setq c (cons (vl-remove-if '(lambda (x) (and (/= 10 (car x)) (/= 11 (car x)))) (entget p)) c))
	 )
	 (setq c (mapcar '(lambda (x) (cons 10 (list (car x) (cadr x)))) (mapcar 'cdr (apply 'append c))))
	 (setq l1 (reverse (cdr (member (assoc 10 el) (reverse el)))))
	 (setq l1 (append (subst '(70 . 0) (assoc 70 l1) l1)))
	 (setq l2 (reverse (cdr (reverse (member (assoc 10 el) el)))))
	 (and (= 1 (logand 1 (cdr (assoc 70 el)))) (setq l2 (append l2 (list (assoc 10 el)))))
	 (foreach p l2
	   (if (vl-some '(lambda (x) (equal p x 1e-8)) c)
	     (progn (setq r (cons p r))
		    (entmake (append l1 (reverse r)))
		    (setq r (list p))
	     )
	     (setq r (cons p r))
	   )
	 )
	 (entmake (append l1 (reverse r)))
	 (repeat (setq n (sslength s)) (entdel (ssname s (setq n (1- n)))))
	 (entdel e)
	)
  )
  
  (princ)
)

ronjonp · ‎01-20-2021

@CADaSchtroumpf Looks good to me 🙂 .. I'd just change one line below ... but really both work. 🍻

(vl-load-com)
(defun c:foo (/ a b c e el l1 l2 n r s x)
  ;; RJP » 2021-01-18
  ;; Splits a polyline with other polylines that share a common vertex
  (cond	((and (setq e (car (entsel "\nPick polyline to split: ")))
	      (= "LWPOLYLINE" (cdr (assoc 0 (setq el (entget e)))))
	      (not (vla-getboundingbox (vlax-ename->vla-object e) 'a 'b))
	      (mapcar 'set '(a b) (mapcar 'vlax-safearray->list (list a b)))
	      (setq s (ssdel e (ssget "_C" a b '((0 . "LWPOLYLINE,LINE")))))
	      (> (sslength s) 0)
	 )
	 (foreach p (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
	   ;; (setq c (cons (vl-remove-if '(lambda (x) (and (/= 10 (car x)) (/= 11 (car x)))) (entget p)) c))
	   (setq c (cons (vl-remove-if-not '(lambda (x) (member (car x) '(10 11))) (entget p)) c))
	 )
	 (setq c (mapcar '(lambda (x) (cons 10 (list (car x) (cadr x)))) (mapcar 'cdr (apply 'append c))))
	 (setq l1 (reverse (cdr (member (assoc 10 el) (reverse el)))))
	 (setq l1 (append (subst '(70 . 0) (assoc 70 l1) l1)))
	 (setq l2 (reverse (cdr (reverse (member (assoc 10 el) el)))))
	 (and (= 1 (logand 1 (cdr (assoc 70 el)))) (setq l2 (append l2 (list (assoc 10 el)))))
	 (foreach p l2
	   (if (vl-some '(lambda (x) (equal p x 1e-8)) c)
	     (progn (setq r (cons p r)) (entmake (append l1 (reverse r))) (setq r (list p)))
	     (setq r (cons p r))
	   )
	 )
	 (entmake (append l1 (reverse r)))
	 (repeat (setq n (sslength s)) (entdel (ssname s (setq n (1- n)))))
	 (entdel e)
	)
  )
  (princ)
)

ronjonp · ‎01-20-2021

Actually a a few more edits ... **** the 30 minute rule 🤡

(defun c:foo (/ a b c e el l1 l2 n r s x)
  ;; RJP » 2021-01-20
  ;; Splits a polyline with other polylines that share a common vertex
  (cond	((and (setq e (car (entsel "\nPick polyline to split: ")))
	      (= "LWPOLYLINE" (cdr (assoc 0 (setq el (entget e)))))
	      (not (vla-getboundingbox (vlax-ename->vla-object e) 'a 'b))
	      (mapcar 'set '(a b) (mapcar 'vlax-safearray->list (list a b)))
	      (setq s (ssdel e (ssget "_C" a b '((0 . "LWPOLYLINE,LINE")))))
	      ;; Save 's' to list to delete later
	      (> (length (setq s (vl-remove-if 'listp (mapcar 'cadr (ssnamex s))))) 0)
	 )
	 (foreach p s (setq c (cons (vl-remove-if-not '(lambda (x) (member (car x) '(10 11))) (entget p)) c)))
	 (setq c (mapcar '(lambda (x) (cons 10 (list (car x) (cadr x)))) (mapcar 'cdr (apply 'append c))))
	 (setq l1 (reverse (cdr (member (assoc 10 el) (reverse el)))))
	 (setq l1 (subst '(70 . 0) (assoc 70 l1) l1))
	 (setq l2 (reverse (cdr (reverse (member (assoc 10 el) el)))))
	 (and (= 1 (logand 1 (cdr (assoc 70 el)))) (setq l2 (append l2 (list (assoc 10 el)))))
	 (foreach p l2
	   (if (vl-some '(lambda (x) (equal p x 1e-8)) c)
	     (progn (setq r (cons p r))
		    (entmake (append l1 (reverse r)))
		    (setq r (list p))
		    ;; Remove point from 'c' so it does not get looked at twice
		    (setq c (vl-remove p c))
	     )
	     (setq r (cons p r))
	   )
	 )
	 (entmake (append l1 (reverse r)))
	 ;; Delete all ( beware it will delete all items found within bounding
	 ;; box so further code is needed to delete only 'cutters' )
	 (mapcar 'entdel (cons e s))
	)
  )
  (princ)
)(vl-load-com)

Sea-Haven · ‎01-20-2021

To Ronjonp The 30 minute rule a pain end up with multiple code sets rather than 1 version. When will they update their forum. All the others let you do it. If you make a typo etc your broken code is still there.

ronjonp · ‎01-20-2021

@Sea-Haven wrote:
To Ronjonp The 30 minute rule a pain end up with multiple code sets rather than 1 version. When will they update their forum. All the others let you do it. If you make a typo etc your broken code is still there.

Yeah .. not sure who's moderating this place ( explicative HERE + a bonus 'DANG' ) but my original post was edited and the original was "daamn the 30 minute rule" which of daamn got removed. 🤣 WOW .. please PM me your identity so we can talk about this interesting censorship. Better yet reply to this post so we can see who is making the rules!

*EDIT -> auto correction of 'DAAMN' fixed to gain context.

GeryKnee · ‎01-21-2021

Yes, thats vary good.

Thank you very much.

Gery.

GeryKnee · ‎01-21-2021

Thanks for all ronjonp. Its better than what i thought about.

Regards,

Gery

ronjonp · ‎01-21-2021

@GeryKnee wrote:
Thanks for all ronjonp. Its better than what i thought about.
Regards,
Gery

Glad to help out .. it was fun to write and post 3 times. 🍻

GeryKnee · ‎01-23-2021

Hello ronjonp.
I come back to your code.
I Use a little different version that doesn't delete the "splitters"
(i discarded the line (mapcar 'entdel (cons e s)))
That's because often procceds many unwanted objects deletions.
The automatic deletion sould occure if splitters sould be selected
just only those create after the target polyline creation.
Maybe the use of object ID number sould help abut it.
If you have any idea about it sould be good to upgrade the code.
Regards,
Gery

CADaSchtroumpf · ‎01-25-2021

@GeryKnee a écrit :
Hello ronjonp.
just only those create after the target polyline creation.
Regards,
Gery

It's doable...

I take this opportunity to also improve 2 other points that have appeared in use.
1 - If Xdata are present, then reproduce them on the cut segments, currently they are lost.
2 - If used with (for me) Map or Civil (or other products which can use dictionaries) the procedure generates errors on the cut segments if dictionaries are used.
We can correct with _AUDIT, but it's not very clean ...

Note: For autocad Map, you can do the same as for XData, copy the Object Data, version not proposed here.

Here is the version of ronjonp still modified:

(vl-load-com)
(defun c:lw_split ( / a b c e el hndl xd_l l1 l2 n r s x)
  ;; RJP » 2021-01-20
  ;; Splits a polyline with other polylines that share a common vertex
  ;; modified by B.Valsecchi for keep Xdata and resolve dictionnary conflicts
  (cond	((and (setq e (car (entsel "\nPick polyline to split: ")))
	      (= "LWPOLYLINE" (cdr (assoc 0 (setq el (entget e (list "*"))))))
	      (setq hndl (cdr (assoc 5 el)))
	      (not (vla-getboundingbox (vlax-ename->vla-object e) 'a 'b))
	      (mapcar 'set '(a b) (mapcar 'vlax-safearray->list (list a b)))
	      (setq s (ssdel e (ssget "_C" a b '((0 . "LWPOLYLINE,LINE")))))
	      ;; Save 's' to list to delete later
	      (> (length (setq s (mapcar 'handent (vl-remove-if '(lambda (x) (< x hndl)) (mapcar '(lambda (x) (cdr (assoc 5 (entget x)))) (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))))))) 0)
	 )
	 (setq xd_l (assoc -3 el))
	 (foreach n el (if (member (car n) '(-1 5 102 330 360)) (setq el (vl-remove (assoc (car n) el) el))))
	 (foreach p s (setq c (cons (vl-remove-if-not '(lambda (x) (member (car x) '(10 11))) (entget p)) c)))
	 (setq c (mapcar '(lambda (x) (cons 10 (list (car x) (cadr x)))) (mapcar 'cdr (apply 'append c))))
	 (setq l1 (reverse (cdr (member (assoc 10 el) (reverse el)))))
	 (setq l1 (subst '(70 . 0) (assoc 70 l1) l1))
	 (setq l2 (reverse (cdr (reverse (member (assoc 10 el) el)))))
	 (and (= 1 (logand 1 (cdr (assoc 70 el)))) (setq l2 (append l2 (list (assoc 10 el)))))
	 (foreach p l2
	   (if (vl-some '(lambda (x) (equal p x 1e-8)) c)
	     (progn (setq r (cons p r))
		    (entmake (append l1 (reverse r) (if xd_l (list xd_l) '())))
		    (setq r (list p))
		    ;; Remove point from 'c' so it does not get looked at twice
		    (setq c (vl-remove p c))
	     )
	     (setq r (cons p r))
	   )
	 )
	 (entmake (append l1 (reverse r) (if xd_l (list xd_l) '())))
	 ;; Delete all ( beware it will delete all items found within bounding
	 ;; box so further code is needed to delete only 'cutters' )
	 (mapcar 'entdel (cons e s))
	)
  )
  (princ)
)

Community

polyline splitter autolisp command

polyline splitter autolisp command

polyline splitter autolisp command