Replace Blocks with points

Dear All,

I have a drawing that has almost 36000 blocks at the insertion point of text.

These blocks are of different layers. Now I need a lisp to remove the blocks and place a point at the insertion point of the block/Text and to its corresponding layer.

Now I need a lisp to remove the blocks and place a point at the insertion point of the block/Text and to its corresponding layer.

The corresponding layer? Is that the layer of the text it is in front of? Is it sort of a table with some symbol (block) and its description (layer)?

36000 blocks in one drawing???

Check this out ...... Buddy.

(defun c:test (/ *error* ss TH:CAD TH:StartUnDo TH:EndUnDo)
 ; Tharwat 21. 02. 2011
 (vl-load-com)
 (defun *error* ( msg )
   (and TH:UnDo (vla-EndUndoMark TH:CAD))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ)
 )
 (setq TH:CAD (vla-get-ActiveDocument (vlax-get-acad-object)))
 (setq TH:StartUnDo (vla-StartUndoMark TH:CAD))
 (if (eq (getvar 'pdmode)0 )(setvar 'pdmode 3))
 (if (setq ss (ssget "_x" '((0 . "INSERT"))))
   ((lambda (i / ss1 e L )
      (while
        (setq ss1 (ssname ss (setq i (1+ i))))
        (entmakex (list (cons 0 "POINT")(cons 8 (cdr (assoc 8 (entget ss1))))(cons 10 (cdr (assoc 10 (entget ss1))))
                        )
                  )
             (entdel ss1)
        )
      )
     -1
     )
   (Alert "\n Not even one block found "))
 (setq TH:EndUnDo (vla-EndUndoMark TH:CAD)) 
 (princ)
 )

Tharwat

Tharwat = Speedy Gonzales

I did not get what mean by Gonzles .

I did not get what mean by Gonzles .

http://en.wikipedia.org/wiki/Speedy_Gonzales

http://www.youtube.com/results?search_query=speedy+gonzales&aq=f

:wink:

Very nice Gonzales and good to know .

Thanks for the infos.

Tharwat

Tharwat,

What is the purpose of the variables you use for the return of vla-Start/EndUndoMark?

 (and [color=red][b]TH:UnDo[/b][/color] (vla-EndUndoMark TH:CAD))
...
 (setq [b][color=red]TH:StartUnDo[/color][/b] (vla-StartUndoMark TH:CAD))
...
 (setq [b][color=red]TH:EndUnDo[/color][/b] (vla-EndUndoMark TH:CAD)) 

Also, this is redundant:

[color=red][b](cons 8 (cdr (assoc 8[/b][/color] (entget ss1))))

[color=red][b](cons 10 (cdr (assoc 10 [/b][/color](entget ss1))))

It could be replaced with just

[color=black](assoc  8[/color] (entget ss1))

[color=black](assoc 10 [/color](entget ss1))

Tharwat,

 

What is the purpose of the variables you use for the return of vla-Start/EndUndoMark?

 

 

 

Also, this is redundant:

 

 

 

It could be replaced with just

 

[color=black](assoc  8[/color] (entget ss1))

[color=black](assoc 10 [/color](entget ss1))

Wow, that was pointed out to him just a couple days ago.

What is the purpose of the variables you use for the return of vla-Start/EndUndoMark?

That's right Lee, There is no need to Variable name for these functions .

 

It could be replaced with just

[color=black](assoc  8[/color] (entget ss1))
[color=black](assoc 10 [/color](entget ss1))

Also that's right , it was a matter of re-constructing it two times for nothing.

Appreciated a lot.

Tharwat

 

Also, this is redundant.....

Im guilty of that before:

--->

^

I appreciated;but not all blocks,i need only selected (layer wise) blocks.

Thanks

(defun ss_id ( ss / id lst )
 (if (eq 'PICKSET (type ss))
   (repeat (setq id (sslength ss))
     (setq lst
       (cons
         (ssname ss (setq id (1- id)))
         lst
       )
     )
   )
 )
 lst
)

(defun c:test ( / ss )
 (if 
   (setq ss 
     (ss_id (ssget (list (cons 0 "insert"))))
[color=red];|   (ssget (list (cons 0 "insert") (cons 8 "0") )) 
       will only select blocks in "0" layer |;[/color]
   )
   (foreach x ss
     (entmake
       (list
         (cons 0 "point")
         (cons 8 (getvar 'clayer))
         (assoc 10 (entget x))
       )
     )
     (entdel x)
   )
 )
 (princ)
)

Dan,

Note that you could improve the efficiency of your code by iterating through the SelectionSet only once:

(defun c:ins2pts ( / ss e i )

 (if (setq ss (ssget "_:L" '((0 . "INSERT"))))
   (repeat (setq i (sslength ss)) (setq e (ssname ss (setq i (1- i))))
     (if
       (entmakex
         (list
           (cons 0 "POINT")
           (assoc 8 (entget e))
           (cons 10 (trans (cdr (assoc 10 (entget e))) e 0))
           (assoc 210 (entget e))
         )
       )
       (entdel e)
     )
   )
 )
 (princ)
)

Hi

But I need the above one layerwise selections,bcoz I have diffrent name of blocks

Thanks

amr

Hi

But I need the above one layerwise selections,bcoz I have diffrent name of blocks

 

What you mean by layerwise ?

Dan,

 

Note that you could improve the efficiency of your code by iterating through the SelectionSet only once

True, but with a smal task like this you would never notice the difference in speed. I find it's easier to have a setup like this for quick programming

@ cadmarao

See my comment in red in code above.

Dan,

 

Note that you could improve the efficiency of your code by iterating through the SelectionSet only once:

 

(defun c:ins2pts (/ ss i e d)
 (if (setq ss (ssget "_:L" '((0 . "INSERT"))))
   (repeat (setq i (sslength ss))
     (if (entmakex (list '(0 . "POINT")
                         (assoc 8 (setq d (entget (setq e (ssname ss (setq i (1- i)))))))
                         (cons 10 (trans (cdr (assoc 10 d)) e 0))
                         (assoc 210 d)
                   )
         )
       (entdel e)
     )
   )
 )
 (princ)
)

Someone's bored...

Someone's bored...

Nah, just saw the thread and thought I'd elaborate on your example to remove multiple entity dumps on the same object.