Multi Taging on Structural Frames

;; COMMAND C:MTC(MULTI TAG CODE)
;; 1SG1_H-~~~ -> PLINE(OBJECT'S LAYER)+1SG1(COLOR BYBLOCK)
;;======= KM MODULE: TAG A BLOCK NAME ======
(defun KM:TGB ( _BS / cl ss bb bl bname _midpoint sp tp)
(setq cl (getvar "CLAYER"))
;(setq ss (ssget '((0 . "insert"))))
(setq bb _BS)
;(setq bb (ssname ss 0))
(setq bl (cdr (assoc 8 (entget bb))))
(setq bname (vla-get-effectivename (vlax-ename->vla-object bb)))
(setq _midpoint (KM:MoB bb))
(setq sp (list (car _midpoint) (cadr _midpoint) 0.0))
(setvar "CLAYER" bl)
(command "_.pline" "non" sp "non" "@200,-1200" "non" "@200,0" "")
(setq tp (getvar "lastpoint"))
(setq horJust 0 verJust 2) ;justifify MidLeft
(setq tag_block 
(list (cons 0 "TEXT") 
(cons 1 bname) 
(cons 7 "Standard") 
(cons 8 bl) 
(cons 10 tp) 
(cons 11 tp) 
(cons 71 0) 
(cons 72 horJust) 
(cons 73 verJust) 
(cons 40 100)))
(entmake tag_block)
(setvar "CLAYER" cl)
(princ)
)

;;======= MULTI TAGS BLOCK NAME ======
(defun c:MTG ()
(if (setq bls (ssget '((0 . "INSERT"))))
(progn
(setq len (sslength bls))
(setq n 0)
(repeat len
(setq _BS (ssname bls n))
(KM:TGB _BS)
(setq n (1+ n))
)))
(princ)
)

;;======= KM MODULE: TAG A BLOCK CODE ======
(defun KM:TGBC ( _BS / cl ss bb bl bname cname _midpoint sp tp)
(setq cl (getvar "CLAYER"))
;(setq ss (ssget '((0 . "insert"))))
(setq bb _BS)
;(setq bb (ssname ss 0))
(setq bl (cdr (assoc 8 (entget bb))))
(setq bname (vla-get-effectivename (vlax-ename->vla-object bb)))
(setq cname (car (SplitStr bname "_")))
(setq _midpoint (KM:MoB bb))
(setq sp (list (car _midpoint) (cadr _midpoint) 0.0))
(setvar "CLAYER" bl)
(command "_.pline" "non" sp "non" "@200,-1200" "non" "@200,0" "")
(setq tp (getvar "lastpoint"))
(setq horJust 0 verJust 2) ;justify MidLeft
(setq tag_block 
(list (cons 0 "TEXT") 
(cons 1 cname) 
(cons 7 "Standard") 
(cons 8 bl) 
(cons 10 tp) 
(cons 11 tp) 
(cons 62 0); COLOR 0=BYBLOCK, 256=BYLAYER
(cons 71 0) 
(cons 72 horJust) 
(cons 73 verJust) 
(cons 40 200)))
(entmake tag_block)
(setvar "CLAYER" cl)
(princ)
)

;;; s = string d = delimiter p = position delimiter (thanx Lee Mac)
(defun SplitStr ( s d / p )
  (if (setq p (vl-string-search d s))
    (cons (substr s 1 p) (SplitStr (substr s (+ p 1 (strlen d))) d)) (list s)))


;;======= MULTI TAGS BLOCK CODE ======
(defun c:MTC ()
(if (setq bls (ssget '((0 . "INSERT"))))
(progn
(setq len (sslength bls))
(setq n 0)
(repeat len
(setq _BS (ssname bls n))
(KM:TGBC _BS)
(setq n (1+ n))
)))
(princ)
)