Leaderboard

Very, very fast 'on the fly' coding, but seems it works. If you need also add Constant attributes tell me. (defun c:attmt(/ aDoc aSp oSiz bSet aLst cLst tStr nTxt bCtr Tags TextInsert) [color="#0000ff"] ; ***************************************************************************** ; ADJUSTMENTS ; ; (Modify it to adjust for your own requirements) ; ; ***************************************************************************** (setq Tags T) ; - if T add tags to MText if Nil not (setq TextInsert T) ; - Text insertion point. If T center of Bounding Box ; of block, if Nil Block insertion point. ; ******************************* END ADJUSTMENTS *****************************[/color] (vl-load-com) (defun GetBoundingCenter (vlaObj / blPt trPt cnPt) (vla-GetBoundingBox vlaObj 'minPt 'maxPt) (setq blPt(vlax-safearray->list minPt) trPt(vlax-safearray->list maxPt) cnPt(vlax-3D-point (list (+(car blPt)(/(-(car trPt)(car blPt))2)) (+(cadr blPt)(/(-(cadr trPt)(cadr blPt))2)) 0.0 ); end list ); end vlax-3D-point ); end setq ); end of GetBoundingCenter (if(not attmt:Size)(setq attmt:Size(getvar "TEXTSIZE"))) (setq oSiz attmt:Size attmt:Size(getreal(strcat "\nText size <"(rtos attmt:Size)">: "))) (if(null attmt:Size)(setq attmt:Size oSiz)) (setq aDoc(vla-get-ActiveDocument(vlax-get-acad-object))) (if(= 1(vla-get-ActiveSpace aDoc)) (setq aSp(vla-get-ModelSpace aDoc)) (setq aSp(vla-get-PaperSpace aDoc)) ); end if (princ "\n<<< Select text to extract attributes to MText >>> ") (if(setq bSet(ssget '((0 . "INSERT")))) (progn (foreach b(mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr(ssnamex bSet)))) (setq aLst '() tStr "") ; end setq (if TextInsert (setq bCtr(GetBoundingCenter b)) (setq bCtr(vla-get-InsertionPoint b)) ); end if (if(= :vlax-true(vla-get-HasAttributes b)) (progn (setq aLst (mapcar '(lambda (a) (list (vla-get-TagString a) (vla-get-TextString a))) (vlax-safearray->list (vlax-variant-value(vla-GetAttributes b))))) (foreach i(reverse aLst) (setq tStr(strcat tStr(if Tags(strcat(car i) ": ")"")(last i)"\\P")) ); end foreach (if(/= "" tStr) (progn (setq nTxt(vla-AddMText aSp bCtr (* attmt:Size 30.0) tStr)) (vla-put-Height nTxt attmt:Size) ); end progn ); end if ); end progn ); end if ); end foreach (vla-EndUndoMark aDoc) ); end progn ); end if (princ) ); end of c:attmt Edit. Size of MText now works.