Mtext entity text length & contents

[Steven P]

Good morning, 

Sorry if my title here is confusing, I wasn't sure how best to describe my question.

 

As background, I am writing a LISP to change text to upper case, but with certain exceptions such as having 'mm' and not 'MM'. To do this I am selecting the text and then getting the entity information for the text (entity code 1 or 3 depending on the text). Grab the text, change it to upper case, do a string substitution for the exceptions and then put the modified text back into the entity. This works so long as the text is less than 255 characters long. After that there are multiple dotted pair entries for the text, all with the same identifier (3). Noting I have seen this happen before on other LISP, thought it is time for me to find out how to fix this.

 

So my question, does anyone know how to process all the text even if it spans several dotted pair entries? (my problem is that for say 2550 characters, there are 10x '3' dotted pairs containing all the text, I can't do '...assoc 3....' because it will only find one)

 

I think I might be able to do it if I loop through the entity definition, each dotted pair at a time, if it is text process it, if not move on... I think... however if anyone has any pointers or something they could copy here for me that would be great. 

 

Hope this makes sense.

 

Thanks in advance, Steven

 

 

[Jonathan Handojo]

You have the right idea, you need to loop through each one. You can dodge using assoc and use mapcar instead. Like in this fashion:

 

;; ent - mtext entity
;; excp - a string for exception (case-sensitive)
;;		-> For paragraph break, include "\\P" 

(defun test (ent excp / up)
    (setq up (strcase excp))
    (entmod
	(mapcar
	    '(lambda (x / c)
		 (if (member (setq c (car x)) '(1 3))
		     (cons c (sbs excp up (strcase (cdr x))))
		     x
		     )
		 )
	    (entget ent)
	    )
	)
    )

(defun sbs (new old str / ad ln i n ol p)
    (setq ln (strlen new)
	  ol (strlen str)
	  ad (- ol ln)
	  n 0
	  i 0
	  )
    (while
	(and
	    (< i (+ ol n))
	    (setq i (vl-string-search old str i))
	    )
	(if
	    (and
		(not (zerop i))
		(setq p (/= (substr str i 2) "\\P"))
		)
	    (setq str (vl-string-subst new old str i) n (+ n ad))
	    )
	(setq i (+ i (if p ln (1- ln))))
	)
    str
    )

This might not be flawless, but should give you some idea

[Steven P]

Thanks Jonathan,

 

I didn't get chance to try this today, but a virtual team meeting tomorrow... should be able to try it out then

[ronjonp]

Are you opposed to using vla-get\put-textstring? It's much simpler IMO.

 

Quick example .. but be aware that the 'MM' translate will also change SAmmY too

(defun c:foo (/ o s)
  (if (setq s (ssget ":L" '((0 . "*TEXT"))))
    (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
      (vla-put-textstring
	(setq o (vlax-ename->vla-object e))
	(vl-string-translate "MM" "mm"  (strcase (vla-get-textstring o)))
      )
    )
  )
  (princ)
)

 

Edited January 19, 2021 by ronjonp

[Jonathan Handojo]

1 hour ago, ronjonp said:

Are you opposed to using vla-get\put-textstring? It's much simpler IMO.

 

Quick example .. but be aware that the 'MM' translate will also change SAmmY too

(defun c:foo (/ o s)
  (if (setq s (ssget ":L" '((0 . "*TEXT"))))
    (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
      (vla-put-textstring
	(setq o (vlax-ename->vla-object e))
	(vl-string-translate "MM" "mm"  (strcase (vla-get-textstring o)))
      )
    )
  )
  (princ)
)

 

Haha, yes true. Idk if it's slower or faster, but I certainly was overthinking and missed the simple one 

 

Well, regardless though, if the user wants to change something starting with a P, they'll need to be careful of those paragraph breaks \P, so it was something that I consider.

[Steven P]

Online meeting underway and it looks like your first code works well, thanks Jonathon. I have quickly added the ability to have several exceptions via a list (not just the MM/mm, but also kW and others) - I'll copy the  change here later.

 

Ronjon, I started this from modifying something else that I had and so followed that method - I'll try your version shortly, it looks a lot simpler for what I am asking about here.

 

I have other LISPS that I have copied from other places that use entities to update text, and they all fall down in a similar way with long texts I am hoping I can use Jonathans example to update them as and when I need to.

[Steven P]

Just for completion, this is what I came up with using the ent modify method:, someone night find it useful in the future

 

Probably there are more efficient things I can do to my parts, but it works as far as I have tested it

 

Thanks

(defun c:txt2caps (/ excplist ent)


;;set exceptions
;;note here 'x'mm to take acount of words with double 'M'
  (setq excplist (list (cons "0MM" "0mm") (cons "1MM" "1mm") (cons "2MM" "2mm") (cons "3MM" "3mm") ))
  (setq excplist (append excplist (list (cons "4MM" "4mm") (cons "5MM" "5mm") (cons "6MM" "6mm") (cons "7MM" "7mm") ) ))
  (setq excplist (append excplist (list (cons "8MM" "8mm") (cons "9MM" "9mm") (cons "0MM" "0mm") ) ))

;;correct for mm squared
  (setq excplist (append excplist (list (cons "mm2" "mm\U+00B2") (cons "MM2" "mm\U+00B2") (cons (strcat "MM" (chr 178)) (strcat "mm" (chr 178))) ) ))

;;mtext formatting
;;paragraph, indents, lists etc
;;maybe a nicer way to do with but.. this worked and needs adding to later
      (setq excplist (append excplist (list (cons "PXI-" "pxi-") (cons "XI-3" "xi-3") (cons "PXSM1;" "pxsm1;") (cons ",L4" ",l4") (cons ",T4" ",t4") ) ))


  (setq ent (car (nentsel "\nSelect Text")))
  (entmod
    (mapcar
      '(lambda (x / c)
        (if (member (setq c (car x)) '(1 3))
        (cons c (sbs excplist (strcase (cdr x))))
          x
        )
      )
      (entget ent)
    )
  )
  (princ)
)


(defun sbs (excplist str / ad ln i n ol p acount)
  (setq acount 0)
  (while (< acount (length excplist))
    (setq new (cdr (nth acount excplist))
          old (car (nth acount excplist))
          ln (strlen new)
	  ol (strlen str)
	  ad (- ol ln)
	  n 0
	  i 0
	  )
    (while
      (and
        (< i (+ ol n))
        (setq i (vl-string-search old str i))
      )
      (if
        (and
          (not (zerop i))
        )
        (setq str (vl-string-subst new old str i) n (+ n ad))
      ) ;end if
      (setq i (+ i (if p ln (1- ln))))
    ) ;end while
    (setq acount (+ acount 1))
  ) ;end while
  str
)

 

[BIGAL]

You dont need to worry about a new line when making your explist so long as you have a last closing bracket the list will be created. I have like a 15 line make list with 1 option per line for readability,

Note the strcat use cons or for me list.

 

(setq excplist (list 
'( "0MM" "0mm") '( "1MM" "1mm") '( "2MM" "2mm") '( "3MM" "3mm")
'( "4MM" "4mm") '( "5MM" "5mm") '( "6MM" "6mm") '( "7MM" "7mm")
'( "8MM" "8mm") '( "9MM" "9mm") '( "0MM" "0mm")
'( "mm2" "mm\U+00B2") '( "MM2" "mm\U+00B2")
(list (strcat "MM" (chr 178)) (strcat "mm" (chr 178)))
))

(("0MM" "0mm") ("1MM" "1mm") ("2MM" "2mm") ("3MM" "3mm") ("4MM" "4mm") ("5MM" "5mm") ("6MM" "6mm") ("7MM" "7mm") ("8MM" "8mm") ("9MM" "9mm") ("0MM" "0mm") ("mm2" "mm²") ("MM2" "mm²") ("MM²" "mm²"))

 

[Steven P]

Hello again, Thanks for your advice last week on this,  your examples are working well.

 

So a quick question, and one that perhaps will never be so important, asking just for completion.

 

If I have a dimension with a text override to capitalise, funny things happen. 

In RonJonPs example, and adjusting it to accept Dimensions, there is an error with VLA-  Textstring 'unknown name: TextString".

In Jonathons example, the text displayed on screen changes as expected, but the property 'text override'' and in the entity, it doesn't change - next time you double click on the overridden text it reverts to its original form.

 

So is there a quick fix for this?  Like I said, not very important, I rarely use the text override and even less need to have a LISP to capitalise them. Thanks in advance though

 

 

[Steven P]

Whoops - my mistake, I was using nentsel and not entsel I think, just ignore me,