Jump to content
archipelag0

Moving Text Block to adjacent point

Recommended Posts

archipelag0

I use a very useful LISP by Pedro Ferreira called PMSFptwtxt which places a 3D point at the insertion point of a text string. It's great for processing point surveys which have been flattened, thus losing their elevation height.

 

Unfortunately the text label giving z-values for each point is usually not positioned correctly relative to the point which it describes, so the 3D points created are correct in z-value but not x and y. Most labels are consistently located (say top right) at a fixed distance from the point, but a few are below left or above centre etc. Having gone through labouriously finding and moving any rougue labels by eye, I started thinking there might be a more efficient way to acheive this.

 

If there was a recursive LISP that draws a line between the text insertion point and it's neighbouring point then I could filter the line lengths to find the atypical distances and fix these manually, then select the remaining labels and move them all together. The only tricky bit would be telling the LISP which point the text relates to. I'm guessing this could be done with some sort of delaunay/voronoi routine to find the nearest neighbour. I'm a LISP noob, so I'm not even sure if this is possible but any hints/opinions would be gratefully received...

 

Thanks in advance!

 

Tom

Share this post


Link to post
Share on other sites
Lee Mac

Why does the LISP have to be recursive?

 

Give this a try:

 

[color=GREEN];; Text 2 Point  -  Lee Mac 2012[/color]
[color=GREEN];; Prompts for a selection of Text and Point entities and moves[/color]
[color=GREEN];; each Text entity to the nearest (2D distance) Point entity in the set.[/color]
[color=GREEN];;[/color]
[color=GREEN];; Retains existing Text elevation.[/color]

