Jump to content

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


aridzv

Recommended Posts

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 by aridzv
Link to comment
Share on other sites

  • aridzv changed the title to Need help to add mask to text in a lisp that adds text to multiple lines (change to mtext?)
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 by exceed
Link to comment
Share on other sites

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.

Link to comment
Share on other sites

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 by aridzv
Link to comment
Share on other sites

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

 

  • Like 1
  • Thanks 1
Link to comment
Share on other sites

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

  • Like 1
Link to comment
Share on other sites

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 by aridzv
  • Like 2
Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...