Select numbers by number value - greater than, less than if there is a prefix text

Select numbers by number value - greater than, less than if there is a prefix text

Ten_Tol
Explorer Explorer
829 Views
7 Replies
Message 1 of 8

Select numbers by number value - greater than, less than if there is a prefix text

Ten_Tol
Explorer
Explorer

This is an offshoot from a previous thread:

Solved: Re: Select numbers by number value - greater than, less than - Autodesk Community - AutoCAD

 

I am looking to highlight a line in MText based on a criteria. The criteria needs to be variable. 

E.g. if FV<0.460 highlight in red, if <480 highlight in orange.

       if CV<0.200 highlight in red, if <0.255 highlight in orange.

The prefixes are constant in this case, however the routine would be more useful if it wouldn't tie to this specific. 

It would also be more useful to only select (rather than automatically colour to a preset) as this way the routine can be used for other purposes.  

 

An example of my MText. This is a label for a single point.

L5U6006
BOS 36.047
CV 0.248
FCL 35.795
FTC 3.300
FFL 32.495
FV 0.476
TOC 32.019

 

In the attached sample the two Northernmost points have been edited to show the desired outcome. 

 

If need be, the Mtext can be exploded to plain text, however it is better to keep it as such.  (The point on the right has the Mtext exploded.)

 

 

 

0 Likes
Accepted solutions (1)
830 Views
7 Replies
Replies (7)
Message 2 of 8

ВeekeeCZ
Consultant
Consultant

First of all, you should really overkill overlapped objects, all are doubled.

Then try it. It's more complicated than the original task.

 

(vl-load-com)

