Insert Block

;;;-------======={ Insert Blocks Program }======------------
;;;  Description       : Insert Block for Selected                                                                                            
;;;                      "TEXT" "MTEXT" or "POINT"                                                          
;;;  Command           : "INSBLK"                                                                          
;;;  First Release On  : 01-05-2012                      
;;;  Second Release On : 09-11-2013                        
;;;                      added File Option                
;;;  Author            : Ganesh Shetty (c) 2013                                  
;;;                      www.autolispgs.blogspot.in        
;;;  Email             : autolisphelp@gmail.com            
;;;  Note :Please do not modify or copy any part of this  
;;;        Program without Author Permissions              
;;;---------------------------------------------------------

(defun c:INSBLK (/ *error* Stripcoords _Placeblocks *adoc* *osm* ss space i
                   noext option bnm ssnm en->vl point)
    (vl-load-com)  ;Load Activex Support....

; Error Handler ........
(defun *error* (msg)
   (if *adoc* (vla-endundomark *adoc*))
(and *osm* (setvar 'osmode *osm*))
(if (not (member msg '("Function cancelled" "quit / exit abort")))
   (princ (strcat "\n--->Error:" msg))
)
(princ)
)

; Strip coordinates from objects .....
(defun Stripcoords (e / ent etype)
   (setq ent (entget e))
(setq etype (cdr (assoc 0 ent)))
(if (or (= "MTEXT" etype)
       (= "POINT" etype)
       (and
   (zerop (cdr (assoc 72 ent)))
(zerop (cdr (assoc 73 ent)))
)
)
(cdr (assoc 10 ent))
(cdr (assoc 11 ent))
)
)

; Insert Block at points
(defun _Placeblocks (s spec bname / i sn)
   (repeat (setq i (sslength s))
   (setq sn (ssname s (setq i (1- i))))
(vla-insertblock spec (vlax-3d-point (stripcoords sn)) bname 1 1 1 0)
)
)

;;------------------------MAIN----------------------------------;;
(setq *adoc* (vla-Get-ActiveDocument (vlax-get-Acad-Object)))
(setq space (vla-get-modelspace *adoc*))
(setq *osm*  (getvar 'osmode))
(setvar 'osmode 0)
(vla-StartUndoMark *adoc*)
(prompt "\nSelect Objects TEXT,MTEXT or Point...")
(if (setq ss(ssget "_:L" '((-4 . "<Or")
                           (0 . "POINT")
(0 . "TEXT")
(0 . "MTEXT")
(-4 . "Or>")
  )
)
)
(progn
   (setq noext T)
(while noext
   (initget "File Name")
   (setq Option (getkword "\nSelect Block from [File] or Enter Name [Name]:"))
(cond
   (   (= Option nil)
   (princ "\nInvalid Option Try again.")
)
(   (= Option "File")
   (setq bnm (getfiled "Select Block Path"  "C:\\" "dwg;dxf" 16))
(if (= bnm nil)
(princ "\nBlock Not Selected Please Retry with Block Option.")
(progn
(setq noext nil)
   (_Placeblocks ss  space bnm)
           (if (= (sslength ss) 1)
(princ "\n 1  Object has updated with Block.")
(princ (strcat "\n " (rtos (sslength ss) 2 0) "  Objects has Updated with Block."))
)
)
)
)
(   (= Option "Name")
   (setq bnm (getstring "\nEnter Block Name to Insert:"))
(if (or (= bnm nil) (= bnm ""))
   (princ "\nInvalid Block Name ,Try again.")
(progn
   (if (not (tblsearch "BLOCK" bnm))
   (princ (strcat "\nBlock not found in Drawing ! Retry with Block Option."))
(progn
   (setq noext nil)
(_Placeblocks ss space bnm)
(if (= (sslength ss) 1)
   (princ "\n 1  Object has updated with Block.")
(princ (strcat "\n " (rtos (sslength ss) 2 0) "  Objects has Updated with Block."))
)
)
)
)
)
)
)
)
)
   (princ "\nNo Objects Selected..")
)
    (vla-endundomark *adoc*)
(setvar 'osmode *osm*)
(princ)
)

Read More