entity coordinates

Hi dear friends

I want write coordinates and number of many points in screen in separate layers , but my code don't work correctly , it returns y value and counter number correctly and for x and z values return 0 .

please check my code and show me suitable tips .

thanks very much

:: my code is as below :

(defun C:WR (/ mysset counter)

(setq mysset (ssget))

(setq counter 0)

(setq sf 0.5)

(while (

(setq pt (cdr (assoc 10 (entget (ssname mysset counter)))))

(setq x (strcat "E" (rtos (car pt) 2 3)))

(setq y (strcat "N" (rtos (cadr pt) 2 3)))

(setq z (strcat "Z" (rtos (caddr pt) 2 3)))

(command "text" p1 (* sf 2.5) "0" x)

(command "text" "" y)

(command "text" "" z)

(command "text" "" (itoa (1+ counter)))

(setq counter (+ counter 1))

)

(princ))

I'm not quite sure why you want to make a selection set, the (cdr (assoc 10... will just return the position of the cursor when you pick an entity; you might as well use getpoint. Here's a quick edit of your code (we'll call it artistic license), no error checking.

(defun C:test ();(/ mysset counter)
(setq oldsnap (getvar "osmode"));stores osnap setting
 (setvar "osmode" 0);set osnap to none; edit as needed/wanted
(setq counter 0)
(setq sf 0.5);is this necessary?
(while (setq pt (getpoint "Select point: "))
(setq x (strcat "E" (rtos (car pt) 2 3)))
(setq y (strcat "N" (rtos (cadr pt) 2 3)))
(setq z (strcat "Z" (rtos (caddr pt) 2 3)))
(command "text" pt (* sf 2.5) "0" x); you could just hard code the height to be 0.125, text style height needs to be 0
(command "text" "" y)
(command "text" "" z)
(command "text" "" (itoa (1+ counter)))
(setq counter (+ counter 1))
);while
 (setvar "osmode" oldsnap);sets osnap as it was
(princ)
);defun

I'm not quite sure why you want to make a selection set, the (cdr (assoc 10... will just return the position of the cursor when you pick an entity; you might as well use getpoint. Here's a quick edit of your code (we'll call it artistic license), no error checking.

(defun C:test ();(/ mysset counter)
(setq oldsnap (getvar "osmode"));stores osnap setting
 (setvar "osmode" 0);set osnap to none; edit as needed/wanted
(setq counter 0)
(setq sf 0.5);is this necessary?
(while (setq pt (getpoint "Select point: "))
(setq x (strcat "E" (rtos (car pt) 2 3)))
(setq y (strcat "N" (rtos (cadr pt) 2 3)))
(setq z (strcat "Z" (rtos (caddr pt) 2 3)))
(command "text" pt (* sf 2.5) "0" x); you could just hard code the height to be 0.125, text style height needs to be 0
(command "text" "" y)
(command "text" "" z)
(command "text" "" (itoa (1+ counter)))
(setq counter (+ counter 1))
);while
 (setvar "osmode" oldsnap);sets osnap as it was
(princ)
);defun

Thanks you very much , it's work correctly in 3d space.

Another:

(defun c:pt (/ txt i lspc tsze j p)
 (setq i 0 lspc 1.5 tsze 1.25)
 
 (defun txt (pt val)
   (entmake (list (cons 0 "TEXT") (cons 10 pt) (cons 1 val) (cons 40 tsze))))
 
 (while (setq j -1 p (getpoint (strcat "\nSpecify Point [" (itoa (setq i (1+ i))) "] : ")))
   (foreach str (append
                  (mapcar
                    (function (lambda (y x) (strcat y (rtos x 2 3)))) '("E" "N" "Z") p) (list (itoa i)))
     (txt (polar (trans p 1 0) (/ (* 3 pi) 2.) (* (setq j (1+ j)) lspc tsze)) str)))

 (princ))

Another:

 

(defun c:pt (/ txt i lspc tsze j p)
 (setq i 0 lspc 1.5 tsze 1.25)
 
 (defun txt (pt val)
   (entmake (list (cons 0 "TEXT") (cons 10 pt) (cons 1 val) (cons 40 tsze))))
 
 (while (setq j -1 p (getpoint (strcat "\nSpecify Point [" (itoa (setq i (1+ i))) "] : ")))
   (foreach str (append
                  (mapcar
                    (function (lambda (y x) (strcat y (rtos x 2 3)))) '("E" "N" "Z") p) (list (itoa i)))
     (txt (polar (trans p 1 0) (/ (* 3 pi) 2.) (* (setq j (1+ j)) lspc tsze)) str)))

 (princ))

thank you very much Lee , your code works better than my code , please tell me if I want put them into separate layer and color ,how I can do it ?

Thanks CadMan - its better (and much faster) to avoid command calls.

Try this:

(defun c:pt (/ txt mk_lay lLst i lspc tsze j p)
 (vl-load-com)
 (setq i 0 lspc 1.5 tsze 1.25
       doc (vla-get-ActiveDocument (vlax-get-acad-object)))

 (setq lLst '("EastLayer" "NorthLayer" "ZLayer" "PointLayer"))

 (defun txt (pt val lay)
   (entmake (list (cons 0 "TEXT") (cons 8 lay) (cons 10 pt) (cons 1 val) (cons 40 tsze))))

 (defun mk_lay (lay) (or (tblsearch "LAYER" lay) (vla-add (vla-get-Layers doc) lay)))
 (mapcar 'mk_lay lLst)  
 
 (while (setq j -1 p (getpoint (strcat "\nSpecify Point [" (itoa (setq i (1+ i))) "] : ")))
   (foreach str (append
                  (mapcar
                    (function (lambda (y x) (strcat y (rtos x 2 3)))) '("E" "N" "Z") p) (list (itoa i)))
     (txt (polar (trans p 1 0) (/ (* 3 pi) 2.) (* (setq j (1+ j)) lspc tsze)) str (nth j lLst))))

 (princ))

Alter lLst as necessary

Thanks CadMan - its better (and much faster) to avoid command calls.

 

Try this:

 

(defun c:pt (/ txt mk_lay lLst i lspc tsze j p)
 (vl-load-com)
 (setq i 0 lspc 1.5 tsze 1.25
       doc (vla-get-ActiveDocument (vlax-get-acad-object)))

 (setq lLst '("EastLayer" "NorthLayer" "ZLayer" "PointLayer"))

 (defun txt (pt val lay)
   (entmake (list (cons 0 "TEXT") (cons 8 lay) (cons 10 pt) (cons 1 val) (cons 40 tsze))))

 (defun mk_lay (lay) (or (tblsearch "LAYER" lay) (vla-add (vla-get-Layers doc) lay)))
 (mapcar 'mk_lay lLst)  
 
 (while (setq j -1 p (getpoint (strcat "\nSpecify Point [" (itoa (setq i (1+ i))) "] : ")))
   (foreach str (append
                  (mapcar
                    (function (lambda (y x) (strcat y (rtos x 2 3)))) '("E" "N" "Z") p) (list (itoa i)))
     (txt (polar (trans p 1 0) (/ (* 3 pi) 2.) (* (setq j (1+ j)) lspc tsze)) str (nth j lLst))))

 (princ))

Alter lLst as necessary

LEE You being an extraordinary man and I wish you happiness .

LEE You being an extraordinary man and I wish you happiness .

Thanks for your kind words CadMan - have a good evening

How about a little color.

(defun c:pt (/ txt mk_lay lLst cLst i lspc tsze j p)
 (vl-load-com)
 (setq i 0 lspc 1.5 tsze 1.25
       doc (vla-get-ActiveDocument (vlax-get-acad-object)))

 (setq lLst '("EastLayer" "NorthLayer" "ZLayer" "PointLayer")
       cLst '(1 2 3 4)
       )

 (defun txt (pt val lay)
   (entmake (list (cons 0 "TEXT") (cons 8 lay) (cons 10 pt) (cons 1 val) (cons 40 tsze))))

 (defun mk_lay (lay col) (or (tblsearch "LAYER" lay) (vla-put-color (vla-add (vla-get-Layers doc) lay) col)))
 ;(mapcar 'mk_lay lLst)
 (mapcar '(lambda (l c) (mk_lay l c)) lLst cLst)
 
 (while (setq j -1 p (getpoint (strcat "\nSpecify Point [" (itoa (setq i (1+ i))) "] : ")))
   (foreach str (append
                  (mapcar
                    (function (lambda (y x) (strcat y (rtos x 2 3)))) '("E" "N" "Z") p) (list (itoa i)))
     (txt (polar (trans p 1 0) (/ (* 3 pi) 2.) (* (setq j (1+ j)) lspc tsze)) str (nth j lLst))))

 (princ))

Nice one dude

Nice one dude

Just wanted to play along.

How about a little color.

 

(defun c:pt (/ txt mk_lay lLst cLst i lspc tsze j p)
 (vl-load-com)
 (setq i 0 lspc 1.5 tsze 1.25
       doc (vla-get-ActiveDocument (vlax-get-acad-object)))

 (setq lLst '("EastLayer" "NorthLayer" "ZLayer" "PointLayer")
       cLst '(1 2 3 4)
       )

 (defun txt (pt val lay)
   (entmake (list (cons 0 "TEXT") (cons 8 lay) (cons 10 pt) (cons 1 val) (cons 40 tsze))))

 (defun mk_lay (lay col) (or (tblsearch "LAYER" lay) (vla-put-color (vla-add (vla-get-Layers doc) lay) col)))
 ;(mapcar 'mk_lay lLst)
 (mapcar '(lambda (l c) (mk_lay l c)) lLst cLst)

 (while (setq j -1 p (getpoint (strcat "\nSpecify Point [" (itoa (setq i (1+ i))) "] : ")))
   (foreach str (append
                  (mapcar
                    (function (lambda (y x) (strcat y (rtos x 2 3)))) '("E" "N" "Z") p) (list (itoa i)))
     (txt (polar (trans p 1 0) (/ (* 3 pi) 2.) (* (setq j (1+ j)) lspc tsze)) str (nth j lLst))))

 (princ))

Alan, can you revise so the sequence is N, E, Z, pt#

would be nice if acad returned y,x,z instead of x,y,z

Civil's and surveyors always think pt#,N,E,Elev , at least most do.

thx dude

(defun c:pt (/ txt mk_lay lLst cLst i lspc tsze j p)
 (vl-load-com)
 (setq i 0 lspc 1.5 tsze 1.25
       doc (vla-get-ActiveDocument (vlax-get-acad-object)))

 (setq lLst '("EastLayer" "NorthLayer" "ZLayer" "PointLayer")
       cLst '(1 2 3 4)
       )

 (defun txt (pt val lay)
   (entmake (list (cons 0 "TEXT") (cons 8 lay) (cons 10 pt) (cons 1 val) (cons 40 tsze))))

 (defun mk_lay (lay col) (or (tblsearch "LAYER" lay) (vla-put-color (vla-add (vla-get-Layers doc) lay) col)))
 (mapcar '(lambda (l c) (mk_lay l c)) lLst cLst)
 
 (while (setq j -1 p (getpoint (strcat "\nSpecify Point [" (itoa (setq i (1+ i))) "] : ")))
   (foreach str (append
                  (mapcar
                    (function (lambda (y x) (strcat y (rtos x 2 3)))) '("N" "E" "Z")
                      (list (cadr p) (car p) (caddr p))) (list (itoa i)))
     (txt (polar (trans p 1 0) (/ (* 3 pi) 2.) (* (setq j (1+ j)) lspc tsze)) str (nth j lLst))))

 (princ))

Alan, can you revise so the sequence is N, E, Z, pt#

would be nice if acad returned y,x,z instead of x,y,z

Civil's and surveyors always think pt#,N,E,Elev , at least most do.

thx dude

Ask and you shall receive.

Ask and you shall receive.

Its sad that I spend my Sunday coding....

Its sad that I spend my Sunday coding....

its all in the wrist!

thanks dude, perfect

Civil's and surveyors always think pt#,N,E,Elev , at least most do.

Not so. If you can use it like that, then very good, but PLEASE do not generalize. There are other countries outside the USA which use different conventions.

its all in the wrist!

thanks dude, perfect

You're welcome

Not so. If you can use it like that, then very good, but PLEASE do not generalize. There are other countries outside the USA which use different conventions.

My bad:oops:

My bad:oops:

Hi Steve

Guess aussies are use the sequence as N, E, -Z, pt#

Did you hear something about?

LOL

~'J'~