mtext paragraph spacing

[chulse]

Is it possible to edit the paragraph spacing of mtext via lisp? I couldn't find it listed in the dxf reference (or pehaps I missed it - not sure exactly what to look for)...

 

Assuming it can be accessed by a dxf code, I assume it could be changed with entmod?

 

The reason I ask is that in 2011 that function in the mtext paragraph dialog juust doesn't work. I was told by Autodesk:

 

This is a known issue, and I have received a notice from our development team that this issue has been corrected in the next release's product code. There is a possibility that the change may appear in a future update for AutoCAD 2011, but I cannot confirm, nor promise that. I have linked this case to the defect and you'll be notified when it is fixed. Our apologies for any inconvenience.

 

 

Thanks

[Lee Mac]

MText Formatting code I'm afraid, something like:

 

\\px[color=Blue]b0.5[/color],[color=Red]a0.4[/color];

[color=Blue]before [/color], [color=Red]after[/color]

 

Use this to remove it

[chulse]

MText Formatting code I'm afraid, something like:

 

\\px[color=blue]b0.5[/color],[color=red]a0.4[/color];

[color=blue]before [/color], [color=red]after[/color]

 

Thanks Lee

Is it possible to manipulate it? That isn't a normal DXF code that can be changed with entmod is it...?

Can you give me a hint on how to access it?

[Lee Mac]

The formatting codes are stored in the MText String (DXF 1 & 3), so you would need to manipulate the data encoded within these strings.

[chulse]

ahh, thanks

[Lee Mac]

I thought I might take up the challenge - this is perhaps one way to approach the problem, using the RegEx Object to perform the replacement.

 

