merge intersecting text with same value

[marlance]

Is it possible to merge intersecting text with the same value?

Heres my problem. text are too close to each other

it should be like this

[pbejse]

---

@hmsilva wrote:
Nicely coded, pBe.

Henrique

---

Thank you kind sir, 

You may notice it was written in haste as i threw in vanilla and VL coding all over the place. 🙂

Cheers

pBe

[marko_ribar]

I just gave you a kudo... You're right, I haven't tested my code thoroughly... Here is quick fix, but my previous code (before final - with selection sets couldn't be quick fixed as I wanted)... Never mind, this one works like yours, but nontheless I think your code if better, more concise, and I think it's slightly faster...

Thanks for your testing drawing... I thought I solved it...

(defun c:mergetxts ( / massoc _intl unique touchlst sstxt i ent enttxt txtent txtgroups touchtxtgroup touchtxtgroups txtlstnew )

  (defun massoc ( search lst )
    (vl-remove nil
      (if lst
        (cons
          (assoc search lst)
          (massoc search (cdr (member (assoc search lst) lst)))
        )
      )
    )
  )

  (defun _intl ( l1 l2 / ll1 ll2 a ls1 ls2 )
    (setq ll1 l1
          ll2 l2
    )
    (while
      (setq a (car ll2))
      (while ll1
        (if (equal a (car ll1) 1e-8)
          (setq ls1 (append ls1 (list a))
                ll1 (cdr ll1)
          )
          (setq ll1 (cdr ll1))
        )
      )
      (setq ll2 (cdr ll2)
            ll1 (vl-remove a l1)
      )
    )
    (setq ll1 l1
          ll2 l2
    )
    (while
      (setq a (car ll1))
      (while ll2
        (if (equal a (car ll2) 1e-8)
          (setq ls2 (append ls2 (list a))
                ll2 (cdr ll2)
          )
          (setq ll2 (cdr ll2))
        )
      )
      (setq ll1 (cdr ll1)
            ll2 (vl-remove a l2)
      )
    )
    (if (< (length ls1) (length ls2)) ls1 ls2)
  )
  
  (defun unique ( lst )
    (if lst (cons (car lst) (vl-remove-if '(lambda ( x ) (equal (_intl x (car lst)) x)) (unique (cdr lst)))))
  )

  (defun touchlst ( txte txtgroup / txtent lst )
    (vl-load-com)
    (setq lst (cons txte lst))
    (foreach txtent txtgroup
      (if (not (eq (cadr txte) (cadr txtent)))
        (if (vlax-invoke (vlax-ename->vla-object (cadr txte)) 'intersectwith (vlax-ename->vla-object (cadr txtent)) acextendnone)
          (progn
            (setq lst (cons txtent lst))
            (setq txte txtent)
          )
        )
      )
    )
    lst
  )

  (setq sstxt (ssget "_:L" '((0 . "TEXT"))))
  (setq i -1)
  (while (setq ent (ssname sstxt (setq i (1+ i))))
    (setq txtgroups (cons (list (cdr (assoc 1 (entget ent))) ent) txtgroups))
  )
  (setq txtgroups (mapcar '(lambda ( x ) (massoc (car x) txtgroups)) txtgroups))
  (setq txtgroups (unique txtgroups))
  (foreach txtgroup txtgroups
    (foreach txtent txtgroup
      (setq touchtxtgroup (cons (touchlst txtent (vl-remove txtent txtgroup)) touchtxtgroup))
    )
    (setq touchtxtgroup (vl-sort touchtxtgroup '(lambda ( a b ) (> (length a) (length b)))))
    (setq touchtxtgroup (unique touchtxtgroup))
    (setq touchtxtgroups (cons touchtxtgroup touchtxtgroups))
    (setq touchtxtgroup nil)
  )
  (foreach touchtxtgroup touchtxtgroups
    (foreach touch touchtxtgroup
      (setq txtlstnew (cons (car touch) txtlstnew))
    )
  )
  (setq i -1)
  (while (setq enttxt (ssname sstxt (setq i (1+ i))))
    (if (not (vl-member-if '(lambda ( x ) (eq enttxt (cadr x))) txtlstnew))
      (entdel enttxt)
    )
  )
  (princ)
)

 Regards, M.R.

[pbejse]

---

@marko_ribar wrote:

I just gave you a kudo..

Thanks for your testing drawing... I thought I solved it...

 Regards, M.R.

---

Thank you M.R.

You are welcome, i guess now you did.

Cheers

pBe

[marko_ribar]

---

@pbejse wrote:

---

@marko_ribar wrote:

I just gave you a kudo..

Thanks for your testing drawing... I thought I solved it...

 Regards, M.R.

---

Thank you M.R.

You are welcome, i guess now you did.

Cheers

pBe

---

Just tested on my 1000 gropus, your code is much faster ab 10 times faster than mine... So you win at the end... How will you celebrate your victory?

M.R.

[marko_ribar]

One note pBe, since you're working in VLIDE, have a look into this settings... When set up this way, when clicked format button on code, empty spaces with tabs will be replaced with normal spaces... Now when your code is pasted from VLIDE into notepad (++) or here into Insert Code, formatting will be preserved with spaces... This ensures that anyone that then copy+paste your code from your post will obtain code in format it's posted and VLIDE has formated...

One more note... You are using small caps in almost all functions inside your code, then what does mean (Car) or (Foreach), shouldn't that be (car) or (foreach)... Please take look in my posted pictures ab setting VLIDE, small intervention on your side can make hudge improvenment on the people using your codes... And yes, now your formatting is much better than it was - you added a habbit that you press format button...

M.R.

Thanks again for your advanced coding...

[pbejse]

---

@marko_ribar wrote:

One note pBe, since you're working in VLIDE, have a look into this settings...

.... And yes, now your formatting is much better than it was - you added a habbit that you press format button...

---

Thank you for the tip M.R. I will try to set my format options on vlide.