[编程交流] Lisp编辑多行文字

(defun KGA_Conv_Pickset_To_ObjectList (ss / i ret)
 (if ss
   (repeat (setq i (sslength ss))
     (setq ret (cons (vlax-ename->vla-object (ssname ss (setq i (1- i)))) ret))
   )
 )
)
(defun KGA_Geom_ObjectMiddle (obj / ptBL ptTR)
 (vla-getboundingbox obj 'ptBL 'ptTR)
 (mapcar
   '/
   (mapcar '+ (vlax-safearray->list ptBL) (vlax-safearray->list ptTR))
   '(2.0 2.0 2.0)
 )
)
(defun ConvSort (objLst)
 (mapcar
   '(lambda (i) (nth i objLst))
   (vl-sort-i
     (mapcar '(lambda (obj) (KGA_Geom_ObjectMiddle obj)) objLst)
     '(lambda (a b)
       (if (equal (cadr a) (cadr b) 1e- ; Equal Y.
         (< (car a) (car b))
         (> (cadr a) (cadr b))
       )
     )
   )
 )
)
; (ConvStr "40 B12@200-150 [Ring]" 123) => "40 B12@200-123 [Ring]"
(defun ConvStr (str n / i)
 (strcat
   (substr str 1 (setq i (1+ (vl-string-position 45 str))))
   (itoa n)
   (progn
     (setq str (substr str (1+ i)))
     (while (wcmatch (substr str 1 1) "#") (setq str (substr str 2)))
     str
   )
 )
)
(defun c:Conv ( / doc enm lst lyr num ss)
 (setq doc (vla-get-activedocument (vlax-get-acad-object)))
 (vla-endundomark doc)
 (vla-startundomark doc)
 (if
   (and
     (setq enm (car (entsel "\nEntity for layer: ")))
     (setq lyr (vla-get-layer (vlax-ename->vla-object enm)))
     (setq num (getint "\nStart nr.: "))
     (setq num (1- num))
     (setq ss (ssget "_X" (list '(0 . "MTEXT") (cons 8 lyr) '(1 . "*-#*"))))
     (setq ss (ConvSort (KGA_Conv_Pickset_To_ObjectList ss)))
   )
   (mapcar
     '(lambda (obj / str)
       (vla-put-textstring
         obj
         (cond
           ((cdr (assoc (setq str (vla-get-textstring obj)) lst)))
           ((cdar (setq lst (cons (cons str (ConvStr str (setq num (1+ num)))) lst))))
         )
       )
     )
     ss
   )
 )
 (vla-endundomark doc)
 (princ)
)