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

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