Jump to content

Match Properties Text


Ocron

Recommended Posts

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.

Link to comment
Share on other sites

(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)
)

Link to comment
Share on other sites

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 by Lee Mac
Link to comment
Share on other sites

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

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...