[编程交流] 多行文字段落间距

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

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