Mtext to block data

[timothy.birdwell]

So here is the goal I am looking for. I need a lisp that can select a Mtext, temporarily store each line individually. Then return each line inside an objects data. The command would ask to select an object, then select the data to be transfered. I don't know if this has been done in earlier post, I have been looking. I will attach a test drawing. The block reference already has an OD: which is meant for separate data. The data I need to fill out is Block:Fiber_Ped. Also add longitude and latitude. The following picture will show how the block is set up and what it needs to look like, the data is manually entered at this time. The mtext will stay in the file but as an invisiblelayer, but don't need a function for that.

 

[CodeDing]

@timothy.birdwell ,

Are you running Civil 3D? Or another vertical? I can see your UDPs in the properties window, but I cannot locate their definition anywhere else in the drawing lol

Best,

~DD

[timothy.birdwell]

@CodeDing 

  The only programs I use/ have access to is Map 3D and Google Earth. These files circulate through this office and others. So every program under the sun touches it, but I am limited to only the 2 programs.

[Moshe-A]

@timothy.birdwell  hi,

check this MMT (Match MText) command.

at select objects pick the mtext and the block together.

enjoy

Moshe

(vl-load-com)

; Match MText
(defun c:mmt (/ break_mtext ; local function
	        ss ename0 ename1 AcDbBlkRef attributes)

 ; break text at \P 
 (defun break_mtext (ent / newColumn->dropLine ; local function
		           mtext p lst)

  ; replace each \n with \\P 
  (defun newColumn->dropLine (str)
   (while (vl-string-search "\n" str)
    (setq str (vl-string-subst "\\P" "\n" str))
   )

   str 
  ); newColumn->dropLine

   
  (setq mtext (newColumn->dropLine (cdr (assoc '1 (entget ent)))))

  (while (or
	   (setq p (vl-string-search "\\P" mtext))
           (setq p (vl-string-search "\\p" mtext))
	 )
   (setq lst (cons (substr mtext 1 p) lst))   
   (setq mtext (substr mtext (+ p 3)))
  )

  (reverse (cons (substr mtext 1) lst))   
 ); break_mtext


 ; here start c:mmt 
 (if (setq ss (ssget '((-4 . "<OR")
			(-4 . "<AND") (0 . "insert") (2 . "fiber_ped") (66 . 1) (-4 . "AND>")
                        (0 . "mtext")
		        (-4 . "OR>")
		      )
	      )
     )
  (progn
   (if (eq (cdr (assoc '0 (entget (ssname ss 0)))) "INSERT")
    (setq ename0 (ssname ss 0) ename1 (ssname ss 1))
    (setq ename0 (ssname ss 1) ename1 (ssname ss 0))
   )
    
   (setq AcDbBlkRef (vlax-ename->vla-object ename0))

   (mapcar	 
    (function
      (lambda (AcDbAttrib text)
       (vla-put-textString AcDbAttrib text)
       (vlax-release-object AcDbAttrib)	
      )
    )
    (setq attributes (vlax-invoke AcDbBlkRef 'getAttributes))
    (break_mtext ename1)
   ); mapcar

   (vlax-release-object AcDbBlkRef)
  ); progn
 ); if

 (princ)
); c:mmt

[CodeDing]

@timothy.birdwell ,

Ahhh, just ignore my first response. I discovered that we're not working with Property Sets here, just attributes inside a block.

I think I'm on a similar path as @Moshe-A ... But this can be easily edited for some more customization. Hope it helps.

(defun c:MTTB ( / LM:str->lst lstProps eMtext lstMtext eBlock)
  ;;MText - To - Block
  (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)
    )
  )
  (setq lstProps '("CONTENT1" "CONTENT2" "CONTENT3" "CONTENT4" "CONTENT5" "CONTENT6"
                   "CONTENT7" "CONTENT8" "CONTENT9" "CONTENT10" "CONTENT11" "CONTENT12"))
  (if (and (setq eMtext (car (entsel "\nSelect MText: ")))
           (eq "MTEXT" (cdr (assoc 0 (entget eMtext))))
           (setq lstMtext (LM:str->lst (getpropertyvalue eMtext "Text") "\r")
                 lstMtext (vl-remove "" (apply 'append (mapcar '(lambda (x) (LM:str->lst x "\n")) lstMtext))))
      );and
    (if (and (setq eBlock (car (entsel "\nSelect Block for MText Values: ")))
             (eq "INSERT" (cdr (assoc 0 (entget eBlock))))
             (eq "FIBER_PED" (strcase (getpropertyvalue eBlock "BlockTableRecord/Name")))
        );and
      (mapcar
        '(lambda (prop str) (setpropertyvalue eBlock prop str))
        lstProps
        lstMtext
      );mapcar
    ;else
      (prompt "\nBad BLOCK entity...")
    );if
  ;else
    (prompt "\nBad MTEXT entity...")
  );if
  (prompt "\nMTTB Complete.")
  (princ)
);defun

Best,

~DD

[ronjonp · Accepted solution]

Well no shortage of answers! Here's another that will sort a larger selection set by closest distance to find 'pairs' of blocks and mtext to process.

(defun c:foo (/ lm:unformat lm:str->lst _foo b j m o p r s x)
  ;;-------------------=={ UnFormat String }==------------------;;
  ;;                                                            ;;
  ;;  Returns a string with all MText formatting codes removed. ;;
  ;;------------------------------------------------------------;;
  ;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
  ;;------------------------------------------------------------;;
  ;;  Arguments:                                                ;;
  ;;  str - String to Process                                   ;;
  ;;  mtx - MText Flag (T if string is for use in MText)        ;;
  ;;------------------------------------------------------------;;
  ;;  Returns:  String with formatting codes removed            ;;
  ;;------------------------------------------------------------;;
  (defun lm:unformat (str mtx / _replace rx)
    (defun _replace (new old str)
      (vlax-put-property rx 'pattern old)
      (vlax-invoke rx 'replace str new)
    )
    (if	(setq rx (vlax-get-or-create-object "VBScript.RegExp"))
      (progn (setq str
		    (vl-catch-all-apply
		      (function
			(lambda	()
			  (vlax-put-property rx 'global actrue)
			  (vlax-put-property rx 'multiline actrue)
			  (vlax-put-property rx 'ignorecase acfalse)
			  (foreach pair
				   '(("\032" . "\\\\\\\\")
				     ;; RJP removed \\\\P| for use case
				     ;; (" " . "\\\\P|\\n|\\t")
				     (" " . "\\n|\\t")
				     ("$1"
				      .
				      "\\\\(\\\\[ACcFfHLlOopQTW])|\\\\[ACcFfHLlOopQTW][^\\\\;]*;|\\\\[ACcFfHLlOopQTW]"
				     )
				     ("$1$2/$3" . "([^\\\\])\\\\S([^;]*)[/#\\^]([^;]*);")
				     ("$1$2" . "\\\\(\\\\S)|[\\\\](})|}")
				     ("$1" . "[\\\\]({)|{")
				    )
			    (setq str (_replace (car pair) (cdr pair) str))
			  )
			  (if mtx
			    (_replace "\\\\"
				      "\032"
				      (_replace "\\$1$2$3" "(\\\\[ACcFfHLlOoPpQSTW])|({)|(})" str)
			    )
			    (_replace "\\" "\032" str)
			  )
			)
		      )
		    )
	     )
	     (vlax-release-object rx)
	     (if (null (vl-catch-all-error-p str))
	       str
	     )
      )
    )
  )
  (vl-load-com)
  ;; String to List  -  Lee Mac
  (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)
    )
  )
  ;; RJP » 2022-12-02
  (defun _foo (str)
    (while (vl-string-search "\n" str) (setq str (vl-string-subst "\\P" "\n" str)))
    (setq str (lm:unformat str nil))
    (cond ((wcmatch str "PED *") (substr str 5))
	  ((wcmatch str "VAULT *") (substr str 7))
	  (str)
    )
  )
  (cond	((setq s (ssget	'((-4 . "<OR")
			  (0 . "MTEXT")
			  (-4 . "<AND")
			  (0 . "INSERT")
			  (2 . "Fiber_Ped,*vault*")
			  (66 . 1)
			  (-4 . "AND>")
			  (-4 . "OR>")
			 )
		 )
	 )
	 (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
	   (setq o (vlax-ename->vla-object e))
	   (if (vlax-property-available-p o 'textstring)
	     (setq m (cons (list (vlax-get o 'insertionpoint)
				 (lm:str->lst (_foo (vlax-get o 'textstring)) "\\P")
			   )
			   m
		     )
	     )
	     (setq b (cons (list (vlax-get o 'insertionpoint)
				 (mapcar '(lambda (x) x) (vlax-invoke o 'getattributes))
			   )
			   b
		     )
	     )
	   )
	 )
	 (foreach bl b
	   (setq p (car bl))
	   (setq m (vl-sort m '(lambda (r j) (< (distance p (car r)) (distance p (car j))))))
	   (mapcar '(lambda (r j) (vla-put-textstring r j)) (cadr bl) (cadr (car m)))
	   (setq m (cdr m))
	 )
	)
  )
  (princ)
)

[timothy.birdwell]

@Moshe-A @CodeDing @CodeDing 

  Thankyou so much for the quick responses. I will be trying them out today. I have tried the 1st one already from @Moshe-A it selects the mtexts but will not select the block, but I will try the others out as well. Thanks again.

[timothy.birdwell]

@CodeDing code worked great. Now to add more blocks for it to select from would I copy lines 11 through 30 and chage FIBER_PED to DROP_VAULT and then again to VAULT, or could they all go in the first code as a new line?

[ronjonp]

@timothy.birdwell 

Did you give this a try? It's not as manual as the other versions.

[timothy.birdwell]

Yes just checked it, worked really well. What ive noticed with both of them, its locked to fiber_ped, when I try to add it to another block such as drop_vault and vault, it doesnt read it. I will attach the file im testing on

[ronjonp]

Change this:

(2 . "Fiber_Ped")

to this:

(2 . "Fiber_Ped,drop_vault")

The comma separates names of blocks if you need to add more.

[timothy.birdwell]

Awesome so I can use it all in one code of line. My coding is very basic and I thought this would throw me into unending loop for some reason.

(2 . "Fiber_Ped,Drop_Vault,Vault") ;; assuming this is the list of blocks the items can go into?;;

[ronjonp]

That works .. so does this 🙂

(2 . "Fiber_Ped,*Vault*")

Take a look here for a list of wildcard values to use.

[timothy.birdwell]

@ronjonp I have no problem getting it to fill in Fiber_Ped and Drop_Vault, but the Vault block will not autofill.

[ronjonp]

Try the code above again .. had to modify the _foo function. It was returning nil if no \n characters were found.

[timothy.birdwell]

@ronjonp You are my hero! You saved me about 10k of those blocks to do by hand. I am very thankful for what you have done for me!

[ronjonp]

---

@timothy.birdwell wrote:

@ronjonp You are my hero! You saved me about 10k of those blocks to do by hand. I am very thankful for what you have done for me!

---

Glad to help out 🙂 .. you really have 10k of these to process!?

Definitely double check your work. The code is very reliant on where the block is in proximity to the insertion point of the mtext.

A scenario like below would pull the wrong data:

[timothy.birdwell]

Is there anyway to remove vault and ped from the extraction string so it will on show its nomenclature i.e. PED 41_2-65L/001 would be replace with just 41_2-65L/001? I'm scouring lee mac and other places to find if you can.

[ronjonp]

---

@timothy.birdwell wrote:

Is there anyway to remove vault and ped from the extraction string so it will on show its nomenclature i.e. PED 41_2-65L/001 would be replace with just 41_2-65L/001? I'm scouring lee mac and other places to find if you can.

---

Replace the '_foo' function with this version:

(defun _foo (str)
  (while (vl-string-search "\n" str) (setq str (vl-string-subst "\\P" "\n" str)))
  (cond	((wcmatch str "PED *") (substr str 5))
	((wcmatch str "VAULT *") (substr str 7))
	(str)
  )
)

[timothy.birdwell]

Works like a charm now thanks again for your insight!

;;To quickly label Mtext into objects                       ;;
;; Type foo to start the command select the Mtext and object;;
(defun c:foo (/ b j m o p r s x)
  ;; String to List  -  Lee Mac
  (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)
    )
  )
  ;; RJP » 2022-12-02
 (defun _foo (str)
  (while (vl-string-search "\n" str) (setq str (vl-string-subst "\\P" "\n" str)))
  (cond	((wcmatch str "PED *") (substr str 5))
	((wcmatch str "VAULT *") (substr str 7))
	(str)
  )
)
  (cond	((setq s (ssget	'((-4 . "<OR")
			  (0 . "MTEXT")
			  (-4 . "<AND")
			  (0 . "INSERT")
			  (2 . "Fiber_Ped,*vault*")
			  (66 . 1)
			  (-4 . "AND>")
			  (-4 . "OR>")
			 )
		 )
	 )
	 (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
	   (setq o (vlax-ename->vla-object e))
	   (if (vlax-property-available-p o 'textstring)
	     (setq m (cons (list (vlax-get o 'insertionpoint)
				 (lm:str->lst (_foo (vlax-get o 'textstring)) "\\P")
			   )
			   m
		     )
	     )
	     (setq b (cons (list (vlax-get o 'insertionpoint)
				 (mapcar '(lambda (x) x) (vlax-invoke o 'getattributes))
			   )
			   b
		     )
	     )
	   )
	 )
	 (foreach bl b
	   (setq p (car bl))
	   (setq m (vl-sort m '(lambda (r j) (< (distance p (car r)) (distance p (car j))))))
	   (mapcar '(lambda (r j) (vla-put-textstring r j)) (cadr bl) (cadr (car m)))
	   (setq m (cdr m))
	 )
	)
  )
  (princ)
)