(defun c:bn (/ n ss ns bn ag dc i lk ls m) (vl-load-com)
  (if (setq n -1 ss (ssget '((0 . "line"))))
    (if (/= (setq bn (getstring T "\nBlock name:")) "")
      (if (tblobjname "block" bn)
        (progn
          (setq ag (getangle "\nBlock rotation <0>:")) (if (= ag nil) (setq ag 0))
          (vla-startundomark (setq dc (vla-get-activedocument (vlax-get-acad-object))))
          (repeat (1- (sslength ss))
            (setq ns (vlax-ename->vla-object (ssname ss (setq n (1+ n)))) i n)
            (repeat (- (sslength ss) 1 i)
              (if (not (minusp (vlax-safearray-get-u-bound (setq lk (vlax-variant-value
                  (vla-Intersectwith ns (vlax-ename->vla-object (ssname ss
                    (setq i (1+ i)))) 0))) 1)))
                (if (not (member (setq m (vlax-safearray->list lk)) ls))
                  (progn (setq ls (cons m ls))
                    (vla-InsertBlock (vla-get-modelspace dc) (vlax-3d-point m)
                      bn 1 1 1 ag)))))
          ) (vla-endundomark dc)
        ) (alert (strcat "ERROR\n" """ bn """ " was not found"))
      )
    )
  ) (prin1)
)

(defun c:BDE (/ ss fl ls nm n bs) (vl-load-com)
  (if (setq ss (ssget (list (cons 0 "insert"))))
    (if (setq fl (getfiled "Block Data Extraction"
        (vl-filename-base (getvar 'dwgname)) "txt" 1))
      (progn
        (setq fl (open fl "w"))
        (repeat (setq n (sslength ss))
          (if (not (member (setq nm (vla-get-EffectiveName
              (vlax-ename->vla-object (ssname ss (setq n (1- n)))))) ls)) 
            (progn
              (setq ls (append ls (list nm)) s 0)
              (repeat (setq bs (sslength ss))
                (if (= (cdr (assoc 2 (entget (ssname ss (setq bs (1- bs)))))) nm)
                  (setq s (1+ s))))
              (write-line (strcat (rtos s 2 0) "  "
                (cdr (assoc 4 (tblsearch "block" nm))) "  " nm) fl)
            )
          )
        ) (close fl)     
      )
    )
  ) (princ)
)

(setq ss (ssget (list (cons 0 "insert"))))

(setq ss (ssget "_x" (list (cons 0 "insert"))))

(defun c:BDE (/ ss fl ls nm n bs) (vl-load-com)
  (if (setq ss (ssget (list (cons 0 "insert"))))
    (if (setq fl (getfiled "Block Data Extraction"
        (vl-filename-base (getvar 'dwgname)) "xls" 1))
      (progn
        (setq fl (open fl "w"))
        (repeat (setq n (sslength ss))
          (if (not (member (setq nm (vla-get-EffectiveName
              (vlax-ename->vla-object (ssname ss (setq n (1- n)))))) ls)) 
            (progn
              (setq ls (append ls (list nm)) s 0)
              (repeat (setq bs (sslength ss))
                (if (= (cdr (assoc 2 (entget (ssname ss (setq bs (1- bs)))))) nm)
                  (setq s (1+ s))))
              (write-line (strcat (cdr (assoc 4 (tblsearch "block" nm)))
                 "\t" nm "\t" (rtos s 2 0)) fl)
            )
          )
        ) (close fl)     
      )
    )
  ) (princ)
)

(defun c:bn (/ bs ts dc bn tn) (vl-load-com)
  (defun *error* (msg)
    (if (not (wcmatch (strcase msg t) "*cancel*,*exit*"))
      (princ (strcat "\nError: " msg)))
    (if bs (redraw (ssname bs 0) 4)) (setq *error* nil))
  (if (setq bs (ssget ":s" '((0 . "insert"))))
    (progn (redraw (ssname bs 0) 3)
      (if (setq ts (ssget ":s" '((0 . "*text"))))
        (progn
          (vla-startundomark (setq dc (vla-get-activedocument (vlax-get-acad-object))))
          (vla-move (setq bn (vlax-ename->vla-object (ssname bs 0))) (vlax-3d-point
            (vlax-safearray->list (vlax-variant-value (vla-get-InsertionPoint bn))))
            (vlax-3d-point (vlax-safearray->list (vlax-variant-value
            (vla-get-InsertionPoint (setq tn (vlax-ename->vla-object (ssname ts 0))))))))
          (vla-put-Rotation bn (vla-get-Rotation tn))
          (vla-endundomark dc)
        )
      ) (redraw (ssname bs 0) 4)
    )
  ) (setq *error* nil) (prin1)
)

(defun c:bh (/ sb bn ds dc nm nn) (vl-load-com)
  (if (setq sb (ssget ":s" '((0 . "insert"))))
    (progn (redraw (ssname sb 0) 3)
      (if (/= (setq bn (getstring T "\nBlock or layer name:")) "")
        (if (and (not (tblobjname "block" bn)) (not (tblobjname "layer" bn)))
          (if (setq ds (getstring T "\nBlock description:"))
            (progn
              (vla-startundomark (setq dc (vla-get-activedocument
                (vlax-get-acad-object))))
              (vla-Add (vla-get-Layers dc) bn)
              (vla-put-Layer (setq nm (vlax-ename->vla-object (ssname sb 0))) bn)
              (vla-put-Name (setq nn (vla-Item (vla-get-Blocks dc)
                (vla-get-Name nm))) bn)
              (vla-put-Comments nn ds) (vla-endundomark dc)
            )
          ) (alert (strcat "ERROR\n" """ bn """ " is already in use"))
        )
      ) (redraw (ssname sb 0) 4)
    )
  ) (princ)
)

(defun c:bh (/ sb dc nm bb bn ln ds) (vl-load-com)
  (if (setq sb (ssget ":s" '((0 . "insert") (-4 . "<not") (8 . "0") (-4 . "not>"))))
    (progn (redraw (ssname sb 0) 3)
      (setq dc (vla-get-activedocument (vlax-get-acad-object))
            nm (vlax-ename->vla-object (ssname sb 0)))
      (prompt (strcat "\nLayer name: " (vla-get-Layer nm) "\nBlock name: "
        (vla-get-Name nm) "\nBlock description: " (vla-get-Comments
        (setq bb (vla-Item (vla-get-Blocks dc) (vla-get-Name nm))))))
      (if (/= (setq ln (getstring T "\nLayer name:")) "")
        (if (not (tblobjname "layer" ln))
          (if (/= (setq bn (getstring T "\nBlock name:")) "")
            (if (not (tblobjname "block" bn))
              (if (setq ds (getstring T "\nBlock description:"))
                (progn
                  (vla-startundomark dc)
                  (vla-put-Name (vla-Item (vla-get-Layers dc) (vla-get-Layer nm)) ln)
                  (vla-put-Name bb bn) (vla-put-Comments bb ds)
                  (vla-endundomark dc)
                )
              ) (alert (strcat "ERROR\n" bn " is already in use"))
            )
          ) (alert (strcat "ERROR\n" ln " is already in use"))
        )
      ) (redraw (ssname sb 0) 4)
    )
  ) (princ)
)