Author Topic: [SOLVED] Delete Blocks with no Text Near Them  (Read 5053 times)

0 Members and 1 Guest are viewing this topic.

blahdc

  • Guest
[SOLVED] Delete Blocks with no Text Near Them
« on: September 15, 2011, 10:33:52 PM »
Okay this is a long shot but I know there are some smart people on these boards  :-D


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.
« Last Edit: September 16, 2011, 04:25:52 PM by blahdc »

JohnK

  • Administrator
  • Seagull
  • Posts: 10651
Re: Delete Text near Entity
« Reply #1 on: September 15, 2011, 11:20:55 PM »
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.
TheSwamp.org (serving the CAD community since 2003)
Member location map - Add yourself

Donate to TheSwamp.org

blahdc

  • Guest
Re: Delete Text near Entity
« Reply #2 on: September 16, 2011, 09:14:02 AM »
Sorry, I updated the original thread with more details and possibly a simpler solution.
« Last Edit: September 16, 2011, 09:19:51 AM by blahdc »

ronjonp

  • Needs a day job
  • Posts: 7529
Re: Delete Blocks with no Text Near Them
« Reply #3 on: September 16, 2011, 01:16:57 PM »
Ok I'll bite  :-P:

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)
)
« Last Edit: September 16, 2011, 04:01:23 PM by ronjonp »

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC

blahdc

  • Guest
Re: Delete Blocks with no Text Near Them
« Reply #4 on: September 16, 2011, 02:02:33 PM »
 :-o

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

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: Delete Blocks with no Text Near Them
« Reply #5 on: September 16, 2011, 02:53:15 PM »
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)
)
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

ronjonp

  • Needs a day job
  • Posts: 7529
Re: Delete Blocks with no Text Near Them
« Reply #6 on: September 16, 2011, 03:10:02 PM »
:-o

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?

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC

blahdc

  • Guest
Re: Delete Blocks with no Text Near Them
« Reply #7 on: September 16, 2011, 03:12:06 PM »
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
« Last Edit: September 16, 2011, 03:55:13 PM by blahdc »

ronjonp

  • Needs a day job
  • Posts: 7529
Re: [SOLVED] Delete Blocks with no Text Near Them
« Reply #8 on: September 16, 2011, 03:35:36 PM »
Glad you got it figured out  :lol:

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC

blahdc

  • Guest
Re: Delete Blocks with no Text Near Them
« Reply #9 on: September 16, 2011, 03:52:10 PM »
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

  • Needs a day job
  • Posts: 7529
Re: Delete Blocks with no Text Near Them
« Reply #10 on: September 16, 2011, 03:58:58 PM »
Gimme a sec. Updated the code above to ignore Z values.

Windows 11 x64 - AutoCAD /C3D 2023

Custom Build PC

JohnK

  • Administrator
  • Seagull
  • Posts: 10651
Re: Delete Text near Entity
« Reply #11 on: September 16, 2011, 04:08:18 PM »
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.
TheSwamp.org (serving the CAD community since 2003)
Member location map - Add yourself

Donate to TheSwamp.org

blahdc

  • Guest
Re: Delete Blocks with no Text Near Them
« Reply #12 on: September 16, 2011, 04:25:25 PM »
Gimme a sec. Updated the code above to ignore Z values.

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

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Re: [SOLVED] Delete Blocks with no Text Near Them
« Reply #13 on: September 16, 2011, 06:39:53 PM »
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)
)
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

jaydee

  • Guest
Re: [SOLVED] Delete Blocks with no Text Near Them
« Reply #14 on: September 16, 2011, 09:49:17 PM »
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
« Last Edit: September 16, 2011, 09:57:07 PM by jaydee »