Need help to add mask to text in a lisp that adds text to multiple lines (change to mtext?)

[aridzv]

Hi.

I have a lisp (see attached) that adds text to multiple lines with loop.

I need to add mask to those texts.

I'm looking for a way to use Mtext instead text in the lisp,

and then add mask.

how do I change it from text to mtext...?

thanks,

Ari.

 

;------------------------------------ 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_UPDATE(/ *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)
  
    (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")
  )

  (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 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 ----------------------------------;;

 

Edited June 2, 2022 by aridzv

[exceed]

5 minutes ago, aridzv said:

Hi.

I have a lisp (see attached) that adds text to multiple lines with loop.

I need to add mask to those texts.

I'm looking for a way to use Mtext instead text in the lisp,

and then add mask.

how do I change it from text to mtext...?

thanks,

Ari.

 

;------------------------------------ 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_UPDATE(/ *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)
  
    (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")
  )

  (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 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 ----------------------------------;;

 

 

 

like this?

 

Edited June 2, 2022 by exceed

[aridzv]

Hi @exceed and thanks for the answer.

the code above is a bit to complicate for me...

I was thinking of taking the piece of code that creates text (see below) and replacing it with code that creates Mtext and add a mask to it:

;;***IS IT POSSIBLE TO REPLACE TEXT WITH MTEXT IN THE CODE BELOW?***

(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)
  )

;; Add Mask to Mtext (?)

 

thanks,

Ari.

[aridzv]

Hi.

I've made some progress with the lisp - I manage to insert the Mtext and give it its rotation,assign it to lines layers, get the aligment and add mask.

The last two things I fail to accomplish are:

1. I need to toggle the "Use Drawing Background Color" off.

2. Set the Fill color number (in my case I need 254...) 

 

here below is the updated code I've made so far, I will appreciate any help on the mask issue... 

thanks...

;;------------------------------------ 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)

(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")
  )

  (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)
(vla-put-backgroundfill theMText :vlax-true)
            
 (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 ----------------------------------;;

 

Edited June 6, 2022 by aridzv

[Steven P]

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))))

 

[aridzv]

@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.

[aridzv]

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 ----------------------------------;;

 

Edited June 6, 2022 by aridzv