(defun c:SelectMTextRange ( / :TextToAssocList LM:str->lst o1 v1 o2 v2 ss ed no s1 tg)
  
  ;; String to List  -  Lee Mac
  ;; Separates a string using a given delimiter
  ;; str - [str] String to process
  ;; del - [str] Delimiter by which to separate the string
  ;; Returns: [lst] List of strings
  
  (defun LM:str->lst ( str del / pos )
    (if (setq pos (vl-string-search del str))
      (cons (substr str 1 pos) (LM:str->lst (substr str (+ pos 1 (strlen del))) del))
      (list str)))
  
  (defun :TextToAssocList (txt)
    (setq txt (mapcar '(lambda (x) (LM:str->lst x "\t")) (LM:str->lst txt "\n")))
    (setq txt (vl-remove 'nil (mapcar '(lambda (x) (if (and (= 2 (length x))
							    (setq e (mapcar '(lambda (y) (vl-string-trim "r" y)) x))
							    (distof (last x)))
						     (cons (strcase (car x)) (distof (last x)))))
				      txt))))
  
  ; ------------------
  
  (princ "\nSelext mtexts in format: multiple lines of TAG VALUE delimited by tab sign,\n")

  (if (setq ss (ssget "I" '((0 . "MTEXT")))) (sssetfirst nil))
  
  (if (and (setq s1 (ssadd))
	   (or ss
	       (setq ss (ssget '((0 . "MTEXT"))))))
    
    (progn
      
      (princ (strcat "\nTags: " (apply 'strcat (mapcar '(lambda (x) (strcat (car x) ", ")) (:TextToAssocList (getpropertyvalue (ssname ss 0) "Text"))))))
      (setq tg (getstring "\nSpecify tag: "))
      
      (initget "L LE E GE G")
      (setq o1 (cond ((getkword "\nSelect operation for first condition [L </LE <=/E =/GE >=/G >] : "))
		     ("L")))
      (initget 1)
      (setq v1 (getdist (strcat "\n" (nth (vl-position o1 '("L" "LE" "E" "GE" "G"))
					  '("Less than" "Less than or equal to" "Equal to" "Greater than" "Greater than or equal to"))
				": ")))
      (if (and (/= o1 "E")
	       (not (initget "L LE E GE G"))
	       (setq o2 (getkword (strcat "Select operation for second condition [" (if (wcmatch o1 "L*") "GE >=/G >" "L </LE <=") "] : ")))
	       )
	(setq v2 (getdist (strcat "\n" (nth (vl-position o1 '("L" "LE" "E" "GE" "G"))
					    '("Less than" "Less than or equal to" "Equal to" "Greater than" "Greater than or equal to"))
				  ": "))))
      
      (if (and ss
	       tg
	       (/= tg "")
	       v1)
	
	(repeat (setq i (sslength ss))
	  (setq en (ssname ss (setq i (1- i))))
	  
	  (if (and (setq no (cdr (assoc (strcase tg) (:TextToAssocList (getpropertyvalue en "Text")))))
		   (apply (read (nth (vl-position o1 '("L" "LE" "E" "GE" "G"))
				     '("<" "<=" "=" ">=" ">")))
			  (list no v1))
		   (if v2
		     (apply (read (nth (vl-position o2 '("L" "LE" "E" "GE" "G"))
				       '("<" "<=" "=" ">=" ">")))
			    (list no v2))
		     T)
		   )
	    (ssadd en s1))))
      (if (entget (ssname s1 0)) (sssetfirst nil s1))))
  (princ)
  )

 

0 Likes
Message 3 of 8

Ten_Tol
Explorer
Explorer

First, apologies for the duplicate objects, must have copied it twice, my PC is sluggish these days. 

I know it is complicated, hence my reach for help. I presented the whole goal so that you get an understanding of where I am aiming, but it the laborious parts can be automated that is of great help. 

 

Many thanks for your code, it kind of works and is amazing, as it selects all those Mtexts, however from that stage I can only highlight the whole Mtext, rather than the specific line. 

 

As @Kent1Cooper mentioned in the other thread, most likely I can't select specific lines in multiple Mtexts. 

This leaves two options I believe, either Explode all Mtext first or accept a very specific code that would go through the lot and put the selected line to the appropriate colour straight away rather than just selecting it. I think it might be easier to change the code to recognise the plain text (1st option) and also that way it can be reused. 

 

0 Likes
Message 4 of 8

Kent1Cooper
Consultant
Consultant

@Ten_Tol wrote:

....

As @Kent1Cooper mentioned in the other thread, most likely I can't select specific lines in multiple Mtexts. 

This leaves two options I believe, either Explode all Mtext first .... I think it might be easier to change the code to recognise the plain text (1st option) .... 

 


I was interested to find something I didn't expect -- that when I used TXT2MTXT on your sample drawing's separate-Text-object set with the one line in red, the red color was maintained for that part within the resulting Mtext object.  Line wrapping wasn't right, so something would need to be done to account for that, but maybe Exploding, finding/coloring, and re-joining into Mtext can be a workable approach.

Kent Cooper, AIA
0 Likes
Message 5 of 8

Ten_Tol
Explorer
Explorer

I like the idea, but will I have to select each bunch of lines for each point individually to create the Mtext?

If so I can leave it as Text, not a great issue.

 

 

0 Likes
Message 6 of 8

Kent1Cooper
Consultant
Consultant

@Ten_Tol wrote:

I like the idea, but will I have to select each bunch of lines for each point individually to create the Mtext?

....


The new pieces resulting from EXPLODE-ing either a Block or a Dimension or a Hatch pattern or Mtext always become the "Previous" selection.  So after Exploding, they can be made into a selection set with (ssget "_P"), without User selection, which can then be fed to a TXT2MTXT command after the finding/coloring operation(s).

Kent Cooper, AIA
0 Likes
Message 7 of 8

ВeekeeCZ
Consultant
Consultant
Accepted solution

Ok, so I've modified the code a bit. Previously I didn't look into your new file... so. 

It's made for index colors (30).

 

(vl-load-com)

(defun c:ColorMTextRange ( / :TextToAssocList LM:str->lst o1 v1 o2 v2 ss ed no s1 tg vl)
  
  ;; String to List  -  Lee Mac
  ;; Separates a string using a given delimiter
  ;; str - [str] String to process
  ;; del - [str] Delimiter by which to separate the string
  ;; Returns: [lst] List of strings
  
  (defun LM:str->lst ( str del / pos )
    (if (setq pos (vl-string-search del str))
      (cons (substr str 1 pos) (LM:str->lst (substr str (+ pos 1 (strlen del))) del))
      (list str)))
  
  (defun :TextToAssocList (txt)
    (setq txt (mapcar '(lambda (x) (LM:str->lst x "\t")) (LM:str->lst txt "\n")))
    (setq txt (vl-remove 'nil (mapcar '(lambda (x) (if (and (= 2 (length x))
							    (setq x (mapcar '(lambda (y) (vl-string-trim "" (vl-string-trim "\r" y))) x))
							    (distof (last x)))
						     (list (car x) (last x) (distof (last x)))))
				      txt))))
  
  ; ------------------
  
  (princ "\nSelext mtexts in format: multiple lines of TAG VALUE delimited by tab sign,\n")

  (if (setq ss (ssget "I" '((0 . "MTEXT")))) (sssetfirst nil))
  
  (if (and (setq s1 (ssadd))
	   (or ss
	       (setq ss (ssget '((0 . "MTEXT"))))))
    
    (progn
      
      (princ (strcat "\nTags: " (apply 'strcat (mapcar '(lambda (x) (strcat (car x) ", ")) (:TextToAssocList (getpropertyvalue (ssname ss 0) "Text"))))))
      (setq tg (getstring "\nSpecify tag: "))

      (setq cl (getint "\nSpecify color number: "))
      
      (initget "L LE E GE G")
      (setq o1 (cond ((getkword "\nSelect operation for first condition [L </LE <=/E =/GE >=/G >] <LessThan>: "))
		     ("L")))
      (initget 1)
      (setq v1 (getdist (strcat "\n" (nth (vl-position o1 '("L" "LE" "E" "GE" "G"))
					  '("Less than" "Less than or equal to" "Equal to" "Greater than" "Greater than or equal to"))
				": ")))
      (if (and (/= o1 "E")
	       (not (initget "L LE E GE G"))
	       (setq o2 (getkword (strcat "Select operation for second condition [" (if (wcmatch o1 "L*") "GE >=/G >" "L </LE <=") "] <no second condition>: ")))
	       )
	(setq v2 (getdist (strcat "\n" (nth (vl-position o1 '("L" "LE" "E" "GE" "G"))
					    '("Less than" "Less than or equal to" "Equal to" "Greater than" "Greater than or equal to"))
				  ": "))))
      
      (if (and ss
	       tg
	       (/= tg "")
	       v1)
	
	(repeat (setq i (sslength ss))
	  (setq en (ssname ss (setq i (1- i))))
	  
	  (if (and (setq no (last (setq as (assoc tg (:TextToAssocList (getpropertyvalue en "Text"))))))
		   (apply (read (nth (vl-position o1 '("L" "LE" "E" "GE" "G"))
				     '("<" "<=" "=" ">=" ">")))
			  (list no v1))
		   (if v2
		     (apply (read (nth (vl-position o2 '("L" "LE" "E" "GE" "G"))
				       '("<" "<=" "=" ">=" ">")))
			    (list no v2))
		     T)
		   )
	    (progn
	      (setq vl (getpropertyvalue en "Contents"))
	      (setq vl (vl-string-subst (strcat "{\\C" (itoa cl) ";" tg "}" ) tg vl))
	      (setq vl (vl-string-subst (strcat "{\\C" (itoa cl) ";" (cadr as) "}" ) (cadr as) vl (vl-string-search tg vl)))
	      (setpropertyvalue en "Contents" vl)))))))
  (princ)
  )

 

Message 8 of 8

Ten_Tol
Explorer
Explorer
Perfect! Exactly what I was after.
0 Likes