([color=BLUE]defun[/color] c:txt2pt ( [color=BLUE]/[/color] _textinsertion di1 di2 dxf ent inc ins lst mpt pnt sel txt )

   ([color=BLUE]defun[/color] _textinsertion ( elist )
       ([color=BLUE]if[/color]
           ([color=BLUE]and[/color]
               ([color=BLUE]zerop[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 72 elist)))
               ([color=BLUE]zerop[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 73 elist)))
           )
           ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 10 elist))
           ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 11 elist))
       )
   )

   ([color=BLUE]if[/color] ([color=BLUE]setq[/color] sel ([color=BLUE]ssget[/color] [color=MAROON]"_:L"[/color] '((0 . [color=MAROON]"POINT,TEXT"[/color]))))
       ([color=BLUE]progn[/color]
           ([color=BLUE]repeat[/color] ([color=BLUE]setq[/color] inc ([color=BLUE]sslength[/color] sel))
               ([color=BLUE]setq[/color] ent ([color=BLUE]entget[/color] ([color=BLUE]ssname[/color] sel ([color=BLUE]setq[/color] inc ([color=BLUE]1-[/color] inc)))))
               ([color=BLUE]if[/color] ([color=BLUE]eq[/color] [color=MAROON]"POINT"[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 0 ent)))
                   ([color=BLUE]setq[/color] lst ([color=BLUE]cons[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 10 ent)) lst))
                   ([color=BLUE]setq[/color] txt ([color=BLUE]cons[/color] ([color=BLUE]cons[/color] (_textinsertion ent) ent) txt))
               )
           )
           ([color=BLUE]foreach[/color] ent txt
               ([color=BLUE]setq[/color] ins ([color=BLUE]list[/color] ([color=BLUE]caar[/color] ent) ([color=BLUE]cadar[/color] ent)))
               ([color=BLUE]if[/color] ([color=BLUE]setq[/color] pnt ([color=BLUE]vl-some[/color] '([color=BLUE]lambda[/color] ( pnt ) ([color=BLUE]equal[/color] ins ([color=BLUE]list[/color] ([color=BLUE]car[/color] pnt) ([color=BLUE]cadr[/color] pnt)) 1e-) lst))
                   ([color=BLUE]setq[/color] lst ([color=BLUE]vl-remove[/color] pnt lst))
                   ([color=BLUE]progn[/color]
                       ([color=BLUE]setq[/color] di1 ([color=BLUE]distance[/color] ins ([color=BLUE]list[/color] ([color=BLUE]caar[/color] lst) ([color=BLUE]cadar[/color] lst)))
                             mpt ([color=BLUE]car[/color] lst)
                       )
                       ([color=BLUE]foreach[/color] pnt ([color=BLUE]cdr[/color] lst)
                           ([color=BLUE]if[/color] ([color=BLUE]<[/color] ([color=BLUE]setq[/color] di2 ([color=BLUE]distance[/color] ins ([color=BLUE]list[/color] ([color=BLUE]car[/color] pnt) ([color=BLUE]cadr[/color] pnt)))) di1)
                               ([color=BLUE]setq[/color] di1 di2
                                     mpt pnt
                               )
                           )
                       )
                       ([color=BLUE]setq[/color] pnt ([color=BLUE]list[/color] ([color=BLUE]car[/color] mpt) ([color=BLUE]cadr[/color] mpt) ([color=BLUE]caddar[/color] ent))
                             dxf ([color=BLUE]cdr[/color] ent)
                             dxf ([color=BLUE]subst[/color] ([color=BLUE]cons[/color] 10 pnt) ([color=BLUE]assoc[/color] 10 dxf) dxf)
                             dxf ([color=BLUE]subst[/color] ([color=BLUE]cons[/color] 11 pnt) ([color=BLUE]assoc[/color] 11 dxf) dxf)
                       )
                       ([color=BLUE]entmod[/color] dxf)
                       ([color=BLUE]setq[/color] lst ([color=BLUE]vl-remove[/color] mpt lst))
                   )
               )
           )
       )
   )
   ([color=BLUE]princ[/color])
)
([color=BLUE]vl-load-com[/color]) ([color=BLUE]princ[/color])

It will prompt for a selection of Text and Point entities and move each Text entity to the nearest Point entity (nearest by 2D distance), unless a Point is already found with equal X/Y coords as the Text entity.

 

The program will retain the existing elevation of the Text entity.

 

Example:

 

txt2pt.gif

 

It's probably not the most efficient routine, but I don't have time study a better algorithm.

Edited by Lee Mac

Share this post


Link to post
Share on other sites
archipelag0

Absolutely perfect!

(and much quicker than my line drawing idea)

 

Thank you Lee Mac.

 

 

T

Share this post


Link to post
Share on other sites
Lee Mac

You're welcome :)

Share this post


Link to post
Share on other sites
HaroldA
Why does the LISP have to be recursive?

 

Give this a try:

 

[color=GREEN];; Text 2 Point  -  Lee Mac 2012[/color]
[color=GREEN];; Prompts for a selection of Text and Point entities and moves[/color]
[color=GREEN];; each Text entity to the nearest (2D distance) Point entity in the set.[/color]
[color=GREEN];;[/color]
[color=GREEN];; Retains existing Text elevation.[/color]

([color=BLUE]defun[/color] c:txt2pt ( [color=BLUE]/[/color] _textinsertion di1 di2 dxf ent inc ins lst mpt pnt sel txt )

   ([color=BLUE]defun[/color] _textinsertion ( elist )
       ([color=BLUE]if[/color]
           ([color=BLUE]and[/color]
               ([color=BLUE]zerop[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 72 elist)))
               ([color=BLUE]zerop[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 73 elist)))
           )
           ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 10 elist))
           ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 11 elist))
       )
   )

   ([color=BLUE]if[/color] ([color=BLUE]setq[/color] sel ([color=BLUE]ssget[/color] [color=MAROON]"_:L"[/color] '((0 . [color=MAROON]"POINT,TEXT"[/color]))))
       ([color=BLUE]progn[/color]
           ([color=BLUE]repeat[/color] ([color=BLUE]setq[/color] inc ([color=BLUE]sslength[/color] sel))
               ([color=BLUE]setq[/color] ent ([color=BLUE]entget[/color] ([color=BLUE]ssname[/color] sel ([color=BLUE]setq[/color] inc ([color=BLUE]1-[/color] inc)))))
               ([color=BLUE]if[/color] ([color=BLUE]eq[/color] [color=MAROON]"POINT"[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 0 ent)))
                   ([color=BLUE]setq[/color] lst ([color=BLUE]cons[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 10 ent)) lst))
                   ([color=BLUE]setq[/color] txt ([color=BLUE]cons[/color] ([color=BLUE]cons[/color] (_textinsertion ent) ent) txt))
               )
           )
           ([color=BLUE]foreach[/color] ent txt
               ([color=BLUE]setq[/color] ins ([color=BLUE]list[/color] ([color=BLUE]caar[/color] ent) ([color=BLUE]cadar[/color] ent)))
               ([color=BLUE]if[/color] ([color=BLUE]setq[/color] pnt ([color=BLUE]vl-some[/color] '([color=BLUE]lambda[/color] ( pnt ) ([color=BLUE]equal[/color] ins ([color=BLUE]list[/color] ([color=BLUE]car[/color] pnt) ([color=BLUE]cadr[/color] pnt)) 1e-) lst))
                   ([color=BLUE]setq[/color] lst ([color=BLUE]vl-remove[/color] pnt lst))
                   ([color=BLUE]progn[/color]
                       ([color=BLUE]setq[/color] di1 ([color=BLUE]distance[/color] ins ([color=BLUE]list[/color] ([color=BLUE]caar[/color] lst) ([color=BLUE]cadar[/color] lst)))
                             mpt ([color=BLUE]car[/color] lst)
                       )
                       ([color=BLUE]foreach[/color] pnt ([color=BLUE]cdr[/color] lst)
                           ([color=BLUE]if[/color] ([color=BLUE]<[/color] ([color=BLUE]setq[/color] di2 ([color=BLUE]distance[/color] ins ([color=BLUE]list[/color] ([color=BLUE]car[/color] pnt) ([color=BLUE]cadr[/color] pnt)))) di1)
                               ([color=BLUE]setq[/color] di1 di2
                                     mpt pnt
                               )
                           )
                       )
                       ([color=BLUE]setq[/color] pnt ([color=BLUE]list[/color] ([color=BLUE]car[/color] mpt) ([color=BLUE]cadr[/color] mpt) ([color=BLUE]caddar[/color] ent))
                             dxf ([color=BLUE]cdr[/color] ent)
                             dxf ([color=BLUE]subst[/color] ([color=BLUE]cons[/color] 10 pnt) ([color=BLUE]assoc[/color] 10 dxf) dxf)
                             dxf ([color=BLUE]subst[/color] ([color=BLUE]cons[/color] 11 pnt) ([color=BLUE]assoc[/color] 11 dxf) dxf)
                       )
                       ([color=BLUE]entmod[/color] dxf)
                       ([color=BLUE]setq[/color] lst ([color=BLUE]vl-remove[/color] mpt lst))
                   )
               )
           )
       )
   )
   ([color=BLUE]princ[/color])
)
([color=BLUE]vl-load-com[/color]) ([color=BLUE]princ[/color])

It will prompt for a selection of Text and Point entities and move each Text entity to the nearest Point entity (nearest by 2D distance), unless a Point is already found with equal X/Y coords as the Text entity.

 

The program will retain the existing elevation of the Text entity.

 

Example:

 

[ATTACH]33660[/ATTACH]

 

It's probably not the most efficient routine, but I don't have time study a better algorithm.

 

 

Hi Lee,

 

I am trying to achieve the same but I need to also move the text level to the point's level.

 

Do you have a lsp routine to do this by any chance? :)

 

Thank you.

 

Harold

Share this post


Link to post
Share on other sites
HaroldA

Hi Lee,

 

I am trying to achieve the same thing but I need to also move the text to the point's level.

 

Do you have a lsp routine that do this by any chance? :)

 

Thank you.

 

Harold

Share this post


Link to post
Share on other sites
Lee Mac
I am trying to achieve the same thing but I need to also move the text to the point's level.

 

Hi Harold,

 

Welcome to CADTutor :beer:

 

In the above code, simply change:

(setq pnt (list (car mpt) (cadr mpt) (caddar ent))

to:

(setq pnt mpt

This should achieve the desired result.

 

Lee

Share this post


Link to post
Share on other sites
HaroldA

Thank you Lee. :)

Share this post


Link to post
Share on other sites
Lee Mac

No worries! :)

Share this post


Link to post
Share on other sites
madhuchelliah

i fed searching for this over the internet and finally found this thread. my requirement is instead of moving to a point it should be move to nearest snap point like end or mid likewise. off topic question is there any options to create my own snap points like mid or end. Thank you.

Share this post


Link to post
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now

×