Mtext vs Text problem

[guitarguy1685]

I have the following code:

 

 
(defun c:COPYPART (/ ObjC ObjP1 ObjP2 ObjA TxtV Nw1Txt
      Nw2txt)
 (setq CREcho (getvar "CMDECHO"))
 (setq CRSnap (getvar "OSMODE"))
 (setq CRortho (getvar "ORTHOMODE"))
;;-------------Error handler---------------
 (setq *error*    ;;;resets sysvar incase of
    (lambda (msg)   ;;;an error, esc, exit, cancel
      (setvar "cmdecho" CRcecho)
      (setvar "OSMODE" CRSnap)
      (setvar "ORTHOMODE" CROrtho)
      (princ msg)
      (princ)))
;;------------------------------------------------
 (setvar "ORTHOMODE" 1)
 (if (< CRSnap 16384)
     (setvar "OSMODE" (+ CRSnap 16384)))
 (setq ObjC (entsel "\nSelect object to copy down: "))
 (setq ObjP1 (list (car (cadr Objc)) (cadr (cadr Objc))))
 (setq ObjA (getangle "\nSpecify direction of copy: " Objp1))
 (cond ( (= ObjA 0) (setq ObjP2 (list (+ (car ObjP1) 30)(cadr ObjP1))))
( (= Obja (/ pi 2)) (setq ObjP2 (list (car ObjP1) (+ (cadr ObjP1) 5.25))))
( (= Obja pi)(setq ObjP2 (list (- (car ObjP1) 30)(cadr ObjP1))))
( (= Obja (* 3 (/ pi 2)))(setq ObjP2 (list (car ObjP1) (- (cadr ObjP1) 5.25)))))
 (vl-cmdf "_.copy" ObjC "" ObjP1 Objp2)
 (setq TxtV (entget(entlast)))
 (setq Nw1Txt (subst (cons 1 "###-###") (assoc 1 TxtV) TxtV))
 (entmod Nw1Txt)
 (entupd TxtV)

 (setq NewTxt (strcase (getstring "\nEnter New text value: ")))

 (setq Nw2Txt (subst (cons 1 NewTxt) (assoc 1 TxtV) TxtV))
 (entmod Nw2Txt)

 (setvar "CMDECHO" CREcho)
 (setvar "OSMODE" CREnap)
 (setvar "ORTHOMODE" CROrtho)
 (princ)
 )

 

this is what it does. There is some text that already exists and I just need to copy it a certain distance either up/down/left or right. When copied it changes the text values to "###-###". Then I need to enter new data.

 

It works just fine if I copy a "TEXT" object. If I select an "MTEXT" object it will do the copy but it will not change the value or give me an options to enter a new Value.

 

I thought that "TEXT" and "MTEXT" both have the same DXF code for Text String, which is 1. any thoughts as to why this doesn't work for MTEXT?

[Lee Mac]

Try this:

 

(defun c:COPYPART  (/ *ERROR* NEW OBJA OBJC OBJP1 OBJP2 OLDVARS TLST TXTV VARLST)

 (setq VarLst '("CMDECHO" "ORTHOMODE")
       OldVars (mapcar (function getvar) VarLst))

 ;;-------------Error handler---------------
 (setq *error*  (lambda (msg)
                  (and OldVars (mapcar (function setvar) VarLst OldVars))
                  (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
                      (princ (strcat "\n** Error: " msg " **")))
                  (princ)))
 ;;------------------------------------------------
 (mapcar (function setvar) VarLst '(0 1))

 (if (and (setq ObjC (entsel "\nSelect object to copy down: "))
          (setq ObjA (getangle "\nSpecify direction of copy: " (setq Objp1 (cadr Objc)))))
   (progn
     
     (setq ObjP2 (if (or (= 0 ObjA) (= pi ObjA))
                   (polar ObjP1 ObjA 30)
                   (polar ObjP1 ObjA 5.25)))

     (command "_.copy" ObjC "" "_non" ObjP1 "_non" Objp2)
     (setq TxtV (entlast) TLst (entget TxtV))

     (setq TLst (entmod (subst (cons 1 "####-####") (assoc 1 TLst) TLst)))
     (entupd TxtV)

     (if (/= "" (setq New (strcase (getstring t "\nEnter New Text Value: "))))
       (entmod (subst (cons 1 New) (assoc 1 TLst) TLst)))))

 (mapcar (function setvar) VarLst OldVars)
 (princ))

Bear in mind that when modifying an entity more than once, you will have to update the variable value to the newly modified entity data list.

 

PS> In 2010, the copy command repeats, not sure about other versions - you may need to add "" to the end.

 

PPS> I would use vla-copy to be certain.

[guitarguy1685]

well that definetly works. I'm going to read through it and try to understand how it does what it does. I'm sure i'll have some questions. Thanks, you are so helpful.

[Lee Mac]

You're welcome, happy to help out

[CAB]

How about no copy?

(defun c:COPYPART (/ *ERROR* str OBJA OBJC p2 OLDVARS TLST TXTV dist)

 ;;-------------Error handler---------------
 (defun *error* (msg)
   (and OldVars (mapcar (function setvar) VarLst OldVars))
   (or	(wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
(princ (strcat "\n** Error: " msg " **"))
   )
   (princ)
 )
 ;;------------------------------------------------
 (setvar "ErrNo" 0) ; reset variable
 (while
   (cond
     ((= 52 (getvar "ErrNo")) nil) ; exit on ENTER only
     ((null (setq ObjC (entsel "\nSelect object to copy down: ")))
      (princ "\nMissed! Try again."))
     ((not (vl-position (cdr (assoc 0 (entget (car ObjC)))) '("TEXT" "MTEXT")))
      (princ "\nNot text! Try again."))
     ((not (setq ObjA (getangle "\nSpecify direction of copy: " (setq Objp1 (cadr Objc)))))
      (princ "\nNo angle! Try again."))
     (t
      (if (or (equal 0.0 ObjA 0.0001) (equal pi ObjA 0.0001))
 (setq dist 30.)
 (setq dist 5.25)
      )

      (setq tLst (entget (CAR ObjC)))
      (setq TLst (subst (cons 1 "####-####") (assoc 1 TLst) TLst))
      (setq p2 (cdr (assoc 10 TLst)))
      (setq TLst (subst (cons 10 (polar p2 ObjA dist)) (assoc 10 TLst) TLst))
      (setq p2 (cdr (assoc 11 TLst)))
      (setq TLst (subst (cons 11 (polar p2 ObjA dist)) (assoc 11 TLst) TLst))
      (setq TLst (vl-remove-if
	    '(lambda (pair) (member (car pair) '(-2 -1 5 102 300 330 331 340 350 360 410)))
	    Tlst ))
      
      (if (and (setq Tlst (entmakex TLst))
	(setq Tlst (entget TLst))
	(/= "" (setq str (strcase (getstring t "\nEnter New Text Value: ")))))
 (entmod (subst (cons 1 str) (assoc 1 TLst) TLst))
      )
     )
   )
 )

 (princ)
)

[Lee Mac]

Nice solution Alan!