Insert block with attributes and select text string as attr value

[rmr jam]

I have been asked to come up with a way to replace instrument bubbles (circle with 3 separate lines of text)with a block with attributes on a LARGE group of drawings. There may be 20 different instrument bubbles on a drawing. I want to be able to insert the new block at each location and when it asks for the first attribute value, to select an existing string of text to fill in that value. Then prompt for the second value, then the third. I could then place the new block in place of the old circle/text.Then I want to erase the old lines/circle. I searched for an existing lsp routine that might do something close to this.

This is what I have come up with so far. Started with a file I found on here. I realize this may not be the best way to do some of this, any help or suggestions would be appreciated.

 

This pretty much does what I want, but I have a couple of questions. I am selecting an erase window around the old circle/text. When it gets to that part of the lsp, it lets me select the 2 points for my window, but I cant see the selection box while I am doing it. Is there a better way to do this so that I can see the selection box?

[rmr jam]

;define function - instbub, activate with ibblk

(defun c:ibb ( )

;define picktext for use later in the script

(defun picktext () (setq en1 (car (entsel "\nSelect text :" ))) (setq el1 (entget en1))

(if (= (cdr (assoc 0 el1)) "TEXT")

(setq ans (assoc 1 el1))

)

) ;end defun

(command "osnap" "cen" )

;identify pt as insertion point for instbub

(while (setq pt (getpoint "\nPick Insertion Point:"))

;get unit name from a text element

(picktext)

(setq unitname ans)

;get instrument type from text element

(picktext)

(setq insttype ans)

;get instrument number from text element

(picktext)

(setq instnumb ans)

; insert a instrument bubble based on the information stored above

(command "attdia" "0" )

(command "-insert" "instrbub.DWG" "_NON" pt "1" "1" "0" (cdr unitname) (cdr insttype) (cdr instnumb) )

(command "osnap" "off" )

(command "ERASE" "w" (getpoint)(getpoint)"R" "L" )

(command "redraw" )

)

(princ)

)

