Divide polyline at each vertex

[Angelswing91]

Hi all, anybody knows the way how i can divide a polyline at eatch vertex (into polylines)?
I've searched a lisp, but all i found are not working properly.. 😞

[Kent1Cooper]

Try PolylineSubDivide.lsp, with its PSD command, >here<.

[Kent1Cooper]

I noticed some archaisms about that -- here's an updated version, without the problem of (command) functions in the *error* handler [they were not problematic back then], and a few other little improvements.

[CADaSchtroumpf]

You can try also this!

It work's only for LWPOLYLINE, but if you have xdata or/and OD (if you have Object Data with Map or Civil), this keep the data for the subdivise. It don't use command break.

(defun c:break_lw@vtx_withOD ( / js i ent dxf_obj xd_l dxf_43 dxf_38 dxf_39 dxf_10 dxf_40 dxf_41 dxf_42 dxf_39 dxf_210 n lst_data nwent tbldef )
  (initget "Toutes Sélection _All Select")
  (if (eq (getkword "\nLWPolylignes à couper à chaque sommets? [Toutes/Sélection] <Sélection>: ") "All")
    (setq
      js
        (ssget "_X" 
          (list
            (cons 0 "LWPOLYLINE")
            (cons 67 (if (eq (getvar "CVPORT") 2) 0 1))
            (cons 410 (if (eq (getvar "CVPORT") 2) "Model" (getvar "CTAB")))
          )
        )
      i -1
    )
    (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")))
          )
        )
      i -1
    )
  )
  (cond
    (js
      (repeat (sslength js)
        (setq
          dxf_obj (entget (setq ent (ssname js (setq i (1+ i)))) (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)))
            n (cdr (assoc 90 dxf_obj))
          )
          (setq n (1- (cdr (assoc 90 dxf_obj))))
        )
        (repeat n
          (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 2)
                (cons 70 (boole 1 (cdr (assoc 70 dxf_obj)) 128))
                (cons 38 dxf_38)
                (cons 39 dxf_39)
                (cons 10 (car dxf_10))
                (cons 40 (car dxf_40))
                (cons 41 (car dxf_41))
                (cons 42 (car dxf_42))
                (cons 10 (cadr dxf_10))
                (cons 40 (cadr dxf_40))
                (cons 41 (cadr dxf_41))
                (cons 42 (cadr dxf_42))
                (assoc 210 dxf_obj)
              )
              (if xd_l (list xd_l) '())
            )
          )
          (setq dxf_10 (cdr dxf_10) dxf_40 (cdr dxf_40) dxf_41 (cdr dxf_41) dxf_42 (cdr dxf_42) 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) à ses sommets avec ses Object Datas.")
    )
  )
  (prin1)
)

[ronjonp]

Here's another for fun. Could be tidied up a bit since I didn't do any checks for closed polylines.

(defun c:foo (/ a b c el h j n p r s)
  ;; RJP » 2020-06-23
  (setq a '(40 41 42 91))
  (if (setq s (ssget ":L" '((0 . "lwpolyline"))))
    (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
      (setq p (vl-remove-if '(lambda (x) (/= 10 (car x))) (setq el (entget e))))
      (setq h (reverse (cdr (member (assoc 10 el) (reverse el)))))
      (setq n 0)
      (foreach v (mapcar '(lambda (r j) (list r j)) p (cdr p))
	(setq r (member (car v) el))
	(setq j (member (cadr v) el))
	(setq b	(append	(cons (car r) (mapcar '(lambda (c) (assoc c r)) a))
			(cons (car j) (mapcar '(lambda (c) (assoc c j)) a))
		)
	)
	(and (> (1+ n) 255) (setq n 0))
	;; Remove (cons 62 (setq n (1+ n))) below if you don't want the colored segments
	(entmakex (append h b (list (cons 62 (setq n (1+ n))) (assoc 210 el))))
      )
      (entdel e)
    )
  )
  (princ)
)

[ronjonp]

Here's another version that checks for closed plines and should retain xdata.

(defun c:foo (/ a c d el f g h j n p r s)
  ;; RJP » 2020-06-24
  ;; Splits a selection of polylines into individual polyline segments
  (setq a '(40 41 42 91))
  (if (setq s (ssget ":L" '((0 . "lwpolyline"))))
    (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
      (setq p (vl-remove-if '(lambda (x) (/= 10 (car x))) (setq el (entget e '("*")))))
      (setq h (reverse (cdr (member (assoc 10 el) (reverse el)))))
      (setq f (member (assoc 210 el) el))
      (if (= 1 (setq d (logand 1 (setq g (cdr (assoc 70 el))))))
	(setq p (append p (list (car p))))
      )
      (setq n 0)
      (foreach v (mapcar '(lambda (r j) (list r j)) p (cdr p))
	(setq r (member (car v) el))
	(setq j (member (cadr v) el))
	(and (> (1+ n) 255) (setq n 0))
	;; Remove (cons 62 (setq n (1+ n))) below if you don't want the colored segments
	(entmakex (append h
			  (cons (car r) (mapcar '(lambda (c) (assoc c r)) a))
			  (cons (car j) (mapcar '(lambda (c) (assoc c j)) a))
			  (list (cons 62 (setq n (1+ n))) (cons 70 (- g d)))
			  f
		  )
	)
      )
      (entdel e)
    )
  )
  (princ)
)