Match Properties Text

[Ocron]

Hello,

 

I was just wondering if there is a LISP routine out there, or if can be done in ACAD itself. I've searched the site and ACAD help menu (useless nowadays it seems) and can't find anyway of changing the setting to do what I want it too.

 

All I basically need is to have a Match Properties command for Text that will Match all the properties like the normal command EXCEPT Rotation. So if I click on my source text and it is rotated at a 30 degree angle, and I match it with one at 45 it will not make the new text be at 30 degrees like the original. Is there a way in ACAD to do this or a LISP routine I have yet to find that can do this for me?

 

Thank you.

[Lt Dan's legs]

(defun c:Mt (/ *error* ent # a ss)
 (defun *error* (msg)
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
        (princ (strcat "\n** Error: " msg " **"))
   )
   (setvar 'nomutt 0)
   (if (not ent)(redraw)
     (redraw (cdr (car ent)) 4))
   (princ)
 )
 (while
   (not
     (and
(setq ent (car (entsel "\nSpecify text to copy: ")))
(or
         (eq "TEXT" (cdr (assoc 0 (setq ent (entget ent)))))
  (eq "MTEXT" (cdr (assoc 0 ent)))
  (eq "DIMENSION" (cdr (assoc 0 ent)))
)
     )
   )
   (prompt "\nPlease Select text!")
 )
 (redraw (cdr (car ent)) 3)
 (prompt "\nSpecify objects to modify: ")
 (setvar 'nomutt 1)
 (repeat (setq # (sslength (setq ss (ssget '((0 . "text,mtext,dimension"))))))
   (setq a (entget (ssname ss (setq # (1- #)))))
   (entmod (subst (cons 1 (cdr (assoc 1 ent)))(assoc 1 a) a))
 )
 (redraw (cdr (car ent)) 4)
 (setvar 'nomutt 0)
 (princ)
)

[alanjt]

oldie: http://www.cadtutor.net/forum/showthread.php?41669-TextMatch-Pick-up-where-MatchProperties-Left-off-%28for-MText-amp-Text%29

[Lee Mac]

Wrote it, so might as well post it:

 

(defun c:mtt ( / *error* _StartUndo _EndUndo _GetTextInsertion _PutTextInsertion Props doc entity object ss )
 (vl-load-com)
 ;; © Lee Mac 2010

 (setq Props
  '(
    Alignment
    AttachmentPoint
    BackgroundFill
    Backward
    DrawingDirection
    Height
    Layer
    LineSpacingDistance
    LineSpacingFactor
    LineSpacingStyle
    Linetype
    LinetypeScale
    Lineweight
    ObliqueAngle
    Rotation
    ScaleFactor
    StyleName
    TextString
    Thickness
    UpsideDown
    Width
   )
 )

 (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))

 (defun *error* ( msg )
   (if doc (_EndUndo doc)) (if mutt (setvar 'NOMUTT mutt))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ)
 )

 (defun _StartUndo ( doc ) (_EndUndo doc)
   (vla-StartUndoMark doc)
 )

 (defun _EndUndo ( doc )
   (if (= 8 (logand 8 (getvar 'UNDOCTL)))
     (vla-EndUndoMark doc)
   )
 )

 (defun _GetTextInsertion ( object )
   (vlax-get-property object
     (if
       (or
         (eq "AcDbMText" (vla-get-ObjectName object))
         (vl-position (vla-get-Alignment object) (list acAlignmentLeft acAlignmentFit acAlignmentAligned))
       )
       'InsertionPoint
       'TextAlignmentPoint
     )
   )
 )

 (defun _PutTextInsertion ( object point )
   (vlax-put-property object
     (if
       (or
         (eq "AcDbMText" (vla-get-ObjectName object))
         (vl-position (vla-get-Alignment object) (list acAlignmentLeft acAlignmentFit acAlignmentAligned))
       )
       'InsertionPoint
       'TextAlignmentPoint
     )
     point
   )
 )

 (if (and
       (setq entity
         (LM:Selectif
           (lambda ( x )
             (wcmatch (cdr (assoc 0 (entget x))) "TEXT,MTEXT,ATTRIB,ATTDEF")
           )
           nentsel "\nSelect Source Object: "
         )
       )
       (progn
         (setq mutt (getvar 'NOMUTT))
         (setvar 'NOMUTT 1)

         (princ (strcat "\nSelect Destination " (cdr (assoc 0 (entget entity))) " objects: "))
         (setq object (vlax-ename->vla-object entity)
           ss
           (ssget "_:L"
             (list
               (assoc 0 (entget entity))
             )
           )
         )
         (setvar 'NOMUTT mutt) ss
       )
     )
   (
     (lambda ( i values / entity obj )

       (_StartUndo doc)
       
       (while (setq entity (ssname ss (setq i (1+ i))))
         (setq obj (vlax-ename->vla-object entity))

         (mapcar
           (function
             (lambda ( prop value / err )
               (if
                 (vl-catch-all-error-p
                   (setq err 
                     (vl-catch-all-apply
                       (function
                         (lambda nil
                           (if (and (vlax-property-available-p obj prop t) value)
                             (if (vl-position prop '(Alignment AttachmentPoint))
                               (
                                 (lambda ( insertion )
                                   (vlax-put-property obj prop value)
                                   (_PutTextInsertion obj insertion)
                                 )
                                 (_GetTextInsertion obj)
                               )
                               (vlax-put-property obj prop value)
                             )
                           )
                         )
                       )
                     )
                   )
                 )
                 (princ
                   (strcat "\n** Error Applying Property: "
                     (vl-princ-to-string Prop) ": " (vl-catch-all-error-message err) " **"
                   )
                 )
               )
             )
           )
           Props Values
         )
       )

       (_EndUndo doc)
     )
     -1
     (mapcar
       (function
         (lambda ( prop )
           (if (vlax-property-available-p object prop)
             (vlax-get-property object prop)
           )
         )
       )
       Props
     )
   )
 )
 (princ)
)


;;---------------------=={ Select if }==----------------------;;
;;                                                            ;;
;;  Continuous selection prompts until the predicate function ;;
;;  foo is validated                                          ;;
;;------------------------------------------------------------;;
;;  Author: Lee McDonnell, 2010                               ;;
;;                                                            ;;
;;  Copyright © 2010 by Lee McDonnell, All Rights Reserved.   ;;
;;  Contact: Lee Mac @ TheSwamp.org, CADTutor.net             ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  foo - optional predicate function taking ename argument   ;;
;;  fun - selection function to invoke                        ;;
;;  str - prompt string                                       ;;
;;------------------------------------------------------------;;
;;  Returns:  selected entity ename if successful, else nil   ;;
;;------------------------------------------------------------;;

(defun LM:Selectif ( foo fun str / e )
 ;; © Lee Mac 2010
 (while
   (progn (setq e (car (fun str)))      
     (cond
       ( (eq 'ENAME (type e))

         (if (and foo (not (foo e))) (princ "\n** Invalid Object Selected **"))
       )
     )
   )
 )
 e
)

Check/Edit list of properties at the top of the code to match

 

Lee

Edited October 12, 2010 by Lee Mac

[alanjt]

LoL, looks familiar.

Nice work.

[Lt Dan's legs]

lee

** Error: bad argument type: stringp ALIGNMENT **

[Lee Mac]

LoL, looks familiar.

 

Familiar to what?

 

Nice work.

 

Thanks mate

[alanjt]

Familiar to what?

The link I posted.

[Lee Mac]

lee

** Error: bad argument type: stringp ALIGNMENT **

 

Thanks Dan, updated

[Lee Mac]

The link I posted.

 

The functionality you mean?

[alanjt]

The functionality you mean?

Yes. They basically do the same thing.

[Ocron]

Ok. I tried out the Lisp and it seemed to work once I took out the rotation property at the top, but I hit a snag when I did the command. It matched properties, and made them the correct text type and everything, Except the original word I used as the base replaces all the other words that it matched. So it copied the text "The" for every text I selected to match. It matched everything about it. But I think a little too much. lol

[Lee Mac]

As I said, you can control exactly which properties you want to match, at the top of the code

[Ocron]

D'oh!

 

Chalk up another instance of User Error. lol

 

Thanks Lee it works perfect. lol

[Lee Mac]

No worries mate