Leaderboard

Hopefully not 7 years too late... (defun c:unfold ( / ang bpt ent lst ocs par ) (while (progn (setvar 'errno 0) (setq ent (car (entsel))) (cond ( (= 7 (getvar 'errno)) (princ "\nMissed, try again.") ) ( (null ent) nil ) ( (or (vl-catch-all-error-p (setq par (vl-catch-all-apply 'vlax-curve-getendparam (list ent)))) (null par)) (princ "\nInvalid object selected.") ) ) ) ) (if (and (= 'ename (type ent)) (setq bpt (getpoint "\nSpecify base point: ")) (setq ang (getangle "\nSpecify line direction: " bpt)) ) (progn (setq ocs (trans '(0 0 1) 1 0 t)) (if (wcmatch (cdr (assoc 0 (entget ent))) "*POLYLINE") (repeat (setq par (fix (+ 1e-8 par))) (setq lst (cons (cons 010 (trans (polar bpt ang (vlax-curve-getdistatparam ent par)) 1 ocs)) lst) par (1- par) ) ) (setq lst (list (cons 010 (trans (polar bpt ang (vlax-curve-getdistatparam ent (vlax-curve-getendparam ent))) 1 ocs)))) ) (entmake (append (list '(000 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 090 (1+ (length lst))) '(070 . 0) ) (cons (cons 010 (trans bpt 1 ocs)) lst) (list (cons 210 ocs)) ) ) ) ) (princ) ) The above should work with any curve object of finite length.

The upgrade to the forum software a couple of years ago unfortunately caused all instances of "8)" to be removed from code snippets, breaking thousands of examples - I've now edited my earlier post and have corrected the above code.

Here is the final lisp, I've added the option for the user to choose if to add the background mask or not. ;;------------------------------------ DIMLP.LSP - label lines (Pipes) with detailed layer name---------------------------------;; ;; fixo () 2012 * all rights released ;; edited 3/3/12 ;; label lines (Pipes) with layer name (defun C:DIMLPDET_UPDATE2(/ *error* acsp adoc ang curve deriv en mid mp ppt1 ppt2 prex sset txh txt txt1 txt2 txtln txtpt1 insut LAYERNAME offst pipetype pipepn a theMText) (vl-load-com) (setq mspace (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))) (defun *error* (msg) (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)) ) (cond ((or (not msg) (member msg '("console break" "Function cancelled" "quit / exit abort")) ) ) ((princ (strcat "\nError: " msg))) ) (princ) ) (initget "Current Pipe") (if (null (setq YN (getkword "\nChoose Text Layer [Current/Pipe] <Pipe>: "))) (setq YN "Pipe") ) (initget "Yes No") (if (null (setq Bg (getkword "\nAdd Text Background [Yes/No] <No>: "))) (setq Bg "No") ) (setq ht (getreal "\nSet Length factor (If Drawing Units mm-Set 1000, If Drawig Units m-Set 1)<1000>: ")) (if (= ht nil) (setq ht (atof "1000")) ) (setq ht (/ 1 ht)) (setq txh1 (getreal "\nEnter text height<36>: ")) (if (= txh1 nil) (setq txh1 36) ) (setq pipetype (getstring T "\nPipe Type<PVC PIPE>: ")) (if (= pipetype "") (setq pipetype "PVC PIPE") ) (setq a (substr " " 1 1)) (setq pipetype (strcat pipetype a)) ; (setq pipepn (strcase (getstring "\nPipe Type</6>: "))) ; (if (= pipepn "") ; (setq pipepn "/6") ; ) (setq offst (/ txh1 2)) (setq insut (getvar "insunits")) (setq adoc (vla-get-activedocument (vlax-get-acad-object)) acsp (vla-get-block(vla-get-activelayout adoc))) (vla-startundomark adoc ) (setq txh txh1 prex (getvar "dimdec") ) (while (not sset) (setq sset (ssget '((0 . "*LINE"))) ) ) (while (setq en (ssname sset 0)) (setq curve (vlax-ename->vla-object en)) ;;(setq txt1 (rtos (vla-get-length curve) 2 2)) (setq txtln (if (= (getvar "measurement") 0) (rtos (vla-get-length curve) 3 2) (rtos (vla-get-length curve) 2 2)) ) (setq txtln (atof txtln)) (setq txtln (rtos (* txtln ht) 2 2)) (setq LAYERNAME (vla-get-layer curve)) (setq mid (/ (abs (- (vlax-curve-getendparam curve) (vlax-curve-getstartparam curve))) 2.) mp (vlax-curve-getpointatparam curve mid) deriv (vlax-curve-getfirstderiv curve (vlax-curve-getparamatpoint curve mp)) ) (if (zerop (cadr deriv)) (setq ang 0) (setq ang (- (/ pi 2) (atan (/ (car deriv) (cadr deriv))))) ) (if (< (/ pi 2) ang (* pi 1.5)) (setq ang (+ pi ang)) ) ;;; (setq ppt1 (polar mp (+ ang (/ pi 2)) (* txh 0.5)) ;;; ) (setq ppt1 (polar mp (+ ang (/ pi 2)) offst) ) (setq txtpt1 (vlax-3d-point (trans ppt1 1 0))) ;;; (setq txt1 (vla-addtext acsp txt txtpt1 txh)) ;(setq txt (strcat LAYERNAME pipepn)) (setq txt (strcat LAYERNAME " L=" (strcat txtln "m"))) (setq txt (vl-string-subst pipetype "P_" txt)) (setq txt (vl-string-subst "/" "-" txt)) (setq theMText (vla-AddMText mspace txtpt1 (atof "0") txt)) (vla-put-AttachmentPoint theMText acBottomCenter) ;;(vla-put-alignment theMText acAlignmentBottomCenter) ;;(vla-put-textalignmentpoint theMText txtpt1) ;;(vla-put-insertionpoint theMText (vla-get-textalignmentpoint theMText)) (vla-put-rotation theMText ang) (vla-put-Height theMText txh) (if (= Bg "Yes") (progn (vla-put-backgroundfill theMText :vlax-true) (setq dxf_ent (entget (entlast))) (entmod (append dxf_ent '((90 . 1) (63 . 254) (45 . 1.1) (441 . 0)))) ) ) (if (= YN "Pipe") (vlax-put-property theMText 'layer LAYERNAME) ) ;(setq txt1 (vla-addtext acsp txt txtpt1 txh)) ;(vla-put-alignment txt1 acAlignmentBottomCenter) ;(vla-put-textalignmentpoint txt1 txtpt1) ;(vla-put-insertionpoint txt1 (vla-get-textalignmentpoint txt1)) ; (vla-put-rotation txt1 ang) ;(if (= YN "Pipe") ; (vlax-put-property txt1 'layer LAYERNAME) ; ) (ssdel en sset) ) (*error* nil) (princ) ) (princ "\n\t---\tStart command with \"DIMLPDET\"\t---") (princ) (or (vl-load-com) (princ)) ;;------------------------------------ code end ----------------------------------;;

@Steven P TANKS!!!!!!! works like a charm! I've changed the color (dxf code 63) from code 8 to 254 and border offset factor (dxf code 45) 1.2... (setq dxf_ent (entget (entlast))) (entmod (append dxf_ent '((90 . 1) (63 . 254) (45 . 1.2) (441 . 0)))) thanks again, Ari.

Would this work? (from https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/mtext-background-mask-settings-lisp/td-p/5998702) Add this in after you have created each mtext or go back to the link above and do it by selection set (setq dxf_ent (entget (entlast)) (entmod (append dxf_ent '((90 . 1) (63 . 8) (45 . 1.1) (441 . 0))))