Two MTEXT texts to one block with attributes

[Anonymous]

I've been digging around and trying to make something that will work out of other similar solutions I've found but nothing is quite right and I can't seem to get them to work.

So I have a bunch of drawings with employee names and room/cube numbers that I need to be able to turn into a block. There will be one block for each employee/ location. I created a block called "Employee Location" with the attributes "Employee Name" and "Location". I want to be able to select the name then the location and have the predefined block take the place of the two individual MTEXT's.

I know I need the below code but I'm struggling with getting the selected MTEXT into one block. Ideally I would like the block to have the same layer as the text as well.

(defun c:Employee ( / "some needed variables here")

 (if
   (and
     (or (tblsearch "BLOCK" "Employee Location")
         (alert "Attributed Block <Employee Location> is not found in drawing <!>")
     )
     (princ "\nSelect Employee name to be inserted into Attributed Block <Employee Location> :")
     (setq emp (ssget "_:L" '((0 . "MTEXT"))))
     (princ "\nSelect Employee location to be inserted into Attributed Block <Employee Location> :")
     (setq loc (ssget "_:L" '((0 . "MTEXT"))))
   )

Any help would be appreciated. 

[devitg]

Please upload your sample.dwg

[dlanorh]

As @devitg  mentioned a sample drawing containing the block would help (saved as AutoCAD version 2007 for me)

Also a better explanation of what you are trying to achieve.

1. You will at some point need to insert the block.

    This can be accomplished by

    a. using the insert command (this would require knowing the attribute order)

    b. By entmaking the block reference and the attributes

    c. using the vla-insertblock method

  Each has its advantagges and drawbacks, but all would require the insertion point to be known before using it.

2. What happens to the existing MText?

3. You can extract the text string from the MText objects data and this can then be put into the attributes, depending on the method you choose from 1 above.

[hak_vz · Accepted solution]

Here is my code to start with.

Create block with name "Employee Location" and two attributes as you stated in your post.

Code asks to select single MText with employee name and than for location

It asks to pick a point for a location of a new insert, creates it and delete two selected mtexts.

(defun c:Employee ( / acadObj doc modelSpace emp_el loc_el insertionPnt blockRefObj varAttributes *error*)
(defun *error* () (princ))

    (setq 
        acadObj (vlax-get-acad-object)
        doc (vla-get-ActiveDocument acadObj)
        modelSpace (vla-get-ModelSpace doc)
    )
    (vla-startundomark doc)
    (princ "\nSelect Employee name to be inserted into Attributed Block <Employee Location> :")
    (setq emp_el (ssname (setq emp (ssget ":S" '((0 . "MTEXT")))) 0))
    (princ "\nSelect Employee location to be inserted into Attributed Block <Employee Location> :")
    (setq 
        loc_el (ssname (setq loc (ssget ":S" '((0 . "MTEXT")))) 0)
        insertionPnt (vlax-3d-point (getpoint "\nPick block insertion point"))
        blockRefObj (vla-InsertBlock modelSpace insertionPnt "Employee Location" 1 1 1 0)
        varAttributes (vlax-variant-value (vla-GetAttributes blockRefObj))
    )
    ;switch location and name variable between next two lines how they appear in insert command --- loc_el emp_el
    (vla-put-TextString (vlax-safearray-get-element varAttributes 0) (cdr (assoc 1 (entget loc_el))))
    (vla-put-TextString (vlax-safearray-get-element varAttributes 1) (cdr (assoc 1 (entget emp_el))))
     (entdel emp_el)
     (entdel loc_el)
      (vla-endundomark doc)
(princ)  
)

[Anonymous]

@hak_vz  thank you for the reply. When I run your code, select the employee name, select the location, then pick a base point it inserts the block but the text is overlapping. I will try to play around with the code later. 

Screencast:

https://autode.sk/2RR8zOE

[Anonymous]

Here is a test.dwg with the block and example text. 

[Anonymous]

@dlanorh  Here is what i was working with. I found this on another forum from Lee Mac and tried to modify it to my needs. 

; File name: Employee Location Tag
; Created by: Ryan Fahrenkrug
; Date: 1/25/20
; Description: Prompts to select the employee name and cube number text, then creates a block called "Employee Location" from that data.

(defun c:Employee ( / emp loc int1 int2 ent1 ent2 att spc)

  

 (if
   (and
     (or (tblsearch "BLOCK" "Employee Location")
         (alert "Attributed Block <Employee Location> is not found in drawing <!>")
     )
     (princ "\nSelect Employee name to be inserted into Attributed Block <Employee Location> :")
     (setq emp (ssget "_:L" '((0 . "MTEXT"))))
     (princ "\nSelect Employee location to be inserted into Attributed Block <Employee Location> :")
     (setq loc (ssget "_:L" '((0 . "MTEXT"))))
   )
    (progn
      (defun unformatmtext (string / text str)
        ;;	ASMI - sub-function			;;
        ;; Get string from Formatted Mtext string	;;
        (setq text "")
        (while (/= string "")
          (cond ((wcmatch (strcase (setq str (substr string 1 2)))
                          "\\[\\{}`~]"
                 )
                 (setq string (substr string 3)
                       text   (strcat text str)
                 )
                )
                ((wcmatch (substr string 1 1) "[{}]")
                 (setq string (substr string 2))
                )
                ((and (wcmatch (strcase (substr string 1 2)) "\\P")
                      (/= (substr string 3 1) " ")
                 )
                 (setq string (substr string 3)
                       text   (strcat text " ")
                 )
                )
                ((wcmatch (strcase (substr string 1 2)) "\\[LOP]")
                 (setq string (substr string 3))
                )
                ((wcmatch (strcase (substr string 1 2)) "\\[ACFHQTW]")
                 (setq string (substr string
                                      (+ 2 (vl-string-search ";" string))
                              )
                 )
                )
                ((wcmatch (strcase (substr string 1 2)) "\\S")
                 (setq str    (substr string 3 (- (vl-string-search ";" string) 2))
                       text   (strcat text (vl-string-translate "#^\\" " " str))
                       string (substr string (+ 4 (strlen str)))
                 )
                 (print str)
                )
                (t
                 (setq text   (strcat text (substr string 1 1))
                       string (substr string 2)
                 )
                )
          )
        )
        text
      )
      (setq spc
             (vlax-get (vla-get-activelayout
                         (vla-get-activedocument (vlax-get-acad-object))
                       )
                       'block
             )
      )
      (repeat (setq int1 (sslength emp))
        (setq ent1 (ssname emp (setq int1 (1- int1))))
        (and (setq att (vla-insertblock
                         spc
                         (vlax-3d-point (cdr (assoc 10 (entget ent1))))
                         "Employee Location"
                         1.0
                         1.0
                         1.0
                         0.
                       )
             )
             (vl-some
               '(lambda (x)
                  (if (eq (strcase (vla-get-tagstring x)) "EMPLOYEE_NAME")
                    (progn (vla-put-textstring
                             x
                             (unformatmtext (cdr (assoc 1 (entget ent1))))
                           )
                           t
                    )
                  )
                )
               (vlax-invoke att 'getattributes)
             )
	     (entdel ent1)
	     )
	(repeat (setq int2 (sslength loc))
        (setq ent2 (ssname loc (setq int2 (1- int2))))
        (and (setq att (vla-insertblock
                         spc
                         (vlax-3d-point (cdr (assoc 10 (entget ent2))))
                         "Employee Location"
                         1.0
                         1.0
                         1.0
                         0.
                       )
             )
             (vl-some
               '(lambda (y)
                  (if (eq (strcase (vla-get-tagstring y)) "LOCATION")
                    (progn (vla-put-textstring
                             y
                             (unformatmtext (cdr (assoc 1 (entget ent2))))
                           )
                           t
                    )
                  )
                )
               (vlax-invoke att 'getattributes)
             )
             (entdel ent2)
        )
)
      )
    )
 )
 (princ)
)(vl-load-com)

[hak_vz]

I have to test it on your sample drawin, in my testing  it worked corectly.

[Anonymous]

I thinks its just because its a two line Mtext.

[CADaSchtroumpf]

My proposition

(vl-load-com)
(defun c:swap_text ( / AcDoc Space loop key_mod e1name e2name string1 string2)
	(defun sel_onlyText (msg / js)
		(princ msg)
		(while
			(not
				(setq js
					(ssget "_+.:E:S:N" 
						(list
							(cons 0 "*TEXT,MULTILEADER,ATTRIB,INSERT,DIMENSION")
							(cons 67 (if (eq (getvar "CVPORT") 2) 0 1))
							(cons 410 (if (eq (getvar "CVPORT") 2) "Model" (getvar "CTAB")))
						)
					)
				)
			)
		)
		(vlax-ename->vla-object (cadar (ssnamex js 0)))
	)
	(setq
		AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
		Space
		(if (eq (getvar "CVPORT") 1)
			(vla-get-PaperSpace AcDoc)
			(vla-get-ModelSpace AcDoc)
		)
		loop nil
	)
	(initget "Swap Copy Multiple")
	(while (eq (setq key_mod (getkword (strcat "\nProcedure [Swap/Copy/Multiple] " (if loop "**MULTIPLE**" "") "<Copy>: "))) "Multiple")
		(if (eq key_mod "Multiple")
			(if loop (setq loop nil) (setq loop T))
		)
		(initget "Swap Copy Multiple")
	)
	(if (not key_mod) (setq key_mod "Copy"))
	(cond
		(loop
			(while (setq e1name (sel_onlyText (strcat "\nSelect texte source for " key_mod " **MULTIPLE**: ")))
				(setq
					string1
					(cond
						((vlax-property-available-p e1name 'TextString) (vlax-get e1name 'TextString))
						((vlax-property-available-p e1name 'TextOverride)
							(if (eq (vlax-get e1name 'TextOverride) "")
								(strcat (vlax-get e1name 'TextPrefix) (rtos (vlax-get e1name 'Measurement) (vlax-get e1name 'UnitsFormat) (vlax-get e1name 'PrimaryUnitsPrecision)) (vlax-get e1name 'TextSuffix))
								(vlax-get e1name 'TextOverride)
							)
						)
					)
					e2name (sel_onlyText (strcat "\nSelect text target for " key_mod " **MULTIPLE**: "))
					string2
					(cond
						((vlax-property-available-p e2name 'TextString) (vlax-get e2name 'TextString))
						((vlax-property-available-p e2name 'TextOverride)
							(if (eq (vlax-get e2name 'TextOverride) "")
								(strcat (vlax-get e2name 'TextPrefix) (rtos (vlax-get e2name 'Measurement) (vlax-get e2name 'UnitsFormat) (vlax-get e2name 'PrimaryUnitsPrecision)) (vlax-get e2name 'TextSuffix))
								(vlax-get e2name 'TextOverride)
							)
						)
					)
				)
				(cond
					((and string1 string2)
						(if (eq key_mod "Permutation") (vlax-put e1name 'TextString string2))
						(vlax-put e2name 'TextString string1)
					)
				)
			)
		)
		(T
			(setq
				e1name (sel_onlyText (strcat "\nSelect texte source for " key_mod  ": "))
				string1
				(cond
					((vlax-property-available-p e1name 'TextString) (vlax-get e1name 'TextString))
					((vlax-property-available-p e1name 'TextOverride)
						(if (eq (vlax-get e1name 'TextOverride) "")
							(strcat (vlax-get e1name 'TextPrefix) (rtos (vlax-get e1name 'Measurement) (vlax-get e1name 'UnitsFormat) (vlax-get e1name 'PrimaryUnitsPrecision)) (vlax-get e1name 'TextSuffix))
							(vlax-get e1name 'TextOverride)
						)
					)
				)
				e2name (sel_onlyText (strcat "\nSelect text target for " key_mod ": "))
				string2
				(cond
					((vlax-property-available-p e2name 'TextString) (vlax-get e2name 'TextString))
					((vlax-property-available-p e2name 'TextOverride)
						(if (eq (vlax-get e2name 'TextOverride) "")
							(strcat (vlax-get e2name 'TextPrefix) (rtos (vlax-get e2name 'Measurement) (vlax-get e2name 'UnitsFormat) (vlax-get e2name 'PrimaryUnitsPrecision)) (vlax-get e2name 'TextSuffix))
							(vlax-get e2name 'TextOverride)
						)
					)
				)
			)
			(cond
				((and string1 string2)
					(if (eq key_mod "Swap") (vlax-put e1name (if (vlax-property-available-p e1name 'TextOverride) 'TextOverride 'TextString) string2))
					(vlax-put e2name (if (vlax-property-available-p e2name 'TextOverride) 'TextOverride 'TextString) string1)
				)
			)
		)
	)
	(prin1)
)

[hak_vz]

I have tested with your sample and it works correctly even when text is multi line since limit is 256 signs In that situation overlapping of attributes may occur, so it is better if your mtexts are single line, or create block with suficient spacing.   

[Anonymous]

Got it. I added some lines to the Employee Name Att and it is working well now. Thank you!

[hak_vz]

I'm glad it works for you. If block scaling or other changes are needed here is a help for vla-InsertBlock

[ronjonp]

Based on the first example posted by the OP, is this what is wanted?

(defun c:employee (/ _clean a b p s sp x)
  ;; RJP » 2020-01-28
  (defun _clean (s) (vl-string-left-trim " " (vl-string-subst " " "\n" s)))
  (cond	((null (tblsearch "block" "Employee Location"))
	 (alert "Attributed Block <Employee Location> is not found in drawing <!>")
	)
	((null (setq s (ssget "_:L" '((0 . "MTEXT") (8 . "*employees"))))) (print "Bye..."))
	((/= 2 (sslength s)) (print "Only select two mtext at a time..."))
	((null (setq p (getpoint "\nPick a point to place block: "))) (print "Bye..."))
	((setq s (mapcar '(lambda (x)
			    (list x (setq a (_clean (cdr (assoc 1 (entget x))))) (wcmatch a "*#*"))
			    ;; Filter assumes that the location will always have a number and the name will not...
			  )
			 (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
		 )
	 )
	 (cond ((and (setq sp (vlax-ename->vla-object (cdr (assoc 330 (entget (caar s))))))
		     (setq b (vla-insertblock sp (vlax-3d-point p) "Employee Location" 1. 1. 1. 0))
		)
		(foreach x s
		  (vl-catch-all-apply
		    'setpropertyvalue
		    (list (vlax-vla-object->ename b)
			  (if (last x)
			    "LOCATION"
			    "EMPLOYEE_NAME"
			  )
			  (cadr x)
		    )
		  )
		)
		(mapcar 'entdel (mapcar 'car s))
	       )
	       ((print "Something went horribly wrong ;/ ..."))
	 )
	)
  )
  (princ)
)

 

[Anonymous]

Okay so I added a section to insert the block if its not already in the drawing and to put the block on the layer of the mtext. Now I am trying to add an "if statement" to make the attribute text green if the mtext is green but I cant for the life of me figure out how to do this... 

Here is where i am at right now and a pic of the desired outcome. The green is a property override not set by the layer.

(defun c:Employee ( / acadObj doc modelSpace emp_el loc_el insertionPnt blockRefObj varAttributes *error* val1)
(defun *error* () (princ))

  ;Check if the block is already in the drawing and insert it if not then delete the block
  (if
    (not
      (tblsearch "BLOCK" "Employee Location")
     )
      (progn
	(command "-insert" "filepath" 0 1 1 0)
    		(command "_.erase" "last" "")
	)
   )
  	
    (setq 
        acadObj (vlax-get-acad-object)
        doc (vla-get-ActiveDocument acadObj)
        modelSpace (vla-get-ModelSpace doc)
    )
    (vla-startundomark doc)
    (princ "\nSelect Employee name to be inserted into Attributed Block <Employee Location> :")
    (setq emp_el (ssname (setq emp (ssget ":S" '((0 . "MTEXT")))) 0))
    (princ "\nSelect Employee location to be inserted into Attributed Block <Employee Location> :")
    (setq 
        loc_el (ssname (setq loc (ssget ":S" '((0 . "MTEXT")))) 0)
        insertionPnt (vlax-3d-point (getpoint "\nPick block insertion point"))
        blockRefObj (vla-InsertBlock modelSpace insertionPnt "Employee Location" 1 1 1 0)
        varAttributes (vlax-variant-value (vla-GetAttributes blockRefObj))
    )
    ;switch location and name variable between next two lines how they appear in insert command --- loc_el emp_el
    (vla-put-TextString (vlax-safearray-get-element varAttributes 0) (cdr (assoc 1 (entget loc_el))))
    (vla-put-TextString (vlax-safearray-get-element varAttributes 1) (cdr (assoc 1 (entget emp_el))))
 	 ;Changes the layer of the block to match the layer of the selected mtext
 	 (command "_.chprop" "_last" "" "_La" (cdr (assoc 8 (entget(ssname emp 0)))) "")
 	 ;(vla-put-layer blockRefObj "A-EMPLOYEES")
  
  ;Keeps OPEN green if selected
 (if
   (= (vla-get-color emp) acGreen)
   	(vla-put-color (vlax-safearray-get-element varAttributes 1) acGreen)
   )
   
     (entdel emp_el)
     (entdel loc_el)
      (vla-endundomark doc)
(princ)  
)

[hak_vz]

@Anonymous  I'll check and modify this at Monday.

[Anonymous]

@hak_vz  Thank you. I'm really new to the VLA-* stuff. I wont be back in the office until Tuesday. 

[hak_vz · Accepted solution]

---

Change this line

 (if
   (= (vla-get-color emp) acGreen)  ; emp is a selection set and not vla object
   	(vla-put-color (vlax-safearray-get-element varAttributes 1) acGreen)

   )

---

to

(if 
    (= (vla-get-color (vlax-ename->vla-object emp_el)) acGreen)
            (vla-put-color (vlax-safearray-get-element varAttributes 1) acGreen)
)

Explanation:

To access emp_el it has to be converted to vla-object.

To avoid to much text in a console put (setvar 'cmdecho 0) that is returned by chprop command add

(princ "\nSelect Employee location to be inserted into Attributed Block <Employee Location> :")
 (setvar 'cmdecho 0)

and reset it at code end

(setvar 'cmdecho 1)
(princ)

[Anonymous]

@hak_vz that was it thank you!