[Lt Dan's legs]

do you have a gif recorder? What is the text string (it's contents)? Is the text inside the circle?

 

 

 

 

:edit (fixed errors)

 

(defun c:test ( / *error* rb:insertblock rb:put_attributes ss->lst ss blckname )
(defun *error* ( msg )
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ)
 )
(defun rb:insertblock ( activespace blockname layer insertionpoint scale rotation vla-object / block )
 (if 
   (setq block
     (vla-insertblock activespace
       (vlax-3d-point insertionpoint)
       blockname scale scale scale rotation
     )
   )
   (progn
     (and (tblsearch "layer" layer)
       (vla-put-layer block layer)
     )
     (if vla-object
       block
       (handent (vla-get-handle block))
     )
   )
 )
)
(defun ss->lst ( ss flag / id lst )
 (if (eq 'PICKSET (type ss))
   (repeat (setq id (sslength ss))
     (
       (lambda ( name )
         (setq lst
           (cons
             (if flag (vlax-ename->vla-object name)
               name
             )lst
           )
         )
       )(ssname ss (setq id (1- id)))
     )
   )
 )
)
(defun rb:put_attributes ( block lst )
 (and (vlax-method-applicable-p block 'getattributes)
   (foreach x (vlax-invoke block 'getattributes)
     (foreach a lst
       (if 
         (eq (strcase (car a))
           (strcase (vla-get-tagstring x))
         ) (vlax-put x 'textstring (cdr a))
       )
     )
   )
 )
)
 (if 
   (and
     (or
       (and (tblsearch "block" "instrbub") (setq blckname "instrbub")) 
       (findfile "instrbub.DWG")
       (alert "Block \"instrbub\" is missing!")
     )
     (setq ss (ss->lst (ssget '((0 . "circle"))) t))
   )
   (progn
     (foreach x ss
       (rb:put_attributes 
         (rb:insertblock 
           (vla-get-modelspace 
             (vla-get-activedocument (vlax-get-acad-object))
           ) 
           (setq blckname 
             (cond ( blckname "wallball2" )
               ( (findfile "wallball2") )
             )
           )
           (getvar 'clayer)     ;layer
           (vlax-get x 'Center) ;location
            1.                  ;scale
            0.                  ;rotation
            t                   ;return vla-object
         )
         (list 
           (cons "tagname1"                               ;attribute tag
                 "text to add to \"tagname1\" attribute"  ;text for attribute
           )
           (cons 
             "tagname2"                               ;attribute tag
             "text to add to \"tagname2\" attribute"  ;text for attribute
           )
         )
       ) (vla-delete x)
     )
   )
 ) (princ)
)

Edited October 8, 2015 by Lt Dan's legs

[rmr jam]

I don't have a gif recorder. What I am trying to do is replace a symbol on the drawings that is a circle with 3 lines of text inside it with a block with the 3 lines as attributes (instrbub.dwg). There might be 50 different occurrences of this symbol on each drawing and I have about 1000 drawings to do. I have gotten the lisp I was working on where it is working fairly well, but if there is a more efficient way, I'd love to use it. I am looking over the code you posted, but it will take me a while to sort thru what you did there. Thank you for your help.

 

 

Here is my latest iteration:

 

 

;define function - instbub, activate with ibb

(defun c:ibb ( )

;define picktext for use later in the script

(defun picktext () (setq en1 (car (entsel "\nSelect Unit text :" ))) (setq el1 (entget en1))

(if (= (cdr (assoc 0 el1)) "TEXT")

(setq ans (assoc 1 el1))

)

) ;end defun

(defun picktext2 () (setq en1 (car (entsel "\nSelect Type text :" ))) (setq el1 (entget en1))

(if (= (cdr (assoc 0 el1)) "TEXT")

(setq ans (assoc 1 el1))

)

) ;end defun

(defun picktext3 () (setq en1 (car (entsel "\nSelect Numb text :" ))) (setq el1 (entget en1))

(if (= (cdr (assoc 0 el1)) "TEXT")

(setq ans (assoc 1 el1))

)

) ;end defun

(command "osnap" "cen" )

;identify pt as insertion point for instbub

(while (setq pt (getpoint "\nPick Insertion Point:"))

;get unit name from a text element

(picktext)

(setq unitname ans)

;get instrument type from text element

(picktext2)

(setq insttype ans)

;get instrument number from text element

(picktext3)

(setq instnumb ans)

; insert a instrument bubble based on the information stored above

(command "attdia" "0" )

(command "-insert" "instrbub.DWG" "_NON" pt "1" "1" "0" (cdr unitname) (cdr insttype) (cdr instnumb) )

(command "osnap" "off" )

(setq old (ssget))

(command "ERASE" old "R" "L" "")

(command "osnap" "cen" )

(command "redraw" )

)

(princ)

)

[rmr jam]

I am attaching an example drawing. The 4 circles at the bottom are what I am trying to fix. They were drawn as a circle and text. I would like them to be the same block as the circle above them with the attribute values of the text. Hopefully this will clarify what I am trying to do.

example.dwg

[BIGAL]

You should be able to pick the circle only as the text is inside so a ssget will find, a sort on the y insert value will determine their correct order, as you have objects just use erase for all objects so they are gone, when you pick you set a variable obj1 obj2 obj3 with the entity name ERASE OBJ1 OBJ2 OBJ3 OBJ4. Same with circle centre its retrieved as assoc 10 rather than use osnap.

 

As the posts above indicate do the pick text first then insert or else do a attribute update now you have values.

 

Me personally do all changes in one go! Pick a circle this returns layer name or build a layer name list by picking as per your drawing revcloud and hydrogen, then all will be done, not a five minute code sorry.

 

I believe ssget can not use a circle as a inside selection, any one please correct me, so you need a facet search to use SSGET "WP" finding text objects. just happen to have a arc to facet lisp which I can change.

 

Lastly it may rain on the weekend so I may have some time. But anyone else please step up.

[BIGAL]

For any one interested

 

from the Help

(ssget "WP" pt_list) Creates a selection set of all entities within the polygon defined by pt_list

 

; converts an arc to a series of straights
; next version circles
(vl-load-com)
(setq oldsnap (getvar "osmode"))
(setvar "osmode" 0)
(setq oldecho (getvar "cmdecho"))
(setvar "cmdecho" 0)

(while (setq ent (entsel "\nPick arc: "))
(setq obj (vlax-ename->vla-object (car ent)))
(if (= div nil) (setq div (getint "\nEnter number of chords: ")))
     
(setq  endpt (vlax-curve-getEndPoint obj)
    totlen (vlax-curve-getDistAtPoint obj endpt)
    arclen (/ totlen div)
    chrdpt (vlax-curve-getStartPoint obj)
    num 1     
)

(repeat div
 (setq newpt (vlax-curve-getPointatDist obj (* arclen num)))
 (command "line" chrdpt newpt "")
 (setq num (+ num 1))   
 (setq chrdpt newpt)
) ;repeat
(setq objlst (cons obj objlst))
) ; end while

;(vlax-for objdel objlst (vlax-delete  objdel))

(setvar "cmdecho" oldecho)

(setvar "osmode" oldsnap)

(princ)

[ttray33y]

I am attaching an example drawing. The 4 circles at the bottom are what I am trying to fix. They were drawn as a circle and text. I would like them to be the same block as the circle above them with the attribute values of the text. Hopefully this will clarify what I am trying to do.

 

so you are trying to replace all those instrument symbols/bubbles in red namely BLRCL-- & BLDIS-- to instrbub "blue" with currnet instrument tag of red ballons right?

 

i did encounter this kind of situation specially for new drafters, doing p&id with my projects..

[ttray33y]

Lisp used:

Transmutation by Ricky Medley

Block replacer

 

Commands:

transmutation

cg

move "text/mtext"

 

see gif attached.

i would love to help you anytime cleaning those drawings just buy me a beer, btw i do p&ids too.

text to att-block bubs.zip

 

GIF Demo here

Edited October 9, 2015 by ttray33y

[rmr jam]

so you are trying to replace all those instrument symbols/bubbles in red namely BLRCL-- & BLDIS-- to instrbub "blue" with currnet instrument tag of red ballons right?

 

 

 

Not exactly. I have 1000 drawings that were produced/modified by multiple people over the last 20 years with no standard on this symbol. So some will be the BLRCL-- or BLDIS-- block with 3 strings of text, some will be just a circle with text, others will be a block with a different name. Not much consistency. I may be able to use the files you sent. Thank you.

[pBe]

If the issue is consistency [ layers / Textstyles / textheight etc. ] of the target TEXT and circles then running a script would be a problem wouldn't it? but its definitely doable, [ thru a script that is ]

 

For circles with only one text do you still use the same block and what attribute tag would be filled up UNIT, TYPE or INSTNO? if there'll be different blocks post it here.? You need to provide us all the possibilities [ maybe not ALL but.. ], I'm pretty sure its easy as long as we consider all the variables.

[rmr jam]

Thank you for your help. I modified my routine to improve it a little, but I still haven't quite got it right (thanks to a member here for pm'ing me some help).

 

 

I would like to have it erase the circle and the 3 lines of text after inserting my new block without having to select a window and then remove my new block. Im sure there is a way, I just haven't figured it out. So, the "entity" is the circle. I should be able to to erase that, right? But how do I call out the lines of text that I selected to delete them?

 

 

See my latest iteration below. Thanks again.

 

 

;define function - instbub, activate with ibb4

(defun c:ibb4 ( )

;define picktext for use later in the script

(defun picktext () (setq en1 (car (entsel "\nSelect Unit text :" ))) (setq el1 (entget en1))

(if (= (cdr (assoc 0 el1)) "TEXT")

(setq ans (assoc 1 el1))

)

)

;end defun

(defun picktext2 () (setq en1 (car (entsel "\nSelect Type text :" ))) (setq el1 (entget en1))

(if (= (cdr (assoc 0 el1)) "TEXT")

(setq ans (assoc 1 el1))

)

)

;end defun

(defun picktext3 () (setq en1 (car (entsel "\nSelect Numb text :" ))) (setq el1 (entget en1))

(if (= (cdr (assoc 0 el1)) "TEXT")

(setq ans (assoc 1 el1))

)

)

;end defun************************

( (defun point ( insertionpoint )

(entmakex

(list

(cons 0 "point")

(cons 10 insertionpoint)

)

)

)

(if

(and

(setq entity (car (entsel "\nPlease select a circle: ")))

(eq "CIRCLE" (cdr (assoc 0 (setq entity (entget entity)))))

)

(point (cdr (assoc 10 entity)))

)

;

;

;

(setq pt (cdr (assoc 10 entity)))

;get unit name from a text element

(picktext)

(setq unitname ans)

;get instrument type from text element

(picktext2)

(setq insttype ans)

;get instrument number from text element

(picktext3)

(setq instnumb ans)

; insert a instrument bubble based on the information stored above

(command "attdia" "0" )

(command "-insert" "instrbub.DWG" "_non" pt "1" "1" "0" (cdr unitname) (cdr insttype) (cdr instnumb) )

(setq old (ssget))

(command "ERASE" old "R" "L" "")

)

(princ)

)

[BIGAL]

If you go back to my post you see that I am suggesting pick circle and find text inside as well as saving the name of each entitity separately obj obj2 obj3 obj4 change your code el1 etc to el1 el2 el3 then you can find each of these and erase. You also only need pick text defun once you can play with whats sent to the defun in terms of questions and make each seperate variable = ans.

 

Will try to find time to do pick circle get all inside for you.

 

Like Pbe can only try one rule at a time and keep enhancing.

[pBe]

... Like Pbe can only try one rule at a time and keep enhancing.

 

True

 

Right now I wrote a test code that works on your attached drawing file [example3.dwg]

 

 [b][color="navy"]UPDATED CODE POSTED @ post#20[/color][/b]

There are too many questions that only you can answer or you could post a more realistic sample drawing.

The code above is not all a complete code. it lacks conditions for just about everything

 

HTH

 

 

EDIT: only need to do now is getting the block to match the "circle" radius and

delete non conforming blocks and circles

 

DONE

Edited October 23, 2015 by pBe

[rmr jam]

AL, I did see that and that makes sense, thank you, I just am not sure how to implement what you suggested. I am just picking my way thru writing this. This is the third time I've tried to write a lisp routine, so I am having to figure out every command as I go.

 

 

 

Pbe, Thank you as well. I am looking at what you wrote and trying to make sense of it. Did you just write that from scratch? If so, I am even more intimidated by this now. There is a LOT going on there that I don't understand. I basically have to go thru one line at a time and figure it out and its taking me a while. I ran the routine on my example and it worked great, but when I tried it on a full drawing, it doesn't work, just returns nil. I am not able to attach a full drawing for you (proprietary).

 

 

 

To try and clarify what I am trying to accomplish, I'll attempt to give a better explanation. The company I am working for has approx. 1000 P&IDs that have been drawn/modified over the past 25 years with very little standardization. I have tried to standardize symbology, but for years they let various contractors modify the drawings with little oversight. The result is nothing is the same from drawing to drawing. I need all of the instrument bubbles to be a block with 3 attributes (unit/instrument type/instrument number). There may be 5 instrument bubbles on one drawing and 80 on the next.

 

 

 

Some of the existing bubbles are a circle with 3 lines of text, some are a block (a circle with various hidden attribute data that is not needed) with 3 lines of text, and some are various other things. Really too many different examples to show them all.

 

I want to automate as much of this process as I can, but I have to make sure that I get them all, even if I have to manually do a few odd ones.

 

I am attaching a new example drawing that shows some of the various different examples I'm dealing with.

example3.dwg

[pBe]

its an easy fix, at least now i have some other conditions to work on..... i'll see what i can do.

 

EDIT:

At first glance, we need to somehow filter those BLOCKS/CIRCLE "at the same coord",

 

 

65% OF THE OCCURANCES ON ALL OF MY DRAWINGS: Done

Also blocks with a none center insertion point. the rest is easy: Done

Circles with two or three TEXT : Done

1 or 2 Attributes: Done

 

 

Text/Attribute: DONE

Block/Circle: DONE

Circle radius: DONE

Edited October 23, 2015 by pBe

[rmr jam]

pBe,

 

 

That routine is so far beyond my understanding. Could you add some comments to it to describe what is going on there?

[BIGAL]

Watch this space I wrote last night use a circle as ssget filter to retrieve the text its still a work in progress. Doinf it for anyone that may need something like that.

[BIGAL]

I appreciate Pbe is working hard on a full answer, here is a method of finding objects inside a circle along the lines of the code you started to write which uses a more automated approach, at the moment it uses a manual pick of circles but that would be removed to a pick all to be changed. A word of caution it deletes the objects as a test stage, undo will bring back. As I hinted I would make it find all wether it be 1 2 3 or more text entries.

 

; started life as converts a circle to a series of chords
; now find objects inside a circle
(vl-load-com)
(setq oldsnap (getvar "osmode"))
(setvar "osmode" 0)
(setq oldecho (getvar "cmdecho"))
(setvar "cmdecho" 0)

(while (setq ent (entsel "\nPick circle: "))
;(if (= div nil) (setq div (getint "\nEnter number of chords: "))) 
(setq div 20) ; works ok
(setq obj (vlax-ename->vla-object (car ent)))
     
(setq angdiv (/ (* 2.0 pi) div))
(setq cenpt (vlax-safearray->list (vlax-variant-value (vla-get-center obj))))
(setq rad (vla-get-radius obj))
(setq ang 0.0)

(repeat div
(setq newpt (polar cenpt ang rad))
(setq lst (cons (list (car newpt)(cadr newpt)) lst))
(setq ang (+ ang angdiv))
) ;repeat

; select text inside a circle
; selection set of text within polygon
(setq ss (ssget "_WP" lst '((0 . "Text,Mtext"))))

;if always 3 do this way else repeat as required for sslength of ss for variable number of texts
(setq t1 (vla-get-textstring (vlax-ename->vla-object (ssname ss 0))))
(setq t2 (vla-get-textstring (vlax-ename->vla-object (ssname ss 1))))
(setq t3 (vla-get-textstring (vlax-ename->vla-object (ssname ss 2))))
(alert (strcat t1 " " t2 " " t3))

; now lets delete all 
(setq x (sslength ss))
(while (setq ent2 (ssname ss (setq x (- x 1)))) 
(entdel ent2)
) ; delete text inside
(entdel (car ent)) ;delete circle

(setq ss nil
    lst nil)
) ; end while 

; now do insert new block !!!!
(alert "stage 2 not done yet")
) ; end while 

(setvar "cmdecho" oldecho)
(setvar "osmode" oldsnap)
(princ)

 

part 2 this makes squares and circles as block with text or numbers

; bubble pt num
; BY ALAN AUG 2014

(defun make_circle ()
 (entmake (list (cons 0 "CIRCLE")
 (cons 8 "0")
 (cons 10 (list 0 0 0))
 (cons 40 3.25)		; rad
 (cons 210 (list 0 0 1))
 (cons 62 256)
 (cons 39 0)
 (cons 6 "BYLAYER")
  )
 )
)					; DEFUN

(defun make_sq ()
 (setq	vertexList
 (list
 (list -3.25 -3.25 0.)
 (list 3.25 -3.25 0.)
 (list 3.25 3.25 0.)
 (list -3.25 3.25 0.)
 ))
 (entmake
   (append 
   (list '(0 . "LWPOLYLINE")
   '(100 . "AcDbEntity")
   '(100 . "AcDbPolyline")
   (cons 90 (length vertexList))
   (cons 70 1)			; 1 closed : 0 open
   (cons 8 "0")
   (cons 38 0.0)
   (cons 210 (list 0.0 0.0 1.0))
   )
   (mapcar '(lambda (pt) (cons 10 pt)) vertexList)
   )
 )
)					; defun

(defun Make_bubble ( )

 (entmake (list (cons 0 "BLOCK")
   (cons 2 Blkname)
   (cons 70 2)
   (cons 10 (list 0 0 0))
   (CONS 8 "0")
 ))

 (if (= resp "C")
 (make_circle)
 (make_sq)
 )

 (entmake (list (cons 0 "ATTDEF")
      (cons 8 "0")
      (cons 10 (list 0 0 0))
      (cons 1 "1")		; default value
      (cons 2 blkname)		; nblock name
      (cons 3 "Ptnum")		; tag name
      (cons 6 "BYLAYER")
      (cons 7 "STANDARD")	;text style
      (cons 8 "0")		; layer
      (cons 11 (list 0.0 0.0 0.0)) ; text insert pt
      (cons 39 0)
      (cons 40 3.5)		; text height
      (cons 41 1)		; X scale
      (cons 50 0)		; Text rotation
      (cons 51 0)		; Oblique angle
      (cons 62 256)		; by layer color 
      (cons 70 0)
      (cons 71 0)		;Text gen flag
      (cons 72 1)		; Text Justify hor 1 center
      (cons 73 0)		; field length
      (cons 74 2)		; Text Justify ver 2 center
      (cons 210 (list 0 0 1))
 ))

 (entmake (list (cons 0 "ENDBLK")))
 (princ)

)

(defun C:bub (/ ptnum ptnumb pt pt2 oldsnap chrnum sc curspace)
 (if (= 1 (getvar 'cvport))
 (setq sc 1.0)
 (setq sc (/ 1000.0 (getreal "\nEnter plotting scale")))
 )

 (setq oldsnap (getvar "osmode"))
 (setvar "textstyle" "standard")

 (setq ptnum (getstring "\nEnter Pt Number or alpha"))
 (setq chrnum (ascii (substr ptnum 1 1))) ; 1st character is number
 (if (< chrnum 58)
 (setq ptnumb (atof ptnum))		;convert back to a number 
 )


 (while (setq pt (getpoint "\Pick end of line Enter to exit"))
   (setq pt2 (polar pt (/ pi 2.0) 3.25))
   (setvar "osmode" 0)

   (if	(< chrnum 58)
     (progn
(command "-insert"
	 blkname
	 pt
	 sc
	 ""
	 0
	 (rtos ptnumb 2 0)
)
(setq ptnumb (+ ptnumb 1))
     )
     (progn
(command "-insert"
	 blkname
	 pt
	 sc
	 ""
	 0
	 (chr chrnum)
)
(setq chrnum (+ chrnum 1))
     )
   )
   (command "move" "L" "" pt pt2)
   (setvar "osmode" 1)
 )

 (setvar "osmode" oldsnap)
 (princ)
)					; end defun
;;;;;; 
				; program starts here checking 
(alert "Type Bub to repeat\nYou can do alpha's or numbers\nSquare or circles")
(initget 6 "S s C c")
(setq resp (strcase
     (Getkword "\nDo you want Circle or Square C or S <C> ")
   )
)
(if (or (= resp "C") (= resp nil))
 (setq blkname "SETOUT_POINT_NO")
 (setq blkname "SETOUT_POINT_NOSQ")
)


(if (/= (tblsearch "BLOCK" blkname) NIL)
(PRINC "FOUND")				; block exists
(Make_bubble)
)

(C:BUB)
(princ)

[pBe]

(defun c:fixmeplease (/ _inside-p  blocks space     circoll
 textcoll   ss       e   Exlst     insidecircle
       )
;;;  pBe October 2015 ;;;
 (defun _inside-p (pt obj / lst Yoray)
   (setq lst
   (vlax-invoke
     (setq Yoray
     (vla-addray
       (vla-objectidtoobject
  (vla-get-document obj)
  (vla-get-ownerid obj)
       )
       (vlax-3D-point pt)
       (vlax-3D-point (mapcar '+ pt '(1.0 0.0 0.0)))
     )
     )
     'intersectwith
     obj
     acextendnone
   )
   )
   (vla-delete Yoray)
   (= 1 (logand 1 (length lst)))
 )
(defun filter (condition lst)
   (vl-remove-if-not '(lambda (o)
      (Eval condition)) lst))
 (defun _text-p (lst cir / insidecircle)
(foreach txt lst
  (if (_inside-p (vlax-get txt 'insertionpoint) cir)
    (setq insidecircle (cons
    (list (vla-get-textstring txt)
          (vlax-get txt 'insertionpoint)
          txt
    )
    insidecircle
         )
   textcoll     (vl-remove txt textcoll)
    )
  )
)
 insidecircle
 )
 (defun _sort (lst) (vl-sort lst '(lambda (a b)(> (cadadr a) (cadadr b)))))
 (defun _Insblock (spc src bn s )  (vlax-invoke spc 'InsertBlock (vlax-get src 'Center) bn s s s 0 ))
 (defun _Wvtb  (obj slst)  (mapcar '(lambda (x y) (vla-put-textstring x y) y )
       (vlax-invoke obj 'GetAttributes) slst
       ))
 (setq LAyForO  nil
adoc (vla-get-ActiveDocument (vlax-get-acad-object))
blocks (vla-get-blocks adoc )
space  (vla-get-modelspace aDoc))
(vlax-for l (vla-get-layers  aDoc)
  (if
    (equal '(-1 0)
    (mapcar '(lambda (v)
        (vlax-get l v)
      )
     '("LayerOn" "Freeze")
    )
    )
     (setq LAyForO (cons (vla-get-name l) LAyForO)
     )
  )
)
 
 (if (and
 [color="blue"](setq blkn 
	(cond ((tblsearch "BLOCK" "instrbub") "instrbub")
	      ((findfile "instrbub.dwg"))))[/color]
 (setq textcoll nil blkcoll nil
       circoll  nil 
       ss       (ssget
    '((410 . "Model")
      (-4 . "<OR")
      (0 . "CIRCLE")
      (0 . "TEXT")
      (-4 . "<AND")
      (0 . "INSERT")
      (2 . "~instrbub")
      (-4 . "AND>")
      (-4 . "OR>")
     )
         )
 )
      )
   (progn
     (repeat (setq i (sslength ss))
(setq e (vlax-ename->vla-object (ssname ss (setq i (1- i)))))
(cond
  ((eq (setq objtyp (vla-get-ObjectName e)) "AcDbText")
   (setq textcoll (cons e textcoll))
  )
  ((eq objtyp "AcDbCircle")
   (setq circoll (cons (list e nil) circoll))
  )
  ((and	(eq objtyp "AcDbBlockReference")
	(not (member (setq on nil
			   bn (vla-get-EffectiveName e)
		     )
		     Exlst
	     )
	)
   )
   (vlax-for itm (vla-item blocks bn)
     (setq on (cons (list (vla-get-ObjectName itm) itm) on))
   )
   (if (and (setq p (vl-position
		      "AcDbCircle"
		      (mapcar 'car (setq on (reverse on)))
		    )
	    )
       )
     (setq blkcoll (cons (list p on e)
			 blkcoll
		   )
     )
     (setq Exlst (cons bn Exlst))
   )
  )
)
     )
     (foreach blk blkcoll
(Setq txtent  nil
      atr     nil
      atb     nil
      content (cadr blk)
      ipt     (vlax-get (last blk) 'Insertionpoint)
)
(setq circleinsideblock (nth (car blk) content))
(Setq refcircle
       (vlax-invoke
	 space
	 'Addcircle
	 (mapcar '+
		 ipt
		 (vlax-get (cadr circleinsideblock) 'center)
	 )
	 (* (vlax-get (cadr circleinsideblock) 'Radius)
	    (abs (vlax-get (last blk) 'XScaleFactor))
	 )
       )
      crad (vla-get-radius refcircle)
)
(foreach atr (vlax-invoke (last blk) 'Getattributes)
  (if
    (and (member (vla-get-layer atr) LAyForO)
	 (_inside-p (Setq spot (vlax-get atr 'insertionpoint))
		    refcircle
	 )
    )
     (setq atb (cons (list (vla-get-textstring atr) spot) atb))
  )
)
(foreach txt (mapcar 'cadr
		     (filter '(eq "AcDbText" (Car o)) content)
	     )
  (if (and (member (vla-get-layer txt) LAyForO)
	   (_inside-p (Setq
	       spot (mapcar '+ ipt (vlax-get txt 'insertionpoint))
	     )
	     refcircle
	   )
      )
    (setq txtent
	   (cons (list (vla-get-textstring txt) spot) txtent)
    )
  )
)
(setq txoutside (_text-p textcoll refcircle))
(setq sc (/  crad 0.250))
(if (setq allstr (apply 'append (list atb txtent txoutside)))
  (progn
    (setq str2write (_sort allstr))
    (setq atb (_Insblock space refcircle blkn sc))
    (_Wvtb atb (mapcar 'car str2write))
    (foreach tbd (append (mapcar 'last txoutside)
			 (list (last blk) refcircle)
		 )
      (vla-delete tbd)
    )
  )
  (progn
    (vla-delete refcircle)
    (vla-delete (last blk))
  )
)
     )
     (foreach cir circoll
 (if  (setq insidecircle (_text-p textcoll (car cir)))
   (progn
     (setq sc (/ (vla-get-radius (car cir)) 0.250))
     (setq insidecircle (setq str2write (_sort insidecircle)))
     (setq str2write (mapcar 'car insidecircle))
     (setq atb (_Insblock space (car cir) blkn sc))
     (_Wvtb atb (if (= (length insidecircle) 2)
          (cons "E" str2write) str2write))
     (foreach en cir
        (if en (Vla-delete en)))
      (foreach tx_ insidecircle (vla-delete (last tx_)))
 )
   (vla-delete (car cir))
      )
   		)
      )
  [color="blue"] (princ (cond
     ((null blkn) "\n<<< Block \"instrbub\" not found >>>")
     ((null ss) "\n<<< Null Selection >>>")))[/color]
   )
 (princ)
	)

Edited October 23, 2015 by pBe
Block issue FIX