Lisp to edit mtext

[warlock-993]

hello everybody,

 

can anyone help me? .. I have a number of mtext in a specified layer like the following example:

 

2 B32-149 [T2]

6 B32-154 [T1]

2 B32-145 [b2]

40 B12@200-150 [Ring]

44 B12@200-151 [Ring]

 

so every mtext consist of the following parts:

1. a number (2,6,2,40,44)

2. a space

3. (B32,B32,B32,B12,B12)

4. "-"

5. a number (149,154,145,150,151)

6. [T2],[T1],[b2],[Ring],[Ring]

 

What I need is to edit all mtexts of the specified layer in the entire drawing and

edit them to change the number after the "-" so that it start with a specific number the increment by 1 until the last mtext. I need them to be like:

 

2 B32-100 [T2]

6 B32-101 [T1]

2 B32-102 [b2]

40 B12@200-103 [Ring]

44 B12@200-104 [Ring]

 

Is that Possible?

 

I don't know anything about lisp programming so any help will be appreciated

[warlock-993]

and if anyone find a way to make it, is it possible to make it give the same mtexts the same numbering? For example:

if there is two mtexts like this:

2 B32-100 [T2]

2 B32-100 [T2]

and we edit the first one and after re-numbering it became like this 2 B32-140 [T2] .... I need the second one to be the same and have the same number (140)

[Roy_043]

Why are the numbers in the desired result in sequence? What determines this?

[warlock-993]

because the numbers i have are not sequenced and random so i need them to be sequenced in order to avoid any missing number.

sometimes the numbers are like this:

101-102-103-104-124-125-...

you see there is a gap between 104-124 and in need to edit them in order to avoid this gap

[Roy_043]

What I meant:

Why does the first line have the lowest number? Are the entities arranged in a column and should the renumbering occur from top to bottom?

[warlock-993]

because it is the first one in the drawing, and yes it would be great if the renumbering started from the top to bottom

[Roy_043]

Are the entities in a column or not?

[warlock-993]

no they are not ... they are scattered all around the drawing ... so if it's possible to make the renumbering start from left to right and then move downward

[Grrr]

no they are not ... they are scattered all around the drawing ... so if it's possible to make the renumbering start from left to right and then move downward

 

The task you're requesting reminds me of this.

[Roy_043]

I doubt if the sorting makes much sense, but anyway try this:

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

Edited December 5, 2016 by Roy_043

[Grrr]

@Roy, I had a quick glance at your code.

I think that inside the ConvSort subfunction, you should sort by boundingboxes's centroids, instead of 'insertionpoint.

[warlock-993]

I doubt if the sorting makes much sense, but anyway try this:

(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 ConvSort (objLst)
 (mapcar
   '(lambda (i) (nth i objLst))
   (vl-sort-i
     (mapcar '(lambda (obj) (vlax-get obj 'insertionpoint)) 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)))
     (numberp (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)
)

 

 

I'll give it a try and get back to you ... Thanks

[Roy_043]

@Grrr: I don't think it makes much difference here, but sure, why not (code updated).

[warlock-993]

@Roy_043: It works perfectly ... Thank you very much for your help.

is there any way to modify it in order to work on both text and mtext?

Thanks again for your ... I really appreciate it

[Roy_043]

Updated code again. Removed unnecessary call to numberp:

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

[warlock-993]

thanks @roy

I figured out how to make it work on text as well as mtext so thank you again for your help

[warlock-993]

@roy Is it possible to adjust the lisp so that the mtexts like these:

40 B12@200-150 [Ring]

44 B12@200-151 [Ring]

if the number right before the "@" is the same the lisp renumber them with the same number, for example:

40 B12@200-150 [Ring]

44 B12@200-151 [Ring]

the number berfore the "@" for both of them is "12" so i need them to become after the renumbering like this:

40 B12@200-100 [Ring]

44 B12@200-100 [Ring]

I need this adjustment only to the mtexts that have [Ring] in the last of them.

Thanks in advance

[Roy_043]

@warlock-993: Call it your lucky day:

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

[warlock-993]

Thanks a lot @roy ... You're a savior