(defun c:test ( / *error* ss before after )
 ;; © Lee Mac 2010

 (defun *error* ( msg )
   (and RegEx (vlax-release-object RegEx))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ)
 )

 (if (and (setq ss (ssget "_:L" '((0 . "MTEXT"))))
          (not (initget 5))
          (setq before (getdist "\n'Before' Paragraph Spacing: "))
          (not (initget 5))
          (setq after  (getdist  "\n'After' Paragraph Spacing: ")))
   
   (ApplyFootoSS (lambda ( x ) (LM:ReplaceParagraphFormatting x before after)) ss)
   
 )
 (princ)
)

(defun LM:ReplaceParagraphFormatting ( ent before after / new RegEx )
 
 (mapcar '(lambda ( x ) (and (zerop (eval x)) (set x nil))) '(before after))
 
 (setq new
   (if (apply 'or (list before after))
     (strcat "\\px"
       (if before (strcat "b" (vl-princ-to-string before)) "")
       (if after  (strcat (if before ",a" "a") (vl-princ-to-string after)) "")
       ";"
     )
     ""
   )
 )
 
 (setq RegEx (vlax-create-object "VBScript.RegExp"))
 
 (setq str (LM:RegExReplace RegEx new "\\\\p.*?;" (LM:GetTextString ent)))
 (vlax-release-object RegEx)
 
 (vla-put-TextString (vlax-ename->vla-object ent) str)
)

(defun LM:GetTextString ( ent / string )
 ;; © Lee Mac 2010
 (vl-load-com)
 
 (and (eq 'VLA-OBJECT (type ent))
      (setq ent (vlax-vla-object->ename ent)))
 
 (  (lambda ( string )
      (mapcar
        (function
          (lambda ( pair )
            (if (vl-position (car pair) '(1 3))
              (setq string (strcat string (cdr pair)))
            )
          )
        )
        (entget ent)
      )
      string
    )
   ""
 )
)

(defun ApplyFootoSS ( foo ss )
 ;; © Lee Mac 2010
 (
   (lambda ( i / e )
     (while (setq e (ssname ss (setq i (1+ i)))) (foo e))
   )
   -1
 )
)

(defun LM:RegExReplace ( reg new pat str )
 ;; © Lee Mac 2010
 (mapcar
   '(lambda ( prop value ) (vlax-put-property reg prop value))
   '(pattern global ignorecase) (list pat actrue acfalse)
 )
 (vlax-invoke reg 'replace str new)
)

[chulse]

Thanks Lee

But in 2011 that didn't work - no change. Perhaps due to the "known issue"...?

[chulse]

I was looking at vl-string-subst, but I am not sure what is the best way to extract the string from the entity. For my application of this, the text is quite long - much more than the limits of DXF 1 (and I don't know how to get them , all the DXF 3 and 1, all together...)

[Lee Mac]

Please try the updated code above

[chulse]

That worked! Thanks

 

It does though remove the left alignment & indents of the outline structure.

[Lee Mac]

That worked! Thanks

 

It does though remove the left alignment & indents of the outline structure.

 

Yes, things get tricky at that point...

[chulse]

Is there a reference for the formatting codes? I couldn't find a complete one...

[Lee Mac]

Is there a reference for the formatting codes? I couldn't find a complete one...

 

Not that I know of...

[chulse]

Not that I know of...

 

Well that makes it a bit more challenging

 

Thanks for all your help

[Lee Mac]

I had another stab at it Cary - this should hopefully keep the other formatting in tact (fingers crossed!):

 

(defun c:test ( / *error* ss before after )
 ;; © Lee Mac 2010

 (defun *error* ( msg )
   (and RegEx (vlax-release-object RegEx))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ)
 )

 (if (and (setq ss (ssget "_:L" '((0 . "MTEXT"))))
          (not (initget 5))
          (setq before (getdist "\n'Before' Paragraph Spacing: "))
          (not (initget 5))
          (setq after  (getdist  "\n'After' Paragraph Spacing: ")))
   
   (ApplyFootoSS (lambda ( x ) (LM:ReplaceParagraphSpacing x before after)) ss)
   
 )
 (princ)
)

(defun LM:ReplaceParagraphSpacing ( ent before after / str bstr astr bPar aPar RegEx o )
 ;; © Lee Mac 2010
 
 (setq str (LM:GetTextString ent))

 (mapcar '(lambda ( x ) (and (zerop (eval x)) (set x nil))) '(before after))

 (setq bstr (if before (strcat "b" (vl-princ-to-string before)) ""))
 (setq astr (if after  (strcat "a" (vl-princ-to-string after )) ""))
 
 (setq RegEx (vlax-create-object "VBScript.RegExp") o 0)

 (if (setq bPar (LM:RegExExecute RegEx "b.*?[,;]" str))
   (mapcar
    '(lambda ( s )
       (setq str
         (vl-string-subst
           (strcat bstr (substr (car s) (strlen (car s)))) (car s) str (- (cadr s) o)
         )
       )
       (setq o (- (strlen (car s)) 1 (strlen bstr)))
     )
    bPar
   )
 )
 (setq o 0)
 (if (setq aPar (LM:RegExExecute RegEx "a.*?[,;]" str))
   (mapcar
    '(lambda ( s )
       (setq str
         (vl-string-subst
           (strcat astr (substr (car s) (strlen (car s)))) (car s) str (- (cadr s) o)
         )
       )
       (setq o (- (strlen (car s)) 1 (strlen astr)))
     )
    aPar
   )
 )
 
 (vlax-release-object RegEx)
 
 (vla-put-TextString (vlax-ename->vla-object ent) str)
)

(defun LM:GetTextString ( ent / string )
 ;; © Lee Mac 2010
 (vl-load-com)
 
 (and (eq 'VLA-OBJECT (type ent))
      (setq ent (vlax-vla-object->ename ent)))
 
 (  (lambda ( string )
      (mapcar
        (function
          (lambda ( pair )
            (if (vl-position (car pair) '(1 3))
              (setq string (strcat string (cdr pair)))
            )
          )
        )
        (entget ent)
      )
      string
    )
   ""
 )
)

(defun ApplyFootoSS ( foo ss )
 ;; © Lee Mac 2010
 (
   (lambda ( i / e )
     (while (setq e (ssname ss (setq i (1+ i)))) (foo e))
   )
   -1
 )
)

(defun LM:RegExExecute ( reg pat str / l )
 ;; © Lee Mac 2010
 (mapcar
   '(lambda ( prop value ) (vlax-put-property reg prop value))
   '(pattern global ignorecase) (list pat actrue acfalse)
 )
 (vlax-for x (vlax-invoke reg 'execute str)
   (setq l (cons (list (vlax-get x 'value) (vlax-get x 'firstindex)) l))
 )
 l
)

[chulse]

Hi Lee, sorry it took me so long to get back. Thanks for having another go at this.

I get the following error:

** Error: bad argument value: non-negative: -37 **

 

any ideas?

 

Thanks