Jump to content

Text to Mtext lisp- add background mask?


mawelby

Recommended Posts

This is the first time I have ventured into the world of .lsp and code and need some guidance.

 

I have the code below and it works very well in changing text to mtext but in not combining the text into one mtext block. What I need to achieve is to have this code also add a clear background mask with a margin of 1 and then bringing to the front in the draw order. If someone could point me to a good resource to learn how to do this it would be much appreciated.

 

(defun c:t2m (/ sset count num en el mcontent bbox point1 point2 point3 point4 mwidth mheight mstyle njust mrotate nmtext)
(setvar "cmdecho" 0)
(setq sset (ai_aselect))
(if (null sset)
	(progn
		(princ "\nNo objects selected.")
		(exit)
	)
)
(setq count 0)
(while (/= (ssname sset COUNT) nil)
	(setq EN (ssname sset COUNT))
	(setq EL (entget EN))
	(if (= (cdr (assoc 0 EL)) "TEXT")
		(progn
			(setq mcontent (cons '1 (strcase (cdr (assoc 1 el)))))
			(setq bbox (acet-geom-textbox EL 0.1))
			(setq point1 (car bbox))
			(setq point2 (cadr bbox))
			(setq point3 (cadr (cdr bbox)))
			(setq point4 (cadr (cdr (cdr bbox))))
			(setq mwidth (cons '41 (distance point1 point2)))
			(setq mheight (cons '40 (cdr (assoc 40 el))))
			(setq mstyle (cons '7 (cdr (assoc 7 el))))
			(setq nspace (cons '410 (cdr (assoc 410 EL))))
			(setq minsert (cons '10 (cdr (assoc 10 EL))))
			(cond
				((and (= (cdr (assoc 72 el)) 0)(= (cdr (assoc 73 el)) 3))(setq NJUST (cons '71 1)));JY
				((and (= (cdr (assoc 72 el)) 1)(= (cdr (assoc 73 el)) 3))(setq NJUST (cons '71 2)));JU
				((and (= (cdr (assoc 72 el)) 2)(= (cdr (assoc 73 el)) 3))(setq NJUST (cons '71 3)));JI
				((and (= (cdr (assoc 72 el)) 0)(= (cdr (assoc 73 el)) 2))(setq NJUST (cons '71 7)));JN
				((and (= (cdr (assoc 72 el)) 1)(= (cdr (assoc 73 el)) 2))(setq NJUST (cons '71 7)));JN
				((and (= (cdr (assoc 72 el)) 2)(= (cdr (assoc 73 el)) 2))(setq NJUST (cons '71 6)));JK
				((and (= (cdr (assoc 72 el)) 0)(= (cdr (assoc 73 el)) 0))(setq NJUST (cons '71 7)));JN
				((and (= (cdr (assoc 72 el)) 4)(= (cdr (assoc 73 el)) 0))(setq NJUST (cons '71 7)));JN
				((and (= (cdr (assoc 72 el)) 0)(= (cdr (assoc 73 el)) 1))(setq NJUST (cons '71 7)));JN
				((and (= (cdr (assoc 72 el)) 1)(= (cdr (assoc 73 el)) 0))(setq NJUST (cons '71 7)));JN
				((and (= (cdr (assoc 72 el)) 1)(= (cdr (assoc 73 el)) 1))(setq NJUST (cons '71 ));JM
				((and (= (cdr (assoc 72 el)) 2)(= (cdr (assoc 73 el)) 1))(setq NJUST (cons '71 9)));J,
				((and (= (cdr (assoc 72 el)) 2)(= (cdr (assoc 73 el)) 0))(setq NJUST (cons '71 7)));JN
			)
			(setq mrotate (cons '50 (cdr (assoc 50 el))))
			(setq nmtext (list '(0 . "MTEXT") '(100 . "AcDbEntity") '(67 . 0) nspace '(8 . "TEXT") '(100 . "AcDbMText") minsert njust mheight mwidth mstyle mcontent mrotate))
			(entmake nmtext)
			(entdel en)
			(setq count (+ count 1))
		)
		(setq count (+ count 1))
	)
)
(setvar "cmdecho" 1)(princ)
)

Link to comment
Share on other sites

Try it

(defun c:t2m (/ sset count num en el mcontent bbox point1 point2 point3 point4 mwidth mheight mstyle njust mrotate nmtext ss)
(setvar "cmdecho" 0)
(setq sset (ai_aselect))
(if (null sset)
	(progn
		(princ "\nNo objects selected.")
		(exit)
	)
)
(setq count 0 ss (ssadd))
(while (ssname sset COUNT)
	(setq EN (ssname sset COUNT))
	(setq EL (entget EN))
	(if (= (cdr (assoc 0 EL)) "TEXT")
		(progn
			(setq mcontent (cons '1 (strcase (cdr (assoc 1 el)))))
			(setq bbox (acet-geom-textbox EL 0.1))
			(setq point1 (car bbox))
			(setq point2 (cadr bbox))
			(setq point3 (cadr (cdr bbox)))
			(setq point4 (cadr (cdr (cdr bbox))))
			(setq mwidth (cons '41 (distance point1 point2)))
			(setq mheight (cons '40 (cdr (assoc 40 el))))
			(setq mstyle (cons '7 (cdr (assoc 7 el))))
			(setq nspace (cons '410 (cdr (assoc 410 EL))))
			(setq minsert (cons '10 (cdr (assoc 10 EL))))
			(cond
				((and (= (cdr (assoc 72 el)) 0)(= (cdr (assoc 73 el)) 3))(setq NJUST (cons '71 1)));JY
				((and (= (cdr (assoc 72 el)) 1)(= (cdr (assoc 73 el)) 3))(setq NJUST (cons '71 2)));JU
				((and (= (cdr (assoc 72 el)) 2)(= (cdr (assoc 73 el)) 3))(setq NJUST (cons '71 3)));JI
				((and (= (cdr (assoc 72 el)) 0)(= (cdr (assoc 73 el)) 2))(setq NJUST (cons '71 7)));JN
				((and (= (cdr (assoc 72 el)) 1)(= (cdr (assoc 73 el)) 2))(setq NJUST (cons '71 7)));JN
				((and (= (cdr (assoc 72 el)) 2)(= (cdr (assoc 73 el)) 2))(setq NJUST (cons '71 6)));JK
				((and (= (cdr (assoc 72 el)) 0)(= (cdr (assoc 73 el)) 0))(setq NJUST (cons '71 7)));JN
				((and (= (cdr (assoc 72 el)) 4)(= (cdr (assoc 73 el)) 0))(setq NJUST (cons '71 7)));JN
				((and (= (cdr (assoc 72 el)) 0)(= (cdr (assoc 73 el)) 1))(setq NJUST (cons '71 7)));JN
				((and (= (cdr (assoc 72 el)) 1)(= (cdr (assoc 73 el)) 0))(setq NJUST (cons '71 7)));JN
				((and (= (cdr (assoc 72 el)) 1)(= (cdr (assoc 73 el)) 1))(setq NJUST (cons '71 ));JM
				((and (= (cdr (assoc 72 el)) 2)(= (cdr (assoc 73 el)) 1))(setq NJUST (cons '71 9)));J,
				((and (= (cdr (assoc 72 el)) 2)(= (cdr (assoc 73 el)) 0))(setq NJUST (cons '71 7)));JN
			)
			(setq mrotate (cons '50 (cdr (assoc 50 el))))
			(setq nmtext (list '(0 . "MTEXT") '(100 . "AcDbEntity") '(67 . 0) nspace '(8 . "TEXT") '(100 . "AcDbMText") minsert njust mheight mwidth mstyle mcontent mrotate))
			[color="Red"](ssadd
                                 (mip-mtext-mask (entmakex nmtext) t)
                                 ss
                                 )[/color]
			(entdel en)
			(setq count (+ count 1))
		)
		(setq count (+ count 1))
	)
)
 (if (> (sslength ss) 0)(command "_draworder" ss "" "_F"))
(setvar "cmdecho" 1)(princ)
)
(defun mip-mtext-mask (ent OnOff / ed)
;;; ent -mtext ename
;;; OnOff - t - on mtext mask
;;; nil - off (unmask mtext)

 (setq ed (vl-remove-if
            '(lambda (x) (member (car x) '(90 63 421 45 441)))
            (entget ent)
          ) ;_ end of vl-remove-if
 ) ;_ end of setq
 (if OnOFF
   (setq ed (append ed
                    '((90 . 3)
                      (63 . 9)
                      (421 . 13158600)
                      (45 . 1.01) 
                      (441 . 6042092)
                     )
            ) ;_ end of append
   ) ;_ end of setq
   (setq ed (append ed '((90 . 2))))
 ) ;_ end of if
 (entmod ed)
 (entupd ent)
)

Link to comment
Share on other sites

Thanks, but getting the following error when running your lisp:

 

; error: bad character read (octal): 0

 

Any idea why?

Link to comment
Share on other sites

I dont think the dwg matters. The error is with the loading of the lisp, not the running of it. Sorry for confusion.

 

This is the command line text (with t2m2.lsp being you code from your first post):

 

Command: appload

t2m2.lsp successfully loaded.

Command: ; error: bad character read (octal): 0

Link to comment
Share on other sites

I think I have got all the Russian text removed, but still getting the error when loading:

 

(defun c:t2m (/ sset count num en el mcontent bbox point1 point2 point3 point4 mwidth mheight mstyle njust mrotate nmtext ss)
(setvar "cmdecho" 0)
(setq sset (ai_aselect))
(if (null sset)
	(progn
		(princ "\nNo objects selected.")
		(exit)
	)
)
(setq count 0 ss (ssadd))
(while (ssname sset COUNT)
	(setq EN (ssname sset COUNT))
	(setq EL (entget EN))
	(if (= (cdr (assoc 0 EL)) "TEXT")
		(progn
			(setq mcontent (cons '1 (strcase (cdr (assoc 1 el)))))
			(setq bbox (acet-geom-textbox EL 0.1))
			(setq point1 (car bbox))
			(setq point2 (cadr bbox))
			(setq point3 (cadr (cdr bbox)))
			(setq point4 (cadr (cdr (cdr bbox))))
			(setq mwidth (cons '41 (distance point1 point2)))
			(setq mheight (cons '40 (cdr (assoc 40 el))))
			(setq mstyle (cons '7 (cdr (assoc 7 el))))
			(setq nspace (cons '410 (cdr (assoc 410 EL))))
			(setq minsert (cons '10 (cdr (assoc 10 EL))))
			(cond
				((and (= (cdr (assoc 72 el)) 0)(= (cdr (assoc 73 el)) 3))(setq NJUST (cons '71 1)));JY
				((and (= (cdr (assoc 72 el)) 1)(= (cdr (assoc 73 el)) 3))(setq NJUST (cons '71 2)));JU
				((and (= (cdr (assoc 72 el)) 2)(= (cdr (assoc 73 el)) 3))(setq NJUST (cons '71 3)));JI
				((and (= (cdr (assoc 72 el)) 0)(= (cdr (assoc 73 el)) 2))(setq NJUST (cons '71 7)));JN
				((and (= (cdr (assoc 72 el)) 1)(= (cdr (assoc 73 el)) 2))(setq NJUST (cons '71 7)));JN
				((and (= (cdr (assoc 72 el)) 2)(= (cdr (assoc 73 el)) 2))(setq NJUST (cons '71 6)));JK
				((and (= (cdr (assoc 72 el)) 0)(= (cdr (assoc 73 el)) 0))(setq NJUST (cons '71 7)));JN
				((and (= (cdr (assoc 72 el)) 4)(= (cdr (assoc 73 el)) 0))(setq NJUST (cons '71 7)));JN
				((and (= (cdr (assoc 72 el)) 0)(= (cdr (assoc 73 el)) 1))(setq NJUST (cons '71 7)));JN
				((and (= (cdr (assoc 72 el)) 1)(= (cdr (assoc 73 el)) 0))(setq NJUST (cons '71 7)));JN
				((and (= (cdr (assoc 72 el)) 1)(= (cdr (assoc 73 el)) 1))(setq NJUST (cons '71 ));JM
				((and (= (cdr (assoc 72 el)) 2)(= (cdr (assoc 73 el)) 1))(setq NJUST (cons '71 9)));J,
				((and (= (cdr (assoc 72 el)) 2)(= (cdr (assoc 73 el)) 0))(setq NJUST (cons '71 7)));JN
			)
			(setq mrotate (cons '50 (cdr (assoc 50 el))))
			(setq nmtext (list '(0 . "MTEXT") '(100 . "AcDbEntity") '(67 . 0) nspace '(8 . "TEXT") '(100 . "AcDbMText") minsert njust mheight mwidth mstyle mcontent mrotate))
			(ssadd
                                 (mip-mtext-mask (entmakex nmtext) t)
                                 ss
                                 )
			(entdel en)
			(setq count (+ count 1))
		)
		(setq count (+ count 1))
	)
)
 (if (> (sslength ss) 0)(command "_draworder" ss "" "_F"))
(setvar "cmdecho" 1)(princ)
)
(defun mip-mtext-mask (ent OnOff / ed)
;;; ent -mtext ename
;;; OnOff - t - on mtext mask
;;; nil - off (unmask mtext)

 (setq ed (vl-remove-if
            '(lambda (x) (member (car x) '(90 63 421 45 441)))
            (entget ent)
          ) ;_ end of vl-remove-if
 ) ;_ end of setq
 (if OnOFF
;;;
   (setq ed (append ed
                    '((90 . 3)
                      (63 . 9)
                      (421 . 13158600)
                      (45 . 1.01)
                      (441 . 6042092)
                     )
            ) ;_ end of append
   ) ;_ end of setq
   (setq ed (append ed '((90 . 2))))
 ) ;_ end of if
 (entmod ed)
 (entupd ent)
)

Link to comment
Share on other sites

I do not know. This code works for me. I made some changes. Try the new version.

(defun c:t2m (/        sset     count    num      en       el
             mcontent bbox     point1   point2   point3   point4
             mwidth   mheight  mstyle   njust    mrotate  nmtext
             ss
            )
 (vl-load-com)
 (setvar "cmdecho" 0)
 (if (setq sset (ssget "_:L" '((0 . "TEXT"))))
 (progn  
 (setq count 0
       ss    (ssadd)
 ) ;_ end of setq
 (while (ssname sset COUNT)
   (setq EN (ssname sset COUNT))
   (setq EL (entget EN))
   (if (= (cdr (assoc 0 EL)) "TEXT")
     (progn
       (setq mcontent (cons '1 (strcase (cdr (assoc 1 el)))))
       (setq EL (subst mcontent(assoc 1 EL) EL))
       (setq bbox (acet-geom-textbox EL 0.1))
       (setq point1 (car bbox))
       (setq point2 (cadr bbox))
       (setq point3 (cadr (cdr bbox)))
       (setq point4 (cadr (cdr (cdr bbox))))
       (setq mwidth (cons '41 (distance point1 point2)))
       (setq mheight (cons '40 (cdr (assoc 40 el))))
       (setq mstyle (cons '7 (cdr (assoc 7 el))))
       (setq nspace (cons '410 (cdr (assoc 410 EL))))
       (setq minsert (cons '10 (cdr (assoc 10 EL))))
       (cond
         ((and (= (cdr (assoc 72 el)) 0) (= (cdr (assoc 73 el)) 3))
          (setq NJUST (cons '71 1))
         )                                       ;JY
         ((and (= (cdr (assoc 72 el)) 1) (= (cdr (assoc 73 el)) 3))
          (setq NJUST (cons '71 2))
         )                                       ;JU
         ((and (= (cdr (assoc 72 el)) 2) (= (cdr (assoc 73 el)) 3))
          (setq NJUST (cons '71 3))
         )                                       ;JI
         ((and (= (cdr (assoc 72 el)) 0) (= (cdr (assoc 73 el)) 2))
          (setq NJUST (cons '71 7))
         )                                       ;JN
         ((and (= (cdr (assoc 72 el)) 1) (= (cdr (assoc 73 el)) 2))
          (setq NJUST (cons '71 7))
         )                                       ;JN
         ((and (= (cdr (assoc 72 el)) 2) (= (cdr (assoc 73 el)) 2))
          (setq NJUST (cons '71 6))
         )                                       ;JK
         ((and (= (cdr (assoc 72 el)) 0) (= (cdr (assoc 73 el)) 0))
          (setq NJUST (cons '71 7))
         )                                       ;JN
         ((and (= (cdr (assoc 72 el)) 4) (= (cdr (assoc 73 el)) 0))
          (setq NJUST (cons '71 7))
         )                                       ;JN
         ((and (= (cdr (assoc 72 el)) 0) (= (cdr (assoc 73 el)) 1))
          (setq NJUST (cons '71 7))
         )                                       ;JN
         ((and (= (cdr (assoc 72 el)) 1) (= (cdr (assoc 73 el)) 0))
          (setq NJUST (cons '71 7))
         )                                       ;JN
         ((and (= (cdr (assoc 72 el)) 1) (= (cdr (assoc 73 el)) 1))
          (setq NJUST (cons '71 )
         )                                       ;JM
         ((and (= (cdr (assoc 72 el)) 2) (= (cdr (assoc 73 el)) 1))
          (setq NJUST (cons '71 9))
         )                                       ;J,
         ((and (= (cdr (assoc 72 el)) 2) (= (cdr (assoc 73 el)) 0))
          (setq NJUST (cons '71 7))
         )                                       ;JN
       ) ;_ end of cond
       (setq mrotate (cons '50 (cdr (assoc 50 el))))
       (setq nmtext (list '(0 . "MTEXT")   '(100 . "AcDbEntity")
                          '(67 . 0)        nspace
                          '(8 . "TEXT")    '(100 . "AcDbMText")
                          minsert          njust
                          mheight          mwidth
                          mstyle           mcontent
                          mrotate
                         ) ;_ end of list
       ) ;_ end of setq
       (vla-put-backgroundfill
         (vlax-ename->vla-object (entmakex nmtext))
         :vlax-true
       ) ;_ end of vla-put-BackgroundFill
       (ssadd (entlast) ss)
       (entdel en)
       (setq count (+ count 1))
     ) ;_ end of progn
     (setq count (+ count 1))
   ) ;_ end of if
 ) ;_ end of while
 (if (> (sslength ss) 0)
   (command "_draworder" ss "" "_F")
 ) ;_ end of if
 )
 (princ "\nNo objects selected.")
)
 (setvar "cmdecho" 1)
 (princ)
) ;_ end of defun

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