Move text items to (an offset of) the nearest line

[Simon1976]

I have been writing a lisp to move text items to (an offset of) the nearest line retaining the X value of the text item.

Inspiration:

Working on cable diagrams with text items placed (by someone else) too far away from the line (cable) they're supposed to be referencing

Method:

1) To select text & line items

2) Separate into two different selection sets

3) find the perpendicular distance from the Y value of the lines to the XY coordinate of each text item, find the minimum di

stance to the nearest line, then move the text item by that amount to 1mm above/below that nearest line

Notes:

a) Either assoc 10 or 11 would have done for the lines - they're all horizontal

b) If I'd 'enselled' each line , then ssgetted the text it would be easy - but I wanted to do the operation enmass

The code below works for selected text items above the lines. but not the ones below. With this in mind I decided to re-write the lisp using the function distance within the lambda expression to keep the values positive (& therefore find the minimum distance), that when these headaches began...

 

 

(defun c:txtmagnet ( / dstlst ent idx lentx dstmin npt ss ssl sst tent thgt txtp xtxt ylinlst ytxt)
      (setq sst  (ssadd)  ssl (ssadd)
             ss       (ssget '((0 . "LINE,TEXT"))))
 
            (while (setq ent (ssname ss 0));; while to separate text items from line entities
    (if (eq (cdr (assoc 0 (entget ent))) "LINE")
     (ssadd ent ssl) (ssadd ent sst))
                   (ssdel ent ss)
       )
 (repeat (setq idx (sslength ssl));; repeat to create list of Y values of selceted lines
   (setq idx (1- idx))
   (setq lentx (entget(ssname ssl idx)))
   (if Ylinlst
     (setq Ylinlst (append Ylinlst (list(caddr(assoc 10 lentx)))))
     (setq Ylinlst (list(caddr(assoc 10 lentx))))
     )
   )
  (repeat (setq idx (sslength sst));; repeat to find nearest line (in Y direction) & move text item to I unit above that line
    (setq  idx (1- idx)
       tent (ssname sst idx)
        Xtxt (cadr(assoc 10 (entget tent)))
       Ytxt (caddr(assoc 10 (entget tent)))
       dstlst (mapcar '(lambda (x) (if (> Ytxt x) (- Ytxt x) (- x Ytxt)))Ylinlst)
       dstmin (apply 'min dstlst)
       txtp (cdr (assoc 10 (entget tent)))
      npt (list Xtxt (- Ytxt (- dstmin 1)) 0.0 ))
    (command "_move" tent "" "_none" txtp "_none" npt)
    )
 ;;(princ (strcat "\n" (itoa (sslength ssl)) " Line Items")); testing only
 ;;(princ (strcat "\n" (itoa (sslength sst)) " Text Items")); testing only
 (princ)
)

Please can one of you genius' (genii?) help with this? The top picture show before, the lower one is the deisired result

 

 

- Simon

[Tharwat]

Hi Simon,

 

Please try the following program and let me know:

 

(defun c:test  (/ sel int obj lst txt srt p pt c l e)
 ;;====================================================;;
 ;; Author: Tharwat Al Shoufi. Date: 10.Apr.2016    ;;
 ;; move single text objects to nearest line with 1.0    ;;
 ;; unit away on Y Axe.                ;;
 ;;====================================================;;
 (if (setq sel (ssget "_:L" '((0 . "LINE,TEXT"))))
   (repeat (setq int (sslength sel))
     (if (eq "LINE" (cdr (assoc 0 (entget (setq obj (ssname sel (setq int (1- int))))))))
       (setq lst (cons obj lst))
       (setq txt (cons obj txt))
       )
     )
   )
 (if (and lst txt)
   (mapcar '(lambda (xt)
     (setq l nil
           e (entget xt)
           p (cdr (assoc 10 e))
           )
     (mapcar '(lambda (n)
                (setq c (vlax-curve-getclosestpointto n p)
                      l (cons (list (distance c p) c) l)
                      )
                )
             lst)
              (setq srt (vl-sort l '(lambda (j k) (< (car j) (car k)))))
              (if (< (cadr (cadar srt)) (cadr p))
                (setq pt (polar (cadar srt) (* pi 0.5) 1.0))
                (setq pt (polar (cadar srt) (* pi 1.5) (1+ (cdr (assoc 40 e)))))
                )
              (entmod (subst (cons 10 pt)
                             (assoc 10 e)
                             e))
              )
           txt
           )
   )
 (princ)
 )(vl-load-com)

Edited April 10, 2016 by Tharwat

[Simon1976]

Hello Mr Tharwat

 

 

It sort of works, the text over the lines move to the right place, but the text under the lines go to over the lines. They're supposed to move upwards to just under the lines with a 1mm offset (please have a look at my second (lower) picture compared with the upper picture

[Tharwat]

Yeah, sorry I completely forgot about the under line texts

Not a problem.

 

CODES UPDATED ABOVE

[Simon1976]

Works excellently thank you very much indeed Tharwat.

 

 

I spent hours on that, you did it in minutes very impressive indeed

[Tharwat]

Works excellently thank you very much indeed Tharwat.

 

I spent hours on that, you did it in minutes very impressive indeed

 

Nice, you are most welcome.

[Simon1976]

That's odd, the lisp doesn't work here at work. The only difference is I'm using 2014 at work & 2009 at home.

 

 

The lisp doesn't give an error message or crash , it prompts to select objects (which I do) then can be seen working (evidenced by the blue rectangle that appears) then nothing, the text remains unmoved

[Tharwat]

You maybe trying to select Mtext instead of Single texts!

[Simon1976]

You maybe trying to select Mtext instead of Single texts!

 

No, they're just ordinary text items - not mtext

[Tharwat]

You need to upload a sample drawing for me to take a close look.

[Lee Mac]

DXF group 10 will only apply to text with justification set to Left.

[Simon1976]

Where's the attach file icon?

 

 

EDIT

 

 

Ah, only just seen the post from Lee Mac

 

 

The justification was set to ML & I never noticed. Set the justification to 'Start' & it works

Edited April 11, 2016 by Simon1976
Just noticed another post by Lee Mac

[Tharwat]

Hi Simon,

 

Here is the new modification of the same previously written program to include ALL sorts of justifications as well.

 

(defun c:Test  (/ sel int obj lst txt srt p c l e v lf rt)
 ;;====================================================;;
 ;; Author: Tharwat Al Shoufi. Date: 12.Apr.2016    	;;
 ;; move single text objects to nearest line with 1.0	;;
 ;; unit away from Y Axe.                		;;
 ;;====================================================;;
 (if (setq sel (ssget "_:L" '((0 . "LINE,TEXT"))))
   (repeat (setq int (sslength sel))
     (if (eq "LINE" (cdr (assoc 0 (entget (setq obj (ssname sel (setq int (1- int))))))))
        (setq lst (cons obj lst))
        (setq txt (cons obj txt))
        )
     )
   )
 (if (and lst txt)
   (mapcar
     '(lambda (xt)
        (setq l nil
              e (entget xt)
              v (vlax-ename->vla-object xt)
              )
        (vla-getboundingbox v 'lf 'rt)
        (setq p (vlax-safearray->list lf))
        (mapcar '(lambda (n)
                   (setq c (vlax-curve-getclosestpointto n p)
                         l (cons (list (distance c p) c) l)
                         )
                   )
                lst
                )
        (vlax-invoke v 'move p (if (< (cadr (cadar (setq srt (vl-sort l '(lambda (j k) (< (car j) (car k))))))) (cadr p))
                                 (polar (cadar srt) (* pi 0.5) 1.0)
                                 (polar (cadar srt) (* pi 1.5) (1+ (cdr (assoc 40 e))))
                                 )
          )
        )
     txt
     )
   )
 (princ)
 )(vl-load-com)

 

