(defun VALUE (num ent /)
  (cdr (assoc num ent))
)

(defun c:AddExtraAtt (/ *error* CreatAtt ActDoc Sel EntData tmpEnt flag Sel2 InsPt Ht Rot Tag Str Just tmpOpt
    Just72 Just73 tmpEntData entmakeList Lay Wid LastAttTag tmpNum NewTagDft Num Sty)
    
    ; Add attributes until you hit enter to an existing block, while keeping the original attributes.
    ; Tim Willey 12/2005
    ; Sub's 'CreateAtt 'value '*error*
    ; Thanks to Jeff Mishler and Kerry Brown at www.theswamp.org for their input.
    
    (defun *error* (msg)
        (princ msg)
        (vla-EndUndoMark ActDoc)
        (if Sel
            (redraw (car Sel) 4)
        )
    )
    
    (defun CreateAtt (Tag Str InsPt Just72 Just74 Ht Rot Sty Lay Wid / )
        
        (list
            (cons 0 "ATTRIB")
            (cons 100 "AcDbEntity")
            (cons 8 Lay)
            (cons 6 "ByBlock")
            (cons 62 256)
            (cons 100 "AcDbText")
            (cons 10 InsPt)
            (cons 40 Ht)
            (cons 1 Str)
            (cons 50 Rot)
            (cons 41 Wid)
            (cons 7 Sty)
            (cons 72 Just72)
            (cons 11 InsPt)
            (cons 100 "AcDbAttribute")
            (cons 2 Tag)
            (cons 70 0)
            (cons 74 Just74)
        )
    )
    
    (setq ActDoc (vla-get-ActiveDocument (vlax-get-Acad-Object)))
    (vla-EndUndoMark ActDoc)
    (vla-StartUndoMark ActDoc)
    (setq Num 1)
    (while
        (and
            (if Sel
                T
                (setq Sel (entsel "\n Select block to add attribute to: "))
            )
            (setq EntData (entget (car Sel) '("*")))
            (= (value 0 EntData) "INSERT")
            (not (redraw (car Sel) 3))
            (setq entmakeList
                (list
                    (if (not (assoc 66 EntData))
                        (append EntData (list (cons 66  1)))
                        EntData
                    )
                )
            )
            (setq tmpEnt (car Sel))
            (if
                (and
                    (entnext tmpent)
                    (= (cdr (assoc 0 (entget (entnext tmpent)))) "ATTRIB")
                )
                (while (/= (value 0 (entget (setq tmpEnt (entnext tmpEnt)))) "SEQEND")
                    (setq entmakeList (cons (setq EntData (entget tmpEnt)) entmakeList))
                    (setq LastAttTag (cdr (assoc 2 EntData)))
                    (if
                        (and
                            (wcmatch (strcase LastAttTag) "EXTRA LINE*")
                            (>= (setq tmpNum (atoi (substr LastAttTag 11))) Num)
                        )
                        (setq Num (1+ tmpNum))
                        T
                    )
                )
                (setq flag T)
            )
            (setq NewTagDft
                (strcat "EXTRA LINE"
                    (if (< Num 10)
                        (strcat "0" (itoa Num))
                        (itoa Num)
                    )
                )
            )
            (not (initget "Type"))
            (setq Sel2 (nentsel "\n Select existing attribute to match, or Type in attribute properties: "))
            (if (= Sel2 "Type")
                (progn
                    (setq InsPt (getpoint "\n Select insertion point: "))
                    (setq Ht (getdist "\n Height of attribute: "))
                    (setq Rot (getangle "\n Rotation of attribute: "))
                    (/= (setq Tag (getstring T "\n Enter tag value: ")) "")
                    (/= (setq Str (getstring T "\n Enter displayed value: ")) "")
                    (not (initget "L C R M TL TC TR ML MC MR BL BC BR"))
                    (setq Just
                        (if (setq tmpOpt (getkword "\n Justification [<L>/C/R/M/TL/TC/TR/ML/MC/MR/BL/BC/BR]: "))
                            tmpOpt
                            "L"
                        )
                    )
                    (cond
                        ((= Just "L")
                            (setq Just72 0)
                            (setq Just74 0)
                        )
                        ((= Just "C")
                            (setq Just72 1)
                            (setq Just74 0)
                        )
                        ((= Just "R")
                            (setq Just72 2)
                            (setq Just74 0)
                        )
                        ((= Just "M")
                            (setq Just72 4)
                            (setq Just74 0)
                        )
                        ((= Just "TL")
                            (setq Just72 0)
                            (setq Just74 3)
                        )
                        ((= Just "TC")
                            (setq Just72 1)
                            (setq Just74 3)
                        )
                        ((= Just "TR")
                            (setq Just72 2)
                            (setq Just74 3)
                        )
                        ((= Just "ML")
                            (setq Just72 0)
                            (setq Just74 2)
                        )
                        ((= Just "MC")
                            (setq Just72 1)
                            (setq Just74 2)
                        )
                        ((= Just "MR")
                            (setq Just72 2)
                            (setq Just74 2)
                        )
                        ((= Just "BL")
                            (setq Just72 0)
                            (setq Just74 1)
                        )
                        ((= Just "BC")
                            (setq Just72 1)
                            (setq Just74 1)
                        )
                        ((= Just "BR")
                            (setq Just72 2)
                            (setq Just74 1)
                        )
                    )
                    (setq Sty (getvar 'TextStyle))
                )
                (progn
                    (setq tmpEntData (entget (car Sel2)))
                    (setq Just72 (value 72 tmpEntData))
                    (setq Just74 (value 74 tmpEntData))
                    (setq Ht (value 40 tmpEntData))
                    (setq Rot (value 50 tmpEntData))
                    (setq Lay (value 8 tmpEntData))
                    (setq Wid (value 41 tmpEntData))
                    (setq Sty (value 7 tmpEntData))
                    (not (initget "Under Above"))
                    (setq InsPt
                        (cond
                            ((getpoint "\n Select insertion point, or [Under/Above] selected attribute <Under>: "))
                            (t "Under")
                        )
                    )
                    (if (not (equal (type InsPt) 'LIST))
                        (setq InsPt
                            (polar
                                (value
                                    (if (and (equal (value 72 tmpEntData) 0.0) (equal (value 74 tmpEntData) 0.0))
                                        10
                                        11
                                    )
                                    tmpEntData
                                )
                                (rem
                                    (+
                                        Rot
                                        (if (= InsPt "Under")
                                            (* pi 1.5)
                                            (* pi 0.5)
                                        )
                                    )
                                    (* pi 2.)
                                )
                                (DefaultTextSpacing (value 7 tmpEntData) Ht)
                            )
                        )
                    )
                    (if (= (setq Tag (getstring T (strcat "\n Enter tag value <" NewTagDft ">: "))) "")
                        (setq Tag NewTagDft)
                        Tag
                    )
                    (/= (setq Str (getstring T "\n Enter displayed value: ")) "")
                )
            )
        )
        (if (not Lay)
            (setq Lay "0")
        )
        (if (not Wid)
            (setq Wid 1.0)
        )
        (setq entmakeList (cons (CreateAtt Tag Str InsPt Just72 Just74 Ht Rot Sty Lay Wid) entmakeLIst))
        (mapcar 'entmake (reverse entmakeList))
        (if flag
            (entmake
                (list
                    (cons 0 "SEQEND")
                    (cons 100 "AcDbEntity")
                    (cons 8 (value 8 EntData))
                )
            )
            (entmake (setq EntData (entget tmpEnt)))
        )
        (entdel (car Sel))
        (setq Sel (cons (entlast) Sel))
        (redraw (car Sel) 3)
    )
    (if Sel
        (redraw (car Sel) 4)
    )
    (vla-EndUndoMark ActDoc)
    (princ)
)