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

(numberp (setq num (getint "\nStart nr.: ")))

(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)))) ; (ascii "-") => 45.
   (itoa n)
   (progn
     (setq str (substr str (1+ i)))
     (while (wcmatch (substr str 1 1) "#") (setq str (substr str 2)))
     str
   )
 )
)
; (ConvRingNumGet "40 B12@200-150 [Ring]") => 12
(defun ConvRingNumGet (str / i j)
 (if (setq i (vl-string-position 64 str i)) ; (ascii "@") => 64.
   (progn
     (setq j i)
     (while (and (/= j 0) (wcmatch (substr str j 1) "#"))
       (setq j (1- j))
     )
     (if (/= i j) (atoi (substr str (1+ j) (- i j))))
   )
 )
)
(defun c:Conv ( / doc enm lyr mainNum ringNumLst ss strLst)
 (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 mainNum (getint "\nStart nr.: "))
     (setq mainNum (1- mainNum))
     (setq ss (ssget "_X" (list '(0 . "MTEXT,TEXT") (cons 8 lyr) '(1 . "*-#*"))))
     (setq ss (ConvSort (KGA_Conv_Pickset_To_ObjectList ss)))
   )
   (mapcar
     '(lambda (obj / ringNum str)
       (vla-put-textstring
         obj
         (cond
           ((cdr (assoc (setq str (vla-get-textstring obj)) strLst)))
           ((wcmatch str "*#`@*-#*`[Ring`]")
             (if (assoc (setq ringNum (ConvRingNumGet str)) ringNumLst)
               (cdar (setq strLst (cons (cons str (ConvStr str (cdr (assoc ringNum ringNumLst)))) strLst)))
               (progn
                 (setq ringNumLst (cons (cons ringNum (setq mainNum (1+ mainNum))) ringNumLst))
                 (cdar (setq strLst (cons (cons str (ConvStr str mainNum)) strLst)))
               )
             )
           )
           ((cdar (setq strLst (cons (cons str (ConvStr str (setq mainNum (1+ mainNum)))) strLst))))
         )
       )
     )
     ss
   )
 )
 (vla-endundomark doc)
 (princ)
)