Label points X,Y,Z

Dear all;

My end goal is to find a Lisp that will Auto-Labels X,Y,Z when u select points as shown Image Label Mtext with leader without overlapping

Thanks in advance for any help/advice

Siva

"Much more better if all the leaders are 45 degree angel"

Alternate suggestion:

1. Create dynamic block, with reporting XYZ coordinates

2. Insert that block ontop of the pointslist

Create an attributed block with attribute values containing fields referencing the block insertion point.

You can then use my Point Manager program to insert such block at all points in a selection.

Oh yeah, I completely forgot about Lee's Point Manager - people who are labeling XYZ coordinates won't imagine living without it.

Create an attributed block with attribute values containing fields referencing the block insertion point.

 

You can then use my Point Manager program to insert such block at all points in a selection.

Many thanks Lee Mac for your suggestion to my thread

& thank Grrr

See you again

Siva

Siva, maybe this can help - it works with attached DWG :

(defun c:test ( / *error* eea-cpp-6-2d getpoints nthmassocsubst ucsf fn pl p1p2 d le xdata assocl xdatan )

 (defun *error* ( msg )
   (if ucsf
     (command "_.UCS" "_P")
   )
   (if msg
     (prompt msg)
   )
   (princ)
 )

 (defun eea-cpp-6-2d (l / D D1 I Q)
                  ;|
 *****************************************************************************************
  
    by ElpanovEvgeniy
    last edit 19.07.2012
  
    the library function 
    find a pair of points with the smallest distance between them
    
 *****************************************************************************************
  
    argument - list points
    returne  - list pair points
   
    For the first time it is published
    http://www.theswamp.org/index.php?topic=40592.0
    
 *****************************************************************************************
  |;
   (setq l  (vl-sort l (function (lambda (a b) (<= (car a) (car b)))))
         d  (distance (list (caar l) (cadar l)) (list (caadr l) (cadadr l)))
         d1 (+ d 1e-
         q  nil
         i  -1
   )
   (if (and (nth 200 l)
            (progn (repeat 20 (setq q (cons (nth (setq i (1+ i)) l) q)))
                   (apply (function <=)
                          (mapcar (function -)
                                  (apply (function mapcar) (cons (function max) q))
                                  (apply (function mapcar) (cons (function min) q))
                                  '(0 0)
                          )
                   )
            )
       )
     (defun f (p l / di)
       (while (and l (equal (cadr p) (cadar l) d1))
         (cond ((equal (setq di (distance (list (car p) (cadr p)) (list (caar l) (cadar l)))) d 1e- (setq q (cons (list p (car l)) q)))
               ((< di d)
                (setq d  di
                      d1 (+ d 1e-
                      q  (list (list p (car l)))
                )
               )
         )
         (setq l (cdr l))
       )
     )
     (defun f (p l / di)
       (while (and l (equal (car p) (caar l) d1))
         (cond ((equal (setq di (distance (list (car p) (cadr p)) (list (caar l) (cadar l)))) d 1e- (setq q (cons (list p (car l)) q)))
               ((< di d)
                (setq d  di
                      d1 (+ d 1e-
                      q  (list (list p (car l)))
                )
               )
         )
         (setq l (cdr l))
       )
     )
   )
   (foreach a l (f a (cdr l)) (setq l (cdr l)))
   (list d q)
 )

 (defun getpoints ( ss / i l a b c )
   (if ss
     (repeat (setq i (sslength ss))
       (setq a (ssname ss (setq i (1- i))))
       (setq b (entget a))
       (setq c (cdr (assoc 10 b)))
       (setq l (cons c l))
     )
   )
   l
 )

 (defun nthmassocsubst ( n key value lst / k slst p j plst m tst pslst )
   (setq k (length (setq slst (member (assoc key lst) lst))))
   (setq p (- (length lst) k))
   (setq j -1)
   (repeat p
     (setq plst (cons (nth (setq j (1+ j)) lst) plst))
   )
   (setq plst (reverse plst))
   (setq j -1)
   (setq m -1)
   (repeat k
     (setq j (1+ j))
     (if (equal (assoc key (member (nth j slst) slst)) (nth j slst) 1e-6)
       (setq m (1+ m))
     )
     (if (and (not tst) (= n m))
       (setq pslst (cons (cons key value) pslst) tst t)
       (setq pslst (cons (nth j slst) pslst))
     )
   )
   (setq pslst (reverse pslst))
   (append plst pslst)
 )

 (if (eq (getvar 'worlducs) 0)
   (progn
     (command "_.UCS" "_W")
     (setq ucsf t)
   )
 )
 (if (not (tblsearch "BLOCK" "label leader"))
   (if (findfile "label leader.dwg")
     (progn
       (command "_.-INSERT" "label leader.dwg" "_non" '(0.0 0.0 0.0))
       (while (< 0 (getvar 'cmdactive)) (command ""))
       (entdel (entlast))
     )
     (progn
       (setq fn (getfiled "Select \"label leader.dwg\" file..." "\\" "dwg" 16))
       (command "_.-INSERT" fn "_non" '(0.0 0.0 0.0))
       (while (< 0 (getvar 'cmdactive)) (command ""))
       (entdel (entlast))
     )
   )
 )
 (if (setq pl (getpoints (ssget '((0 . "POINT")))))
   (progn
     (setq p1p2 (caadr (eea-cpp-6-2d pl)))
     (setq d (distance (list (caar p1p2) (cadar p1p2)) (list (caadr p1p2) (cadadr p1p2))))
     (foreach p pl
       (command "_.-INSERT" "label leader" "_non" p d)
       (while (< 0 (getvar 'cmdactive)) (command ""))
       (command "_.EXPLODE" (entlast))
       (while (< 0 (getvar 'cmdactive)) (command ""))
       (setq le (car (vl-remove-if-not '(lambda ( x ) (eq (cdr (assoc 0 (entget x))) "LEADER")) (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget "_P")))))))
       (setq xdata (assoc -3 (entget le '("*"))))
       (setq assocl (cdr (cadr xdata)))
       (setq assocl (nthmassocsubst 0 1040 (* (cdr (assoc 1040 assocl)) d) assocl))
       (setq xdatan (list -3 (cons "ACAD" assocl)))
       (entupd (cdr (assoc -1 (entmod (subst xdatan xdata (entget le '("*"))))))) 
     )
   )
 )
 (command "_.-PURGE" "_B" "label leader" "_N")
 (while (< 0 (getvar 'cmdactive)) (command ""))
 (*error* nil)
)

M.R.

label leader.dwg

Siva, maybe this can help - it works with attached DWG :

 

(defun c:test ( / *error* eea-cpp-6-2d getpoints nthmassocsubst ucsf fn pl p1p2 d le xdata assocl xdatan )

 (defun *error* ( msg )
   (if ucsf
     (command "_.UCS" "_P")
   )
   (if msg
     (prompt msg)
   )
   (princ)
 )

 (defun eea-cpp-6-2d (l / D D1 I Q)
                  ;|
 *****************************************************************************************
  
    by ElpanovEvgeniy
    last edit 19.07.2012
  
    the library function 
    find a pair of points with the smallest distance between them
    
 *****************************************************************************************
  
    argument - list points
    returne  - list pair points
   
    For the first time it is published
    http://www.theswamp.org/index.php?topic=40592.0
    
 *****************************************************************************************
  |;
   (setq l  (vl-sort l (function (lambda (a b) (<= (car a) (car b)))))
         d  (distance (list (caar l) (cadar l)) (list (caadr l) (cadadr l)))
         d1 (+ d 1e-
         q  nil
         i  -1
   )
   (if (and (nth 200 l)
            (progn (repeat 20 (setq q (cons (nth (setq i (1+ i)) l) q)))
                   (apply (function <=)
                          (mapcar (function -)
                                  (apply (function mapcar) (cons (function max) q))
                                  (apply (function mapcar) (cons (function min) q))
                                  '(0 0)
                          )
                   )
            )
       )
     (defun f (p l / di)
       (while (and l (equal (cadr p) (cadar l) d1))
         (cond ((equal (setq di (distance (list (car p) (cadr p)) (list (caar l) (cadar l)))) d 1e- (setq q (cons (list p (car l)) q)))
               ((< di d)
                (setq d  di
                      d1 (+ d 1e-
                      q  (list (list p (car l)))
                )
               )
         )
         (setq l (cdr l))
       )
     )
     (defun f (p l / di)
       (while (and l (equal (car p) (caar l) d1))
         (cond ((equal (setq di (distance (list (car p) (cadr p)) (list (caar l) (cadar l)))) d 1e- (setq q (cons (list p (car l)) q)))
               ((< di d)
                (setq d  di
                      d1 (+ d 1e-
                      q  (list (list p (car l)))
                )
               )
         )
         (setq l (cdr l))
       )
     )
   )
   (foreach a l (f a (cdr l)) (setq l (cdr l)))
   (list d q)
 )

 (defun getpoints ( ss / i l a b c )
   (if ss
     (repeat (setq i (sslength ss))
       (setq a (ssname ss (setq i (1- i))))
       (setq b (entget a))
       (setq c (cdr (assoc 10 b)))
       (setq l (cons c l))
     )
   )
   l
 )

 (defun nthmassocsubst ( n key value lst / k slst p j plst m tst pslst )
   (setq k (length (setq slst (member (assoc key lst) lst))))
   (setq p (- (length lst) k))
   (setq j -1)
   (repeat p
     (setq plst (cons (nth (setq j (1+ j)) lst) plst))
   )
   (setq plst (reverse plst))
   (setq j -1)
   (setq m -1)
   (repeat k
     (setq j (1+ j))
     (if (equal (assoc key (member (nth j slst) slst)) (nth j slst) 1e-6)
       (setq m (1+ m))
     )
     (if (and (not tst) (= n m))
       (setq pslst (cons (cons key value) pslst) tst t)
       (setq pslst (cons (nth j slst) pslst))
     )
   )
   (setq pslst (reverse pslst))
   (append plst pslst)
 )

 (if (eq (getvar 'worlducs) 0)
   (progn
     (command "_.UCS" "_W")
     (setq ucsf t)
   )
 )
 (if (not (tblsearch "BLOCK" "label leader"))
   (if (findfile "label leader.dwg")
     (progn
       (command "_.-INSERT" "label leader.dwg" "_non" '(0.0 0.0 0.0))
       (while (< 0 (getvar 'cmdactive)) (command ""))
       (entdel (entlast))
     )
     (progn
       (setq fn (getfiled "Select \"label leader.dwg\" file..." "\\" "dwg" 16))
       (command "_.-INSERT" fn "_non" '(0.0 0.0 0.0))
       (while (< 0 (getvar 'cmdactive)) (command ""))
       (entdel (entlast))
     )
   )
 )
 (if (setq pl (getpoints (ssget '((0 . "POINT")))))
   (progn
     (setq p1p2 (caadr (eea-cpp-6-2d pl)))
     (setq d (distance (list (caar p1p2) (cadar p1p2)) (list (caadr p1p2) (cadadr p1p2))))
     (foreach p pl
       (command "_.-INSERT" "label leader" "_non" p d)
       (while (< 0 (getvar 'cmdactive)) (command ""))
       (command "_.EXPLODE" (entlast))
       (while (< 0 (getvar 'cmdactive)) (command ""))
       (setq le (car (vl-remove-if-not '(lambda ( x ) (eq (cdr (assoc 0 (entget x))) "LEADER")) (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget "_P")))))))
       (setq xdata (assoc -3 (entget le '("*"))))
       (setq assocl (cdr (cadr xdata)))
       (setq assocl (nthmassocsubst 0 1040 (* (cdr (assoc 1040 assocl)) d) assocl))
       (setq xdatan (list -3 (cons "ACAD" assocl)))
       (entupd (cdr (assoc -1 (entmod (subst xdatan xdata (entget le '("*"))))))) 
     )
   )
 )
 (command "_.-PURGE" "_B" "label leader" "_N")
 (while (< 0 (getvar 'cmdactive)) (command ""))
 (*error* nil)
)

M.R.

Dear Marko_Ribar

I was much more busy with my work couldn't get time

Thanks, worked perfectly.

I really appreciate it.

Siva

Siva, if you plan to do the same thing again, I'd suggest this code, although slower, but more accurate in way shortest 2d distance between pairs are calculated...

(defun c:labelpts ( / *error* mindist2dp1p2 getpoints nthmassocsubst ucsf pdm fn pl p1p2 d le xdata assocl xdatan )

 (defun *error* ( msg )
   (if ucsf
     (command "_.UCS" "_P")
   )
   (command "_.ZOOM" "_P")
   (command "_.ZOOM" "_P")
   (if pdm
     (setvar 'pdmode pdm)
   )
   (if msg
     (prompt msg)
   )
   (princ)
 )

 (defun mindist2dp1p2 ( pl / focus f a b d dmin bl r )
   (defun focus ( p dmin / ss i pt l )
     (if (setq ss (ssget "_CP" (list (mapcar '- p (list dmin dmin)) (mapcar '+ p (list dmin (- dmin))) (mapcar '+ p (list dmin dmin)) (mapcar '+ p (list (- dmin) dmin))) '((0 . "POINT"))))
       (repeat (setq i (sslength ss))
         (setq pt (cdr (assoc 10 (entget (ssname ss (setq i (1- i)))))))
         (if (not (equal p pt 1e-12))
           (setq l (cons pt l))
         )
       )
     )
     (if bl
       (foreach p l
         (if (vl-position p bl)
           (setq l (vl-remove p l))
         )
       )
     )
     l
   )
   (defun f ( p l dmin / a b d )
     (setq l (vl-remove-if (function (lambda ( x ) (< dmin (distance (list (car x) (cadr x)) (list (car p) (cadr p)))))) l))
     (if l
       (while (setq a (car l))
         (setq d (distance (list (car a) (cadr a)) (list (car p) (cadr p))))
         (if (< d dmin)
           (setq dmin d b a)
         )
         (setq l (cdr l))
       )
     )
     b
   )
   (setq dmin 1e+308)
   (foreach a pl
     (setq b (f a (if (eq dmin 1e+308) (vl-remove a pl) (focus a dmin)) dmin))
     (if b
       (progn
         (setq d (distance (list (car a) (cadr a)) (list (car b) (cadr b))))
         (if (< d dmin)
           (setq dmin d r (list a b))
         )
         (setq bl (cons b bl))
       )
     )
   )
   r
 )

 (defun getpoints ( ss / i l p )
   (if ss
     (repeat (setq i (sslength ss))
       (setq p (cdr (assoc 10 (entget (ssname ss (setq i (1- i))))))
            l (cons p l)
       )
     )
   )
   l
 )

 (defun nthmassocsubst ( n key value lst / k slst p j plst m tst pslst )
   (setq k (length (setq slst (member (assoc key lst) lst))))
   (setq p (- (length lst) k))
   (setq j -1)
   (repeat p
     (setq plst (cons (nth (setq j (1+ j)) lst) plst))
   )
   (setq plst (reverse plst))
   (setq j -1)
   (setq m -1)
   (repeat k
     (setq j (1+ j))
     (if (equal (assoc key (member (nth j slst) slst)) (nth j slst) 1e-6)
       (setq m (1+ m))
     )
     (if (and (not tst) (= n m))
       (setq pslst (cons (cons key value) pslst) tst t)
       (setq pslst (cons (nth j slst) pslst))
     )
   )
   (setq pslst (reverse pslst))
   (append plst pslst)
 )

 (if (eq (getvar 'worlducs) 0)
   (progn
     (command "_.UCS" "_W")
     (command "_.PLAN" "")
     (command "_.ZOOM" "0.5XP")
     (setq ucsf t)
   )
   (progn
     (command "_.ZOOM" "_E")
     (command "_.ZOOM" "0.5XP")
   )
 )
 (if (not (tblsearch "BLOCK" "label leader"))
   (if (findfile "label leader.dwg")
     (progn
       (command "_.-INSERT" "label leader.dwg" "_non" '(0.0 0.0 0.0))
       (while (< 0 (getvar 'cmdactive)) (command ""))
       (entdel (entlast))
     )
     (progn
       (setq fn (getfiled "Select \"label leader.dwg\" file..." "\\" "dwg" 16))
       (command "_.-INSERT" fn "_non" '(0.0 0.0 0.0))
       (while (< 0 (getvar 'cmdactive)) (command ""))
       (entdel (entlast))
     )
   )
 )
 (alert "Do not change visual screen with zooming-panning...")
 (setq pdm (getvar 'pdmode))
 (setvar 'pdmode 0)
 (command "_.REGEN")
 (prompt "\nSelect points...")
 (if (setq pl (getpoints (ssget '((0 . "POINT")))))
   (progn
     (setq p1p2 (mindist2dp1p2 pl))
     (setq d (distance (list (caar p1p2) (cadar p1p2)) (list (caadr p1p2) (cadadr p1p2))))
     (foreach p pl
       (command "_.-INSERT" "label leader" "_non" p d)
       (while (< 0 (getvar 'cmdactive)) (command ""))
       (command "_.EXPLODE" (entlast))
       (while (< 0 (getvar 'cmdactive)) (command ""))
       (setq le (car (vl-remove-if-not '(lambda ( x ) (eq (cdr (assoc 0 (entget x))) "LEADER")) (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget "_P")))))))
       (setq xdata (assoc -3 (entget le '("*"))))
       (setq assocl (cdr (cadr xdata)))
       (setq assocl (nthmassocsubst 0 1040 (* (cdr (assoc 1040 assocl)) d) assocl))
       (setq xdatan (list -3 (cons "ACAD" assocl)))
       (entupd (cdr (assoc -1 (entmod (subst xdatan xdata (entget le '("*"))))))) 
     )
   )
 )
 (command "_.-PURGE" "_B" "label leader" "_N")
 (while (< 0 (getvar 'cmdactive)) (command ""))
 (*error* nil)
)

HTH, M.R.

Hi marko_ribar;

In some situation space problems & overlapping issues, to avoid that I prefer this way

Example of the Problem:

thanks

Siva

You have to redefine block DWG I posted... Just change position of attributes with fields - I think you can do this through command BEDIT.

Just a comment all our civil projects are labelled with a pt number rather than a xyz, the reason for this is very simple that you upload it into a survey data collector so you can set it out. We normally create a table with the XYZ details and description. This is built into CIV3d but we still have the old routines that create the point adjusting pt number export to a csv and reimport into a table.

You have to redefine block DWG I posted... Just change position of attributes with fields - I think you can do this through command BEDIT.

I did the same but error message appears, again I look into your program I find that I should not change the cad file name, once again I will try........

thanks

Siva

I did the same but error message appears, again I look into your program I find that I should not change the cad file name, once again I will try........

 

thanks

Siva

Sorry, it's been a while since I created that DWG... It was fields inside MTEXT - not attributes... Try with this DWG...

M.R.

label leader.dwg

no worries, it's working fine

thanks

Siva