Select multiple polylines and break them at the vertices

[aridzv]

Hi.

I need to select multiple polylines and break each one of them at their vertices.

 

I use this line of code to get just the polylines from a selection set and put them in a list:

(setq ss (ssget  '((0 . "*POLYLINE"))))

 

and I found this lisp that break a polyline at its vertices in this topic:

 

;;; Break pline @ vertices LPS 2010-04-01
(defun c:test (/ idx obj endparam ptlst)
(vl-load-com)
(setq temperr *error*)            
(setq *error* errortrap)
(setq obj (vlax-ename->vla-object (car (setq ent (entsel "\nSelect polyline: ")))) )
 (if ; test if polyline
   (/= (vlax-get-property obj 'ObjectName) "AcDbPolyline")
      (princ "\nSelected entity is not a polyline")
   )
 (setq ptlst (list (vlax-curve-getStartPoint obj))
   idx 1)
 (if (zerop (vlax-get obj 'Closed))
       (setq endparam (vlax-curve-getParamAtPoint obj (vlax-curve-getEndPoint obj)));if open param at end point
   (setq endparam (cdr (assoc 90 (entget (vlax-vla-object->ename obj)))));if closed # vertices
   )
  (while
   (<= idx endparam)
     (setq ptlst (cons (vlax-curve-getPointAtParam obj idx) ptlst)
    idx (1+ idx)
    )
  )
 (mapcar (function (lambda (x) (vl-cmdf "break" ent "f" x "@"))) ptlst)
  (princ)
 );defun

(defun errortrap (msg)
  (if (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n<< Error: " msg " >>")))
 (setq *error* temperr)
(princ)
)

I need help putting this list into a loop that will go through each polyline in the list and break it at its vertices using the Break pline @ vertices LPS from the topic in the link I have attached above.

 

thanks,

aridzv

 

* I need to keep those segments as polylines - that is why I don't explode them...

Edited August 31, 2022 by aridzv

[ronjonp]

Give this a try:

(defun c:foo (/ a b el h pts s)
  ;; RJP » 2022-08-31
  ;; Explode LWPOLYLINES and keep segment widths
  (if (setq s (ssget ":L" '((0 . "LWPOLYLINE"))))
    (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
      (setq h (assoc 10 (setq el (entget e '("*")))))
      (setq h (vl-remove (assoc 70 el) (reverse (cdr (member h (reverse el))))))
      (setq pts (vl-remove-if-not '(lambda (x) (member (car x) '(10 40 41 42 91))) el))
      (if (vlax-curve-isclosed e)
	(setq pts (append pts (mapcar '(lambda (r j) r) pts '(0 0 0 0 0))))
      )
      (while (> (length pts) 5)
	(entmakex
	  (append h (mapcar '(lambda (r j) r) pts '(0 0 0 0 0 0 0 0 0 0)) (list (assoc 210 el)))
	)
	(setq pts (cdddr pts))
	(setq pts (cddr pts))
      )
      (entdel e)
    )
  )
  (princ)
)

 

Edited August 31, 2022 by ronjonp

[aridzv]

@ronjonp

PERFECT - Thanks!!

aridzv

[ronjonp]

1 minute ago, aridzv said:

@ronjonp

PERFECT - Thanks!!

aridzv

[Steven P]

Just beaten to it in the time it took me to log in....

 

A slightly difffernt method here - there are many ay to do many things. I was going to suggest making 2 routines, keeping one for breaking a single polyline and another to do a loop hrough the selection set (sometimes this is good that you can use the main code for many things)

 

The loop:

(defun c:test ( / ss acount )
  (setq acount 0) ;; a counter
  (setq ss (ssget  '((0 . "*POLYLINE")))) ;;select poylines
  (while (< acount (sslength ss))
    (test (ssname ss acount)) ;;call functon 'test'
    (setq acount (+ acount 1))
  ) ;; end while
)

 

 

and then modifyng your c:test above,

 

;;; Break pline @ vertices LPS 2010-04-01
;;;(defun c:test (/ idx obj endparam ptlst)
(defun test ( myent / idx obj endparam ptlst)
  (vl-load-com)
  (setq temperr *error*)
  (setq *error* errortrap)
;;;;(setq obj (vlax-ename->vla-object (car (setq ent (entsel "\nSelect polyline: ")))) )
  (setq obj (vlax-ename->vla-object (setq ent myent)) )
  (if (/= (vlax-get-property obj 'ObjectName) "AcDbPolyline")
    (princ "\nSelected entity is not a polyline")
  ) ;;end if
  (setq ptlst (list (vlax-curve-getStartPoint obj))
        idx 1
  )
  (if (zerop (vlax-get obj 'Closed))
    (setq endparam (vlax-curve-getParamAtPoint obj (vlax-curve-getEndPoint obj)));if open param at end point
    (setq endparam (cdr (assoc 90 (entget (vlax-vla-object->ename obj)))));if closed # vertices
  ) ;;end if
  (while (<= idx endparam)
    (setq ptlst (cons (vlax-curve-getPointAtParam obj idx) ptlst)
          idx (1+ idx)
    )
  ) ;;end while
;;;;  (mapcar (function (lambda (x) (vl-cmdf "break" ent "f" x "@"))) ptlst)
  (mapcar (function (lambda (x) (vl-cmdf "break" (vlax-curve-getStartPoint obj) "f" x "@"))) ptlst)
) ;; end defun

(defun errortrap (msg)
  (if (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
    (princ (strcat "\n<< Error: " msg " >>"))
  ) ;;end if
  (setq *error* temperr)
  (princ)
)

 

 

or something like this - evening here so CAD is off, didn't test this

Edited September 1, 2022 by Steven P
Corrected typo and corrected code

[aridzv]

@Steven P

Thanks for the reply!

I've run your code in one lsp file like this:

(defun c:test ( / ss acount )
  (setq acount 0) ;; a counter
  (setq ss (ssget  '((0 . "*POLYLINE")))) ;;select poylines
  (while (< acount (sslength ss))
    (test (ssname ss acount)) ;;call functon 'test'
    (setq acount (+ acount 1))
  ) ;; end while
)

;;; Break pline @ vertices LPS 2010-04-01
;;;(defun c:test (/ idx obj endparam ptlst)

(defun test ( myent / idx obj endparam ptlst)

(vl-load-com)
(setq temperr *error*)            
(setq *error* errortrap)
;;;;(setq obj (vlax-ename->vla-object (car (setq ent (entsel "\nSelect polyline: ")))) )

(setq obj (vlax-ename->vla-object (car (setq ent myent))) )

(if ; test if polyline
   (/= (vlax-get-property obj 'ObjectName) "AcDbPolyline")
      (princ "\nSelected entity is not a polyline")
   )
 (setq ptlst (list (vlax-curve-getStartPoint obj))
   idx 1)
 (if (zerop (vlax-get obj 'Closed))
       (setq endparam (vlax-curve-getParamAtPoint obj (vlax-curve-getEndPoint obj)));if open param at end point
   (setq endparam (cdr (assoc 90 (entget (vlax-vla-object->ename obj)))));if closed # vertices
   )
  (while
   (<= idx endparam)
     (setq ptlst (cons (vlax-curve-getPointAtParam obj idx) ptlst)
    idx (1+ idx)
    )
  )
 (mapcar (function (lambda (x) (vl-cmdf "break" ent "f" x "@"))) ptlst)
  (princ)
 );defun

(defun errortrap (msg)
  (if (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n<< Error: " msg " >>")))
 (setq *error* temperr)
(princ)
)

 

*EDIT: the code in c:test had a small typing error - "(setw acount 0)", I fixed it to "(setq acount 0)"....

 

I get this error:

; ----- LISP : Call Stack -----
; [0]...C:TEST
; [1].....TEST <<--
;
; ----- Error around expression -----
; (AL-ENAME2OBJ ENAME)
; in file : 
; C:\Temp\Break_pline_By_vertices4.lsp

 

I can't find why,

and my lisp writing skills are not at a sufficient level to solve the problem....

 

8 hours ago, Steven P said:

.... evening here so CAD is off, didn't test this

no worries,tomorrow is a new day

and Thanks anyway for the answer!!

 

aridzv

Edited September 1, 2022 by aridzv

[Steven P]

10 hours ago, aridzv said:

@Steven P

Thanks for the reply!

I've run your code in one lsp file like this:

*EDIT: the code in c:test had a small typing error - "(setw acount 0)", I fixed it to "(setq acount 0)"....

 

I get this error:

; ----- LISP : Call Stack -----
; [0]...C:TEST
; [1].....TEST <<--
;
; ----- Error around expression -----
; (AL-ENAME2OBJ ENAME)
; in file : 
; C:\Temp\Break_pline_By_vertices4.lsp

 

I can't find why,

and my lisp writing skills are not at a sufficient level to solve the problem....

 

no worries,tomorrow is a new day

and Thanks anyway for the answer!!

 

aridzv

 

 

Suspect there might be a couple of errors in there - was writing it on the laptop watching the TV and didn't have CAD running to check - I'll check and update the code above for you

 

....edited code above, couple of small errors,

 

Edited September 1, 2022 by Steven P