Topic: [SOLVED] Delete Blocks with no Text Near Them

[blahdc]

Okay this is a long shot but I know there are some smart people on these boards 


I have a drawing with hundreds of blocks on one layer. Some of the blocks have text near them, all of the text is on its own layer. Is there a easy way to delete all of the blocks which are not located within 600 feet of any text?

Example attached. My goal would be to delete the middle symbol from the drawing.

[JohnK]

FYI: Your post may not have enough information to solicit the best reply. -e.g. Are the symbols: blocks, polylines, etc. and what distance were you thinking would be the max. If you provided a little more information or restructured your question a little more, I am sure someone will/would have an answer for you very quickly.

[blahdc]

Sorry, I updated the original thread with more details and possibly a simpler solution.

[ronjonp]

Ok I'll bite  :

Code: [Select]

(defun c:test (/ d text)
  (defun 2ddxf10 (e / p) (setq p (cdr (assoc 10 (entget e)))) (list (car p) (cadr p)))
  (defun ss2lst (ss / e n out)
    (setq n -1)
    (if ss
      (while (setq e (ssname ss (setq n (1+ n)))) (setq out (cons e out)))
    )
  )
  (and ;;Set your distance here
       (setq d (getdist "\Enter distance to check: "))
       (setq text (ss2lst (ssget "x" '((0 . "text,mtext")))))
       (foreach blk (ss2lst (ssget '((0 . "insert"))))
(if
   (>= (car (vl-sort (mapcar '(lambda (x) (distance (2ddxf10 blk) (2ddxf10 x))) text) '<)) d)
    (entdel blk)
)
       )
  )
  (princ)
)

[blahdc]

 

Okay so I loaded it up but it seems to be deleting all of the blocks, i bumped my distance up a lot but it didn't change anything.  I'm looking up what you used in your code, I'm thinking it might be in here..... but I have no idea.

Code: [Select]

       (setq text (ss2lst (ssget "x" '((0 . "text,mtext")))))
       (foreach blk (ss2lst (ssget '((0 . "insert"))))
(if (>= (car (vl-sort (mapcar '(lambda (x) (distance (dxf10 blk) (dxf10 x))) text) '<)) d)
    (entdel blk)
)
       )

 I will keep playing around with it. Thank you very much for the start!

 

[CAB]

My version.
Note that I too use insertion points to compare for distances but a bounding box method may be more desirable.

Code: [Select]

;;  limited to Current Space Only (cons 410 (getvar "ctab"))
(defun c:delblk (/ dist ss blks txts)
  (setq dist 600) ; ***  distance is from insert point to insert point ***
  (if
    (and
      (setq ss (ssget "_X" (list '(0 . "insert") (cons 410 (getvar "ctab")))))
      (setq i -1)
      (while (setq ename (ssname ss (setq i (1+ i))))
        (setq blks (cons (list ename (cdr (assoc 10 (entget ename)))) blks))
      )
      (setq ss (ssget "_X" (list '(0 . "text,mtext") (cons 410 (getvar "ctab")))))
      (setq i -1)
      (while (setq ename (ssname ss (setq i (1+ i))))
        (setq txts (cons (list ename (cdr (assoc 10 (entget ename)))) txts))
      )
    )
    ;;  Got Blocks & Text so test the distance form insert points
    (while (setq blk (car blks))
      (setq blks (cdr blks))
      (if (not (vl-some (function (lambda(txt) (< (distance (cadr blk)(cadr txt)) dist) )) txts))
        (entdel (car blk))
      )
    )
  )
  (princ)
)

[ronjonp]

Okay so I loaded it up but it seems to be deleting all of the blocks, i bumped my distance up a lot but it didn't change anything.  I'm looking up what you used in your code, I'm thinking it might be in here..... but I have no idea.

Code: [Select]

       (setq text (ss2lst (ssget "x" '((0 . "text,mtext")))))
       (foreach blk (ss2lst (ssget '((0 . "insert"))))
(if (>= (car (vl-sort (mapcar '(lambda (x) (distance (dxf10 blk) (dxf10 x))) text) '<)) d)
    (entdel blk)
)
       )

 I will keep playing around with it. Thank you very much for the start!

Can you post the drawing you're testing on?

[blahdc]

Ug I am so dumb! Some of the blocks had an elevation assigned to them, no wonder it was deleting most of them. I got both lisps to work. I can not thank you enough!! I need to start learning how to code AutoLISP.

Thank you thank you thank you!!

Problem #2 See Below

[ronjonp]

Glad you got it figured out 

[blahdc]

Ug ok sorry to bug you guys again. I thought that I could assign all of my blocks a zero elevation, but apparently I need to keep that for a future drawing.

So question 2... would it be possilbe to disregard any Z elevation that the blocks may have. Just use a 2-D distance?

[ronjonp]

Gimme a sec. Updated the code above to ignore Z values.

[JohnK]

Sorry, I updated the original thread with more details and possibly a simpler solution.

I am glad to see that you apparently got the help you wanted. That's great.

[blahdc]

Gimme a sec. Updated the code above to ignore Z values.

Works Perfect! Thank you ronjonp and CAB for helping out.

[CAB]

For 2D distance:

Code: [Select]

;;  limited to Current Space Only (cons 410 (getvar "ctab"))
(defun c:delblk (/ dist ss blks txts ename i pt)
  (setq dist 600) ; *** 2D distance is from insert point to insert point ***
  (if
    (and
      (setq ss (ssget "_X" (list '(0 . "insert") (cons 410 (getvar "ctab")))))
      (setq i -1)
      (while (setq ename (ssname ss (setq i (1+ i))))
        (setq pt (cdr (assoc 10 (entget ename))) blks (cons (list ename (list (car pt)(cadr pt)) blks))
      )
      (setq ss (ssget "_X" (list '(0 . "text,mtext") (cons 410 (getvar "ctab")))))
      (setq i -1)
      (while (setq ename (ssname ss (setq i (1+ i))))
        (setq txts (cons (list ename (cdr (assoc 10 (entget ename)))) txts))
      )
    )
    ;;  Got Blocks & Text so test the distance form insert points
    (while (setq blk (car blks))
      (setq blks (cdr blks))
      (if (not (vl-some (function (lambda(txt) (< (distance (cadr blk)(cadr txt)) dist) )) txts))
        (entdel (car blk))
      )
    )
  )
  (princ)
)

[jaydee]

Hi.
I read this thread which spark another similar idear that might be able to take advantage of if it could be done.

When im doing drawing layout stuff, occasionally i cad or see things in pairs (same blocks in pairs )

My idea is, it would be great if i could select all the of blocks, but i only want the block either on the right side, or left side, or above or below be put into a selection set.

-Block to block in each pair ~2 feet apart. (user input max distant)
-Every pair of blocks many feet apart (this is not relevant)

Another idea
Tunnel lighting (thousands of lights in one direction)
What i would like is be able to select ie. every fourth light or every fifth light (user define) to put into a selection to manipulate their layer and change it to an emergency light


Thanks

[CAB]

Yes it can be done.
in order to refine the process a set of rules must be developed to guide the routine to make the correct selections.

[Lee Mac]

CAB, Ronjonp,

Your programs may have problems if the Text has justification other than 'Left' or if any of the objects are drawn in a plane not parallel to the WCS plane.

This could be another way to approach it:

Code: [Select]

(defun c:test ( / di en in ls p1 pt s1 s2 tl )

    (setq di 600.0)

    (if
        (and
            (setq s1 (ssget "_X" (list '(0 . "TEXT,MTEXT") (cons 410 (getvar 'CTAB)))))
            (setq s2 (ssget "_X" (list '(0 . "INSERT")     (cons 410 (getvar 'CTAB)))))
        )
        (progn
            (repeat (setq in (sslength s1))
                (setq en (entget (ssname s1 (setq in (1- in)))))
                (setq pt
                    (cdr
                        (assoc
                            (if
                                (or (eq "MTEXT" (cdr (assoc 0 en)))
                                    (and
                                        (zerop (cdr (assoc 72 en)))
                                        (zerop (cdr (assoc 73 en)))
                                    )
                                )
                                10 11
                            )
                            en
                        )
                    )
                )
                (if (eq "TEXT" (cdr (assoc 0 en)))
                    (setq pt (trans pt (cdr (assoc -1 en)) 0))
                )
                (setq tl (cons (list (car pt) (cadr pt)) tl))
            )
            (repeat (setq in (sslength s2))
                (setq en (ssname s2 (setq in (1- in)))
                      pt (trans (cdr (assoc 10 (entget en))) en 0)
                      pt (list (car pt) (cadr pt))
                      ls tl
                )
                (while (and (setq p1 (car ls)) (not (<= (distance pt p1) di)))
                    (setq ls (cdr ls))
                )
                (if (null ls) (entdel en))
            )
        )
    )
    (princ)
)
The while loop could be replaced with a vl-some / vl-every, but I didn't want to use Visual for the sake of one function...

[ronjonp]

Nice solution Lee 

[Lee Mac]

Nice solution Lee 

Thanks Ron 

[CAB]

CAB, Ronjonp,

Your programs may have problems if the Text has justification other than 'Left' or if any of the objects are drawn in a plane not parallel to the WCS plane.

No attempt was made to make it other than WCS, but I thought dxf 10 was never an obscure point. Therefore the "close enough' applied. After all without using a bounding box using dxf 11 can still be off.