Lisp to move texts

[Sandeep RC]

Can anybody help me creating a lisp program that moves all the selected texts (cyan colored one's in this case) so that it does not overlap with nearby texts (magenta colored one's in this case) & nearby polylines.

This can be possible if the lisp,

1) prompts user to specify a radius 

2) then moves texts lets say vertically or horizontally by that specified distance

3) moves texts along the circumference, lets say by every 45 degree until it does not overlap with nearby text or polylines.

please see attached cad file for reference. thank you.

(circle, polyline & points drawn in 252 color are just for imagination)

Drawing3.dwg

[BIGAL]

The question of overlapping text I think has been around since CAD was created, some software goes to great lengths to move text around but that can lead to the text is no longer relevant to the point its referencing.

The cyan and the magenta text are problems. 

 

Not really an answer but I would look at a rotation of text rather than move. Select a few rotate say 30 degrees if ok press Enter else any key to rotate 30 again. Wrapped in a lisp.

 

 

[Sandeep RC]

@BIGAL Totally agree with your 1st point. But as long as rotating texts is concerned, The network is spreaded across all possible directions, so eventually texts are going to get overlapped again. 

[Sandeep RC]

Anyone one please? who can help me on this?

[Steven P]

Not sure exactly how to do that just now, did an internet search give you any results? Maybe not exactly but something that is close?

 

As a rough starter though, you can get the bounding box of a text - draw a box around the text from this example (http://lee-mac.com/ssboundingbox.html), creating them on a seperate layer perhaps? and then highlight if they overlap (something like this: https://forums.autodesk.com/t5/autocad-forum/editing-overlapping-objects/td-p/6934424). I haven't checked if this works yet though it should highlight where the problems are, quicker to look at and manually fix.

 

I'd need to think how best to link the bounding box to the text it contains to sort the moving out

 

 

[Sandeep RC]

@Steven P Okay, I will go through the above links, mean while let me know,

if a text's base point is exactly on the edge of a circle or a circular block,

then is it possible for a lisp program to move that text by certain or user specified degrees along the circumference until it does not overlap with the nearby plines or texts?

If such kind of thing is possible then it can help me achieve what I am looking for.

[marko_ribar]

I've found in my library something ab overlapping of TEXT(S), but it's *.VLX...

Nevertheless, I am attaching it, so that you can test it in your example *.DWG...

If you are satisfied with result, then just fine. I am OK, not author, but he/she would agree with me if it works as desired...

 

HTH.

M.R.

 

TxtOverlap.VLX txtoverlap.txt

Edited June 1, 2023 by marko_ribar

[Sandeep RC]

@marko_ribar Thanks for replying. Tried above vlx.

It just marks out the overlapping texts.

I need something that helps me move those texts around as well so that they do not overlap with nearby texts or plines.

[Tsuky]

A start with the following.
I leave it to you to improve it at your convenience but I think it is difficult to meet all your requirements because the slightest modification can lead to other overlaps which were not present at the start.

 

(defun draw_tbox ( e / dxf_ent p0 ang sin_a cos_a t_box l_box)
  (setq
    dxf_ent (entget e)
    p0 (cdr (assoc 10 dxf_ent))
    ang (cdr (assoc 50 dxf_ent))
    sin_a (sin ang)
    cos_a (cos ang)
    t_box (textbox dxf_ent)
    l_box
    (mapcar
      '(lambda (x)
        (list
          (+
            (car p0)
            (-
              (* (car x) cos_a)
              (* (cadr x) sin_a)
            )
          )
          (+
            (cadr p0)
            (+
              (* (car x) sin_a)
              (* (cadr x) cos_a)
            )
          )
        )
      )
      (append
        t_box
        (list
          (list (caadr t_box) (cadar t_box) (caddar t_box))
          (list (caar t_box) (cadadr t_box) (caddr (cadr t_box)))
        )
      )
    )
  )
  (entmake
    (list
      '(0 . "LWPOLYLINE")
      '(100 . "AcDbEntity")
      (cons 67 (if (eq (getvar "CVPORT") 1) 1 0))
      (cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model"))
      (cons 8 (getvar "CLAYER"))
      (cons 62 (atoi (getvar "CECOLOR")))
      (cons 6 (getvar "CELTYPE"))
      (cons 370 (getvar "CELWEIGHT"))
      '(100 . "AcDbPolyline")
      '(90 . 4)
      (if (eq (getvar "PLINEGEN") 1) '(70 . 129) '(70 . 1))
      (cons 43 (getvar "PLINEWID"))
      (cons 38 (getvar "ELEVATION"))
      (cons 39 (getvar "THICKNESS"))
      (cons 10 (car l_box))
      '(40 . 0.0)
      '(41 . 0.0)
      '(42 . 0.0)
      '(91 . 0)
      (cons 10 (caddr l_box))
      '(40 . 0.0)
      '(41 . 0.0)
      '(42 . 0.0)
      '(91 . 0)
      (cons 10 (cadr l_box))
      '(40 . 0.0)
      '(41 . 0.0)
      '(42 . 0.0)
      '(91 . 0)
      (cons 10 (cadddr l_box))
      '(40 . 0.0)
      '(41 . 0.0)
      '(42 . 0.0)
      '(91 . 0)
      (assoc 210 dxf_ent)
    )
  )
)
(defun c:TEST ( / ss_keep ss_work n ent_k tmp_k obj_k ent_w tmp_w obj_w vrt_pt)
  (setq ss_keep
    (ssget "_X"
      (list
        '(0 . "TEXT")
        (cons 67 (if (eq (getvar "CVPORT") 1) 1 0))
        (cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model"))
        '(8 . "CONDUIT")
        '(62 . 6)
        '(40 . 2.0)
        '(7 . "Standard")
      )
    )
  )
  (setq ss_work
    (ssget "_X"
      (list
        '(0 . "TEXT")
        (cons 67 (if (eq (getvar "CVPORT") 1) 1 0))
        (cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model"))
        '(8 . "INTERSECTION")
        '(62 . 4)
        '(40 . 2.0)
        '(7 . "Standard")
      )
    )
  )
  (cond
    ((and ss_keep ss_work)
      (repeat (setq n (sslength ss_keep))
        (setq ent_k (ssname ss_keep (setq n (1- n))))
        (draw_tbox ent_k)
        (setq
          tmp_k (entlast)
          obj_k (vlax-ename->vla-object tmp_k)
        )
        (repeat (setq i (sslength ss_work))
          (setq ent_w (ssname ss_work (setq i (1- i))))
          (draw_tbox ent_w)
          (setq
            tmp_w (entlast)
            obj_w  (vlax-ename->vla-object tmp_w)
            vrt_pt (vlax-variant-value (vla-IntersectWith obj_k obj_w 0))
          )
          (if (>= (vlax-safearray-get-u-bound vrt_pt 1) 0)
            (entmod (subst (assoc 50 (entget ent_k)) (assoc 50 (entget ent_w)) (entget ent_w)))
          )
          (entdel tmp_w)
        )
        (entdel tmp_k)
      )
    )
  )
  (prin1)
)

 

Edited June 4, 2023 by Tsuky

[Sandeep RC]

@Tsuky  Thank you for the effort. but this is something different than what is was looking for.

All I need is a lisp that moves only overlapping texts around without changing texts rotation.

I don't know how to write or modify a lisp.

But based on my Autocad experience, I mentioned few criteria's which I believe can help achieve what I am looking for or I wouldn't mind any other way around as well. Thank you.

Edited June 5, 2023 by Sandeep RC