Delete text outside a closed polyline

[ktbjx]

 

here is a sample image of the 1570 DWG files i am working on

originally the have all polyline boxes, but i deleted the other boxes to see the ones i needed to retain clearer

so i was thinking, maybe if i could ask some help to delete all the texts visible outside the polyline boxes.

it would help me a lot. my eyes are hurting trying to check the ones im deleting manually... please help me

[fuccaro]

Here is a dirty one:

(defun c:pp()
  (setq ssP (ssget "X" (list '(0 . "LWPOLYLINE"))))
  (setq ssT (ssget "X" (list (cons 0 "*text"))))
  (setq ssD (ssadd))
  (repeat (setq i (sslength ssP))
    (setq p1 (entget (ssname ssp (setq i (1- i)))))
    (setq points nil)
    (repeat 4 (setq p (member (assoc 10 p1) p1) points (cons (car p) points) p1 (cdr p)))
    (setq x (mapcar 'cadr points) y (mapcar 'caddr points)
	  x1 (eval (cons 'min x)) x2 (eval (cons 'max x))
	  y1 (eval (cons 'min y)) y2 (eval (cons 'max y)))
    (setq j (sslength ssT))
    (repeat j 
      (setq t1 (ssname ssT (setq j (1- j)))
	    ins (cdr (assoc 10 (entget t1)))
	    xt (car ins) yt (cadr ins))
      (setq inside (and (< x1 xt) (> x2 xt) (< y1 yt) (> y2 yt)))
      (if inside (ssadd t1 ssD))
      )
    )
  )

It should place all the texts found inside rectangles in a new selection set called ssD. So run the program, then start an AutoCAD command (say Move or Delete) and when you are prompted to select the objects, type !ssd

Hope it works for you.

 

***** editing******

This will select all your texts inside rectangles. Sorry for that. Maybe you could use my program to select the texts to remain, move them on a hidden layer and delete the remaining ones... Sorry, I have no more time to rewrite the Lisp!

[Jonathan Handojo]

This one is very slow if there's heaps of data, but works. I won't recommend doing over 1000 objects or it will lag. Perhaps there's a better way to my approach.

 

;; Get Inside Angle  -  Lee Mac
;; Returns the smaller angle subtended by three points with vertex at p2
 
(defun LM:GetInsideAngle ( p1 p2 p3 )
    (   (lambda ( a ) (min a (- (+ pi pi) a)))
        (rem (+ pi pi (- (angle p2 p1) (angle p2 p3))) (+ pi pi))
    )
)

(defun JH:selset-to-list (selset / lst iter) ; Returns all entities within a selection set into a list.
  (setq iter 0)
  (repeat (sslength selset)
    (setq lst (cons (ssname selset iter) lst)
	  iter (1+ iter))
    )
  (reverse lst)
  )

(defun c:deloutside ( / *error* acadobj activeundo adoc anypt InsidePolygon InsideTriange minpt mmaxpt msp plpt px ss sslst sspl sstx txpt)
  (defun *error* ( msg )
    (vla-EndUndoMark adoc)
    (if (not (wcmatch (strcase msg T) "*break*,*cancel*,*exit*"))
      (princ (strcat "Error: " msg))
      )
    )

  (defun InsideTriange (p1 p2 p3 px)	; Returns T if px lies inside the triangle bound by p1, p2, and p3
    (or
      (vl-some '(lambda (x) (equal x px 1e-4)) (list p1 p2 p3))
      (equal (apply '+
		    (mapcar '(lambda (x y) (LM:GetInsideAngle x px y))
			    (list p1 p2 p3)
			    (list p2 p3 p1)
			    )
		    )
	     (* 2 pi)
	     1e-4
	     )
      )
    )

  (defun InsidePolygon (lst px / anypt othpt)	; Returns T is px lies inside the polygon bound by the list of points lst
    (setq anypt (car lst)
	  othpt (cdr lst)
	  )
    (or
      (vl-some
	'(lambda (x)
	   (equal x px 1e-4)
	   )
	lst
	)
      (=
	(rem
	  (length
	    (vl-remove nil
	      (mapcar '(lambda (x y) (InsideTriange anypt x y px))
		      (reverse (cdr (reverse othpt)))
		      (cdr othpt)
		      )
	      )
	    )
	  2
	  )
	1
	)
      )
    )

  (setq acadobj (vlax-get-acad-object)
        adoc (vla-get-ActiveDocument acadobj)
        msp (vla-get-ModelSpace adoc)
        activeundo nil)
  (if (= 0 (logand 8 (getvar "UNDOCTL"))) (vla-StartUndoMark adoc) (setq activeundo T))

  (if (setq ss (ssget '((0 . "*POLYLINE,TEXT,MTEXT"))))
    (progn
      (setq sspl (vl-remove-if-not '(lambda (x) (wcmatch (cdr (assoc 0 (entget x))) "*POLYLINE")) (setq sslst (JH:selset-to-list ss)))
	    sstx (vl-remove-if-not '(lambda (x) (wcmatch (cdr (assoc 0 (entget x))) "*TEXT")) sslst)
	    plpt (mapcar '(lambda (x)
			    (mapcar 'cdr (vl-remove-if-not '(lambda (y) (eq (car y) 10)) (entget x)))
			    )
			 sspl
			 )
	    txpt (mapcar '(lambda (x / minpt maxpt)
			    (vla-GetBoundingBox (vlax-ename->vla-object x) 'minpt 'maxpt)
			    (list
			      x
			      (safearray-value minpt)
			      (safearray-value maxpt)
			      )
			    )
			 sstx
			 )
	    )
      (mapcar '(lambda (x)
		 (if
		   (null
		     (vl-some
		       '(lambda (y)
			  (and
			    (InsidePolygon y (cadr x))
			    )
			  )
		       plpt
		       )
		     )
		   (entdel (car x))
		   )
		 )
	      txpt
	      )
      )
    )
  (if activeundo nil (vla-EndUndoMark adoc))
  (princ)
  )

 

[Tharwat]

Hi,

Give this shot and let me know.

(defun c:Test (/ sel int ent get inc ins txt lst)
  ;;------------------------------------;;
  ;; Author : Tharwat Al Shoufi		;;
  ;; Date   : 19.March.2020		;;
  ;; Delete texts that reside outside	;;
  ;; selected lwpolylines.		;;
  ;;------------------------------------;;
  (and (princ "\nSelect Texts and polylines that surronds texts : "
       )
       (setq sel (ssget "_:L" '((0 . "LWPOLYLINE,*TEXT"))))
       (repeat (setq int (sslength sel))
	 (setq int (1- int)
	       ent (ssname sel int)
	       get (entget ent)
	 )
	 (if (= (cdr (assoc 0 get)) "LWPOLYLINE")
	   (and	(setq inc -1
		      ins (ssget
			    "_WP"
			    (mapcar
			      'cdr
			      (vl-remove-if-not '(lambda (p) (= (car p) 10)) get)
			    )
			    '((0 . "*TEXT"))
			  )
		)
		(while (setq inc (1+ inc)
			     ent (ssname ins inc)
		       )
		  (setq txt (cons ent txt))
		)
	   )
	   (setq lst (cons ent lst))
	 )
       )
       (and txt
	    lst
	    (foreach itm lst (or (member itm txt) (entdel itm)))
       )
  )
  (princ)
)

 

[ktbjx]

thank you so much!

i tried the 3 routines,

the first 2 made my computer hangs, and it takes too long.

just like @Jonathan Handojo said. its not very effective on too much texts and polylines..

but @Tharwat routine is a bit faster. though it still takes time but atleast way lesser time than the previous routines. 

thank you so much. this will cut my workload and increase my productivity

[Jonathan Handojo]

12 hours ago, Tharwat said:

(foreach itm lst (or (member itm txt) (entdel itm)))

 

I recommend changing this to vl-position. I've seen a search where  vl-position is at least  three times faster than member.

[Tharwat]

7 hours ago, ktbjx said:

but @Tharwat routine is a bit faster. though it still takes time but atleast way lesser time than the previous routines. 

thank you so much. this will cut my workload and increase my productivity

 

You're welcome.  

[ronjonp]

Late to the party but here's another:

(defun c:foo (/ _ss2l el p s1 s2)
  (defun _ss2l (s)
    (if	s
      (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
    )
  )
  (cond	((setq s1 (ssget "_:L" '((0 . "LWPOLYLINE,*TEXT"))))
	 (foreach e (setq s2 (_ss2l s1))
	   (cond ((= (cdr (assoc 0 (setq el (entget e)))) "LWPOLYLINE")
		  (setq p (mapcar 'cdr (vl-remove-if '(lambda (p) (/= (car p) 10)) el)))
		  (ssdel e s1)
		  (foreach x (_ss2l (ssget "_WP" p '((0 . "*TEXT")))) (ssdel x s1))
		 )
	   )
	 )
	 (mapcar 'entdel (_ss2l s1))
	)
  )
  (princ)
)