Question for Lee - Match Text Properties

[ILoveMadoka]

Lee,

 

In your Match Text Properties program you mention....

the user has complete control over which properties are to be inherited by selected 'destination' objects. The list of properties located at the top of the program correspond to the ActiveX properties of Text, MText, Attribute or Attribute Definition VLA-Objects and may be edited to suit the user's requirements.

Not sure HOW or WHERE to do this.

 

Looking to do Height, StyleName, Scalefactor, Linespacing Factor.

 

Program as written is not working on the drawing that I am trying to change.

It was converted from VISIO if that matters.

 

Please advise.

 

 

 

;;---------------=={ Match Text Properties }==----------------;;
;;                                                            ;;
;;  Prompts for a selection of Text, MText, Attribute, or     ;;
;;  Attribute Definition object to use as property source,    ;;
;;  then proceed to match those properties listed for similar ;;
;;  objects selected thereafter.                              ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2010 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;

(defun c:MTP nil (c:MatchTextProps))

(defun c:MatchTextProps ( / *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 )
               (if
                 (vl-catch-all-error-p
                   (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: " Prop " **"))
               )
             )
           )
           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 Mac, Copyright © 2010 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  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
)

Thanks Much!!

Edited January 8, 2014 by ILoveMadoka
rev

[Spaj]

Hi

 

At a guess I would say that you need to comment out ( ; ) properties you do not wish to match in the list below, as it stand it looks as though all properties except the contents of the text string are matched. ie to not match LAYER place a ; in front of the variable layer.)

 

 

I'm sure Lee will be along shortly to advise.

 

(setq Props    
 '(      
     Alignment
     AttachmentPoint
     BackgroundFill
     Backward
     DrawingDirection
     Height
     Layer
     LineSpacingDistance
     LineSpacingFactor
     LineSpacingStyle
     Linetype
     LinetypeScale
     Lineweight
     ObliqueAngle
     Rotation
     ScaleFactor
     StyleName
   [color=red]; [/color]TextString  [color=red]<-- property not matched[/color]    
     Thickness      
     UpsideDown
     Width
    )
  )

[ILoveMadoka]

At a closer look, it is the font that is not changing

but it appears that the font was changed outside of the style command.

 

Artifacts from converted drawings are always a PITA!!

 

 

New Question:

 

Can the Source Objects font be forced upon the other selected text objects

over-riding any settings?

[Spaj]

Hi

 

It looks like Lee's routine does match the font, or style at least (StyleName), but if you have individual text formatting overides it's a problem. Maybe try source StripMText.lsp. Does an excellent job of stripping out text formatting.

[Lee Mac]

To clarify, my old Match Text Properties program will only change the ActiveX properties for the selection of objects, and so where 'font' is concerned, the closest property you can change using my existing program is the stylename property, which will alter the Text Style assigned to the object.

 

Since MText formatting which has been applied through the MText Editor is stored as formatting codes within the text content, this cannot be matched using this program without matching the entire content of the text (i.e. matching the textstring property).

 

You have the option of removing the MText formatting overrides (using StripMText as suggested above, or otherwise) and using the Text Style to control the font applied to the entire annotation object; else you would need to write a program to extract the formatting codes surrounding the displayed text content and then insert these codes within the content of the 'destination' annotation object (assuming such object supported MText formatting).

 

Lee