Routine to delele all blocks outside closed polyline

[ELIANDEFI]

Good day everyone!

Could anyone help me find or create a routine to delete all blocks outside closed polyline.

PS.
Delete not trim.

Thank you in advance

[Tharwat]

Good day,

Create a selection set of all closed polylines to select all blocks insides each closed polyline then create a selection set of all existed blocks in current space.

The iterate through each block and check if it is already included within any of the selection set of the closed polylines, so if it is not there then delete it otherwise ignore it and continue.

[ELIANDEFI]

Hi Tharwat

Thanks for always accommodating my queries. Is there a LISP to select a closed polyline & it will automatically delete all blocks outside of it. I already have one for trimming but it doesn't works with blocks. Hope you could help on this. This will help me save a lot of time in my work. Thank you in advance.

[Tharwat]

Hi,

Give this a shot.

(defun c:Test (/ sel ent lst inc dis bks )
  ;;------------------------------------------------------------;;
  ;;	Author: Tharwat Al Choufi - Date: 31.Mar.2022		;;
  ;;	website: https://autolispprograms.wordpress.com		;;
  ;;------------------------------------------------------------;;
  (and (princ "\nSelect closed 2Dpolyline :")
       (or (setq sel (ssget "_+.:S:E" '((0 . "*POLYLINE") (-4 . "&=") (70 . 1))))
           (alert "Nothing selected or invalid object or polyline is not closed <!>")
           )
       (setq lst (vlax-curve-getdistatparam (setq ent (ssname sel 0)) (fix (vlax-curve-getendparam ent)))
             inc (/ lst 1000.)
             lst nil dis inc 
             )
       (repeat 1000
         (setq lst (cons (vlax-curve-getpointatdist ent inc) lst)
               inc (+ inc dis)
               )
         )
       (or (setq sel (ssget "_WP" lst '((0 . "INSERT"))))
           (alert "Nothing selected or invalid object or polyline is not closed <!>")
           )
       (setq bks (ssget "_X" (list '(0 . "INSERT") (cons 410 (getvar 'CTAB)))))
       (repeat (setq inc (sslength bks))
         (setq inc (1- inc)
               ent (ssname bks inc)
               )
         (or (ssmemb ent sel) (entdel ent))
         )
       )         
  (princ)
) (vl-load-com)

[ELIANDEFI]

Hi Tharwat,

As always, thank you so much.

This helps me a lot.

[Tharwat]

You're welcome anytime,