Insert Selected Blocks' names at their ins. point

I think I am a little lazy...

Now I feel I maybe can do this routine... but it will be better if someone solves it...

Selecting a bunch of selected blocks... I want to insert their names (using the current style and height) in their own insertion point.

I got this 2 codes, one from Alan J...and the other from me... but if we get rid of picking insertion point, we can have it all done automatically, I think...

Can anybody help?

(defun c:BlockName (/ #Ent #Point)
 (and
   (setq #Ent (car (entsel "\nSpecify block: ")))
   (eq "INSERT" (cdr (assoc 0 (entget #Ent))))
   (setq #Point (getpoint "\nSpecify placement point for MText: "))
   (entmake (list
              '(0 . "MTEXT")
              '(100 . "AcDbEntity")
              '(100 . "AcDbMText")
              (cons 7 (getvar "textstyle"))
              (cons 10 (trans #Point 1 0))
              (cons 1 (cdr (assoc 2 (entget #Ent))))
            ) ;_ list
   ) ;_ entmake
 ) ;_ and
 (princ)
) ;_ defun

(defun c:bn () 
(setq obj (car (entsel "\nPick Block..."))) 
(setq bname (cdr (assoc 2 (entget obj))))
(setq txt (strcat "" bname ""))
(setq p1 (getpoint "\nPick text location: "))
(command "text" p1 "" "" (strcat "" bname "") )
(command "change" "l" "" "" "" "" "" "" txt)
)

Also, I have this parts of a routine to filter blocks from a selection..

   (progn
     (prompt "\nSelect all the Blocks to be exported: ")
     (setq #SSET (ssget (list (cons 0 "INSERT")))))))

And to grab their insertion points

     (setq #CNT (sslength #SSET)
           #IDX 0)
     (while (/= #IDX #CNT)
       (setq #ENT (entget (ssname #SSET #IDX))
             #PT  (cdr (assoc 10 #ENT))

But how to mix it all?

It seems like you have all the pieces you need. What I would suggest is writing a function to do it once, and then writing a function to create a selection set, and for each item in the selection set, call the first function.

Remember that you can pass variables to a function by placing them before the forward slash in the function definition, like so:

(defun function(passedVar / )
(princ passedVar)
)

And look into the ssnamex function (you can find it in the LISP help menu) for taking a selection set and turning it into a list of entity names.

This should give you something to chew on...

(defun c:BlockNames (/ #SS)
 (cond
   ((setq #SS (ssget '((0 . "INSERT"))))
    (or *AcadDoc*
        (setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object)))
    ) ;_ or
    (vlax-for x (setq #SS (vla-get-activeselectionset *AcadDoc*))
      (AT:Mtext (vla-get-insertionpoint x)
                (if (vlax-property-available-p x 'EffectiveName)
                  (vla-get-effectivename x)
                  (vla-get-name x)
                ) ;_ if
                0
                (vla-get-layer x)
                5
      ) ;_ AT:Mtext
    ) ;_ vlax-for
    (vla-delete #SS)
   )
 ) ;_ cond
 (princ)
) ;_ defun

You will need this sub:

;;; Add MText to drawing
;;; #InsertionPoint - MText insertion point
;;; #String - String to place in created MText object
;;; #Width - Width of MText object (if nil, will be 0 width)
;;; #Layer - Layer to place Mtext object on (nil for current)
;;; #Justification - Justification # for Mtext object
;;;             1 or nil= TopLeft
;;;             2= TopCenter
;;;             3= TopRight
;;;             4= MiddleLeft
;;;             5= MiddleCenter
;;;             6= MiddleRight
;;;             7= BottomLeft
;;;             8= BottomCenter
;;;             9= BottomRight
;;; Alan J. Thompson, 05.23.09
(defun AT:MText (#InsertionPoint #String #Width #Layer #Justification / #Width
                #Space #Insertion #Object
               )
 (or #Width (setq #Width 0))
 (or *AcadDoc*
     (setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object)))
 ) ;_ or
 (setq #Space     (if (or (eq acmodelspace
                              (vla-get-activespace *AcadDoc*)
                          ) ;_ eq
                          (eq :vlax-true (vla-get-mspace *AcadDoc*))
                      ) ;_ or
                    (vla-get-modelspace *AcadDoc*)
                    (vla-get-paperspace *AcadDoc*)
                  ) ;_ if
       #Insertion (cond
                    ((vl-consp #InsertionPoint) (vlax-3d-point #InsertionPoint))
                    ((eq (type #InsertionPoint) 'variant) #InsertionPoint)
                    (T nil)
                  ) ;_ cond
 ) ;_ setq
 ;; create MText object
 (setq #Object (vla-addmtext #Space #Insertion #Width #String))
 ;; change layer, if applicable
 (and #Layer
      (tblsearch "layer" #Layer)
      (vla-put-layer #Object #Layer)
 ) ;_ and
 ;; change justification & match insertion point with new justification
 (cond ((member #Justification (list 1 2 3 4 5 6 7 8 9))
        (vla-put-attachmentpoint #Object #Justification)
        (vla-move #Object
                  (vla-get-InsertionPoint #Object)
                  #Insertion
        ) ;_ vla-move
       )
 ) ;_ cond
 #Object
) ;_ defun

This should give you something to chew on...

 

(defun c:BlockNames (/ #SS)
 (cond
   ((setq #SS (ssget '((0 . "INSERT"))))
    (or *AcadDoc*
        (setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object)))
    ) ;_ or
    (vlax-for x (setq #SS (vla-get-activeselectionset *AcadDoc*))
      (AT:Mtext (vla-get-insertionpoint x)
                (vla-get-name x)
                0
                (vla-get-layer x)
                5
      ) ;_ AT:Mtext
    ) ;_ vlax-for
    (vla-delete #SS)
   )
 ) ;_ cond
 (princ)
) ;_ defun

 

 

You will need this sub:

;;; Add MText to drawing
;;; #InsertionPoint - MText insertion point
;;; #String - String to place in created MText object
;;; #Width - Width of MText object (if nil, will be 0 width)
;;; #Layer - Layer to place Mtext object on (nil for current)
;;; #Justification - Justification # for Mtext object
;;;             1 or nil= TopLeft
;;;             2= TopCenter
;;;             3= TopRight
;;;             4= MiddleLeft
;;;             5= MiddleCenter
;;;             6= MiddleRight
;;;             7= BottomLeft
;;;             8= BottomCenter
;;;             9= BottomRight
;;; Alan J. Thompson, 05.23.09
(defun AT:MText (#InsertionPoint #String #Width #Layer #Justification / #Width
                #Space #Insertion #Object
               )
 (or #Width (setq #Width 0))
 (or *AcadDoc*
     (setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object)))
 ) ;_ or
 (setq #Space     (if (or (eq acmodelspace
                              (vla-get-activespace *AcadDoc*)
                          ) ;_ eq
                          (eq :vlax-true (vla-get-mspace *AcadDoc*))
                      ) ;_ or
                    (vla-get-modelspace *AcadDoc*)
                    (vla-get-paperspace *AcadDoc*)
                  ) ;_ if
       #Insertion (cond
                    ((vl-consp #InsertionPoint) (vlax-3d-point #InsertionPoint))
                    ((eq (type #InsertionPoint) 'variant) #InsertionPoint)
                    (T nil)
                  ) ;_ cond
 ) ;_ setq
 ;; create MText object
 (setq #Object (vla-addmtext #Space #Insertion #Width #String))
 ;; change layer, if applicable
 (and #Layer
      (tblsearch "layer" #Layer)
      (vla-put-layer #Object #Layer)
 ) ;_ and
 ;; change justification & match insertion point with new justification
 (cond ((member #Justification (list 1 2 3 4 5 6 7 8 9))
        (vla-put-attachmentpoint #Object #Justification)
        (vla-move #Object
                  (vla-get-InsertionPoint #Object)
                  #Insertion
        ) ;_ vla-move
       )
 ) ;_ cond
 #Object
) ;_ defun

You're a Gennius...

No further assistance required for this post.

You're a Gennius...

 

No further assistance required for this post.

Happy to help.

Oops, forgot to account for Dynamic Blocks. Updated above.