Question for Lee - Match Text

ILoveMadoka · 发表于 2022-7-5 23:45:15

Lee,

In your Match Text Properties program you mention....
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.

copy

;;---------------=={ 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!!

Spaj · 发表于 2022-7-6 00:04:32

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.

[code](setq Props '( Alignment AttachmentPoint BackgroundFill Backward DrawingDirection Height Layer LineSpacingDistance LineSpacingFactor LineSpacingStyle Linetype LinetypeScale Lineweight ObliqueAngle Rotation ScaleFactor StyleName ; TextString

ILoveMadoka · 发表于 2022-7-6 00:25:27

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 · 发表于 2022-7-6 00:32:31

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 · 发表于 2022-7-6 00:46:18

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

[编程交流] Question for Lee - Match Text

发表回复

精选推荐