+ Reply to Thread
Results 1 to 10 of 10
  1. #1
    Forum Newbie
    Using
    Revit Architecture 2012
    Join Date
    Mar 2012
    Posts
    2

    Default Moving Text Block to adjacent point

    Registered forum members do not see this ad.

    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

  2. #2
    Quantum Mechanic Lee Mac's Avatar
    Computer Details
    Lee Mac's Computer Details
    Operating System:
    Win 7 Pro / Win 10 Pro / Linux Mint
    Discipline
    Multi-disciplinary
    Lee Mac's Discipline Details
    Discipline
    Multi-disciplinary
    Details
    Custom Programming / Software Customisation
    Using
    AutoCAD 2018
    Join Date
    Aug 2008
    Location
    London, England
    Posts
    19,569

    Default

    Why does the LISP have to be recursive?

    Give this a try:

    Code:
    ;; Text 2 Point  -  Lee Mac 2012
    ;; Prompts for a selection of Text and Point entities and moves
    ;; each Text entity to the nearest (2D distance) Point entity in the set.
    ;;
    ;; Retains existing Text elevation.
    
    (defun c:txt2pt ( / _textinsertion di1 di2 dxf ent inc ins lst mpt pnt sel txt )
    
        (defun _textinsertion ( elist )
            (if
                (and
                    (zerop (cdr (assoc 72 elist)))
                    (zerop (cdr (assoc 73 elist)))
                )
                (cdr (assoc 10 elist))
                (cdr (assoc 11 elist))
            )
        )
    
        (if (setq sel (ssget "_:L" '((0 . "POINT,TEXT"))))
            (progn
                (repeat (setq inc (sslength sel))
                    (setq ent (entget (ssname sel (setq inc (1- inc)))))
                    (if (eq "POINT" (cdr (assoc 0 ent)))
                        (setq lst (cons (cdr (assoc 10 ent)) lst))
                        (setq txt (cons (cons (_textinsertion ent) ent) txt))
                    )
                )
                (foreach ent txt
                    (setq ins (list (caar ent) (cadar ent)))
                    (if (setq pnt (vl-some '(lambda ( pnt ) (equal ins (list (car pnt) (cadr pnt)) 1e-8)) lst))
                        (setq lst (vl-remove pnt lst))
                        (progn
                            (setq di1 (distance ins (list (caar lst) (cadar lst)))
                                  mpt (car lst)
                            )
                            (foreach pnt (cdr lst)
                                (if (< (setq di2 (distance ins (list (car pnt) (cadr pnt)))) di1)
                                    (setq di1 di2
                                          mpt pnt
                                    )
                                )
                            )
                            (setq pnt (list (car mpt) (cadr mpt) (caddar ent))
                                  dxf (cdr ent)
                                  dxf (subst (cons 10 pnt) (assoc 10 dxf) dxf)
                                  dxf (subst (cons 11 pnt) (assoc 11 dxf) dxf)
                            )
                            (entmod dxf)
                            (setq lst (vl-remove mpt lst))
                        )
                    )
                )
            )
        )
        (princ)
    )
    (vl-load-com) (princ)
    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.
    Last edited by Lee Mac; 15th Mar 2012 at 02:46 pm.
    Lee Mac ProgrammingTwitterExchange App StoreDropbox (500MB free)

    With Mathematics there is the possibility of perfect rigour, so why settle for less?

  3. #3
    Forum Newbie
    Using
    Revit Architecture 2012
    Join Date
    Mar 2012
    Posts
    2

    Default

    Absolutely perfect!
    (and much quicker than my line drawing idea)

    Thank you Lee Mac.


    T

  4. #4
    Quantum Mechanic Lee Mac's Avatar
    Computer Details
    Lee Mac's Computer Details
    Operating System:
    Win 7 Pro / Win 10 Pro / Linux Mint
    Discipline
    Multi-disciplinary
    Lee Mac's Discipline Details
    Discipline
    Multi-disciplinary
    Details
    Custom Programming / Software Customisation
    Using
    AutoCAD 2018
    Join Date
    Aug 2008
    Location
    London, England
    Posts
    19,569

    Default

    You're welcome
    Lee Mac ProgrammingTwitterExchange App StoreDropbox (500MB free)

    With Mathematics there is the possibility of perfect rigour, so why settle for less?

  5. #5
    Forum Newbie
    Discipline
    Civil
    Using
    Civil 3D 2015
    Join Date
    Mar 2017
    Posts
    3

    Default

    Quote Originally Posted by Lee Mac View Post
    Why does the LISP have to be recursive?

    Give this a try:

    Code:
    ;; Text 2 Point  -  Lee Mac 2012
    ;; Prompts for a selection of Text and Point entities and moves
    ;; each Text entity to the nearest (2D distance) Point entity in the set.
    ;;
    ;; Retains existing Text elevation.
    
    (defun c:txt2pt ( / _textinsertion di1 di2 dxf ent inc ins lst mpt pnt sel txt )
    
        (defun _textinsertion ( elist )
            (if
                (and
                    (zerop (cdr (assoc 72 elist)))
                    (zerop (cdr (assoc 73 elist)))
                )
                (cdr (assoc 10 elist))
                (cdr (assoc 11 elist))
            )
        )
    
        (if (setq sel (ssget "_:L" '((0 . "POINT,TEXT"))))
            (progn
                (repeat (setq inc (sslength sel))
                    (setq ent (entget (ssname sel (setq inc (1- inc)))))
                    (if (eq "POINT" (cdr (assoc 0 ent)))
                        (setq lst (cons (cdr (assoc 10 ent)) lst))
                        (setq txt (cons (cons (_textinsertion ent) ent) txt))
                    )
                )
                (foreach ent txt
                    (setq ins (list (caar ent) (cadar ent)))
                    (if (setq pnt (vl-some '(lambda ( pnt ) (equal ins (list (car pnt) (cadr pnt)) 1e-8)) lst))
                        (setq lst (vl-remove pnt lst))
                        (progn
                            (setq di1 (distance ins (list (caar lst) (cadar lst)))
                                  mpt (car lst)
                            )
                            (foreach pnt (cdr lst)
                                (if (< (setq di2 (distance ins (list (car pnt) (cadr pnt)))) di1)
                                    (setq di1 di2
                                          mpt pnt
                                    )
                                )
                            )
                            (setq pnt (list (car mpt) (cadr mpt) (caddar ent))
                                  dxf (cdr ent)
                                  dxf (subst (cons 10 pnt) (assoc 10 dxf) dxf)
                                  dxf (subst (cons 11 pnt) (assoc 11 dxf) dxf)
                            )
                            (entmod dxf)
                            (setq lst (vl-remove mpt lst))
                        )
                    )
                )
            )
        )
        (princ)
    )
    (vl-load-com) (princ)
    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:

    Attachment 33660

    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

  6. #6
    Forum Newbie
    Discipline
    Civil
    Using
    Civil 3D 2015
    Join Date
    Mar 2017
    Posts
    3

    Default

    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

  7. #7
    Quantum Mechanic Lee Mac's Avatar
    Computer Details
    Lee Mac's Computer Details
    Operating System:
    Win 7 Pro / Win 10 Pro / Linux Mint
    Discipline
    Multi-disciplinary
    Lee Mac's Discipline Details
    Discipline
    Multi-disciplinary
    Details
    Custom Programming / Software Customisation
    Using
    AutoCAD 2018
    Join Date
    Aug 2008
    Location
    London, England
    Posts
    19,569

    Default

    Quote Originally Posted by HaroldA View Post
    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

    In the above code, simply change:
    Code:
    (setq pnt (list (car mpt) (cadr mpt) (caddar ent))
    to:
    Code:
    (setq pnt mpt
    This should achieve the desired result.

    Lee
    Lee Mac ProgrammingTwitterExchange App StoreDropbox (500MB free)

    With Mathematics there is the possibility of perfect rigour, so why settle for less?

  8. #8
    Forum Newbie
    Discipline
    Civil
    Using
    Civil 3D 2015
    Join Date
    Mar 2017
    Posts
    3

    Default

    Thank you Lee.

  9. #9
    Quantum Mechanic Lee Mac's Avatar
    Computer Details
    Lee Mac's Computer Details
    Operating System:
    Win 7 Pro / Win 10 Pro / Linux Mint
    Discipline
    Multi-disciplinary
    Lee Mac's Discipline Details
    Discipline
    Multi-disciplinary
    Details
    Custom Programming / Software Customisation
    Using
    AutoCAD 2018
    Join Date
    Aug 2008
    Location
    London, England
    Posts
    19,569

    Default

    No worries!
    Lee Mac ProgrammingTwitterExchange App StoreDropbox (500MB free)

    With Mathematics there is the possibility of perfect rigour, so why settle for less?

  10. #10
    Forum Newbie
    Discipline
    Mechanical
    Using
    AutoCAD 2014
    Join Date
    Apr 2017
    Posts
    1

    Default

    Registered forum members do not see this ad.

    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.

Similar Threads

  1. MOVING THE BASE POINT/ INSERTION POINT
    By nwmjdp in forum AutoCAD Beginners' Area
    Replies: 6
    Last Post: 13th May 2012, 06:44 am
  2. change point to line (0 lengths) and block reference to text???
    By tuti in forum AutoCAD 2D Drafting, Object Properties & Interface
    Replies: 25
    Last Post: 14th Dec 2010, 05:49 pm
  3. align text as per adjacent object's alignment
    By priyanka_mehta in forum AutoLISP, Visual LISP & DCL
    Replies: 5
    Last Post: 31st Mar 2009, 08:14 am
  4. In 3D - how to stop UCS from automatically aligning to adjacent object snap point
    By dvjstyles in forum AutoCAD 3D Modelling & Rendering
    Replies: 3
    Last Post: 3rd Nov 2008, 05:59 pm
  5. Base Point of Drawing keeps moving
    By Rhayes in forum AutoCAD General
    Replies: 2
    Last Post: 9th May 2008, 01:17 pm

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts