社区 › Auto Lisp › 多行文字段落间距

Lee Mac 发表于 2022-7-6 11:21:13

 
是的，事情在那一点上变得棘手。。。

chulse 发表于 2022-7-6 11:23:41

是否有格式代码的参考？我找不到一个完整的。。。

Lee Mac 发表于 2022-7-6 11:29:23

 
据我所知。。。

chulse 发表于 2022-7-6 11:32:00

 
这让它更具挑战性
 
谢谢你的帮助

Lee Mac 发表于 2022-7-6 11:37:52

我又试了一次，Cary-这应该能让其他格式保持得体（祈祷吧！）
 

(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 发表于 2022-7-6 11:41:10

嗨，李，对不起，我花了这么长时间才回来。谢谢你再来一次。
我得到以下错误：
**错误：错误参数值：非负：-37**
 
有什么想法吗？
 
谢谢

查看完整版本: 多行文字段落间距