Regarding to your question about how to attach file(s) to thread - Have a look at the right side hand a bit down to see the button Go Advanced, hit the button then from that new page you can see many options and not only attachments to go with.

 

Good luck.

[Grrr]

Awesome code, Tharwat

I have to mention that it would work for MTEXT aswell !

[Tharwat]

Awesome code, Tharwat

 

Thank you.

 

I have to mention that it would work for MTEXT aswell !

 

Yeah, you are right - the program should be able now to handle Mtext objects as well.

[Simon1976]

Most excellent Tharwat ! Thank you very much indeed

In the back of my mind I was wondering if it was possible using the bounding box method or whether to simply set all the (ordinary) text items to left justified. I hadn't had time as yet to think about it though.

I do hope you won't be offended but I added:

[setq] thgt (cdr (assoc 40 (entget xt)))

And replaced:

 (polar (cadar srt) (* pi 0.5)[color=red] [color=royalblue]1.0[/color][/color][color=blue])[/color]
(polar (cadar srt) (* pi 1.5) ([color=seagreen]1[/color]+[color=seagreen] [color=royalblue](cdr (assoc 40 e))[/color][/color]))

With:

 (polar (cadar srt) (* pi 0.5)[color=red] (* thgt 0.5)[/color])
(polar (cadar srt) (* pi 1.5) [color=red](+ thgt (* thgt 0.5[/color][color=red])[/color]))

My fault really, when writing the original lisp I hadn't concidered larger text, which would need a larger offset than 1 unit to display sensibly

 

 

Ohhh. 'Go Advanced' I never tried that button Thanks for the info

 

EDIT:

I haven't worked out how you've found which line is closest though!

Edited April 12, 2016 by Simon1976
Addendum

[Tharwat]

You are most welcome Simon, I am glad that my program works as expected.

 

No offence taken at all , feel free to modify the part you want from the program with respect to the original author would be appreciated for sure.

 

Happy coding.

[Simon1976]

 

Don't worry, I always include the original author in the header above the lisp with a copy of the web address, who knows when others or self will want to revisit it.

 

 

It's no good passing it onto others if I cannot explain it all, besides It's just not cricket as we English say