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

Question for Lee - Match Text

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.
 
 
 

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

(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
页: [1]
查看完整版本: Question for Lee - Match Text