LISP for breaking multiple polyline at 'insertion point' of multiple Blocks (AUTOCAD 2026)

[xenru]

I have multiple blocks(10 to 20) placed on multiple polylines in my map. I need to break the polylines of a huge map at the insertion point and join the vertices at the insertion point of the block.
Is there any LISP available to break the polylines exactly at the insertion point ?
I saw LEE MAC's LISP does something similar, but it trims the polylines at the border of the blocks. Shown in the picture (LEE MAC written)

[Tsuky]

Try this !? You can use POINT or Insert Point of block...

 

Break_Poly@point.lsp

Edited yesterday at 12:06 PM by Tsuky

[Saxlle]

Something like this!?

 

; *****************************************************************************************************
; Functions     :  PLBRJ
; Description   :  Breaking POLYLINE at blocks insertation points and joined into the one POLYLINE
; Author        :  Saxlle
; Date          :  January 19, 2026
; *****************************************************************************************************

(prompt "\nTo run a LISP type: PLBRJ")

(princ)

(defun c:PLBRJ ( / ent joinList ptlist ss len spt ept i breakPoint)
 
  (setq ent (car (entsel "\nSelect the POLYLINE:"))
	joinList (list)
	ptlist (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ent)))
	ss (ssget "_F" ptlist (list (cons 0 "INSERT")))
	len (sslength ss)
	spt (vlax-curve-getStartPoint (vlax-ename->vla-object ent))
	ept (vlax-curve-getEndPoint (vlax-ename->vla-object ent))
	joinList (append (list spt) joinList)
	i 0
	)
  
  (while (< i len)
    
    (setq breakPoint (cdr (assoc 10 (entget (ssname ss i)))))
    
    (command "_.BREAK" breakPoint "_f" breakPoint breakPoint)
    
    (setq joinList (append (list breakPoint) joinList))
    
    (setq i (1+ i))
    
    )
  
  (setq joinList (reverse (append (list ept) joinList))
	ss (ssget "_F" joinList (list (cons 0 "LWPOLYLINE")))
	)
  
  (command-s "_PEDIT" "m" ss "" "j" "" "")
  
  (prompt "\nThe POLYLINE was broken at blocks insert points and joined into the one POLYLINE!")
  
  (princ)
  
  )

 

Edited yesterday at 02:31 PM by Saxlle
Something strange is happening. Don't use it.

[BIGAL]

For me simplest and quickest is use a wipe out in the block, set to background then will auto obscure line underneath. Hopefully the result you want.

 

Edited 16 hours ago by BIGAL

[mhupp]

I Think they want this more for measurements of some type of conduit than for visual display. tho why not use lee mac's and just add whatever half or 3/4 of [SPLT] is.

maybe points? you could get that from the block.

 

@xenru need a little more detail on why you want this.

 

[ronjonp]

You could Lee's :PAddVertex function like so:

(defun c:foo (/ :paddvertex e lwp pts s)
  ;; Lee Mac's function
  (defun :paddvertex (e p / tan lm:lwvertices a b e h l n r w x z)
    (defun tan (x)
      (if (not (equal 0.0 (cos x) 1e-10))
	(/ (sin x) (cos x))
      )
    )
    (defun lm:lwvertices (e)
      (if (setq e (member (assoc 10 e) e))
	(cons (list (assoc 10 e) (assoc 40 e) (assoc 41 e) (assoc 42 e)) (lm:lwvertices (cdr e)))
      )
    )
    (if	(and p
	     e
	     (setq p (vlax-curve-getclosestpointto e (trans p 1 0))
		   n (vlax-curve-getparamatpoint e p)
	     )
	)
      (if (not (equal n (fix n) 1e-8))
	(progn (setq e (entget e)
		     h (reverse (member (assoc 39 e) (reverse e)))
		     l (lm:lwvertices e)
		     z (assoc 210 e)
	       )
	       (repeat (fix n)
		 (setq a (cons (car l) a)
		       l (cdr l)
		 )
	       )
	       (setq x (car l)
		     r (- n (fix n))
		     w (cdr (assoc 40 x))
		     w (+ w (* r (- (cdr (assoc 41 x)) w)))
		     b (atan (cdr (assoc 42 x)))
	       )
	       (entmod (append h
			       (apply 'append (reverse a))
			       (list (assoc 10 x) (assoc 40 x) (cons 41 w) (cons 42 (tan (* r b))))
			       (list (cons 10 (trans p 0 (cdr z)))
				     (cons 40 w)
				     (assoc 41 x)
				     (cons 42 (tan (* (- 1.0 r) b)))
			       )
			       (apply 'append (cdr l))
			       (list z)
		       )
	       )
	)
      )
    )
  )
  ;; RJP » 2026-01-20
  (cond	((setq s (ssget ":L" '((0 . "INSERT,LWPOLYLINE"))))
	 (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
	   (if (= "LWPOLYLINE" (cdr (assoc 0 (entget e))))
	     (setq lwp (cons e lwp))
	     (setq pts (cons (cdr (assoc 10 (entget e))) pts))
	   )
	 )
	 (and lwp
	      pts
	      (foreach e lwp
		(foreach pt pts
		  (and (equal 0. (distance pt (vlax-curve-getclosestpointto e pt)) 1e-4)
		       (:paddvertex e pt)
		  )
		)
	      )
	 )
	)
  )
  (princ)
)