Jump to content

quick xyz coordinates text placed from selected points

pavanetc

By pavanetc
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

pavanetc Rookie

pavanetc

Posted
Posted

looking a  lisp quick xyz coordinates text placed from selected points

 

I need     x=

                y=

                z= 

 

not like  x, y, z 

xyz.png

SLW210 Grand Master

SLW210

Posted
Posted

All points in the drawing, select points, etc.?

 

Can you post a sample .dwg with before and after?

pavanetc Rookie

pavanetc

Posted
  • Author
Posted

this is someone did which is existing code, could you please modify as I need in CAD

 

X

Y

Z

SAMPLE.dwg

pavanetc Rookie

pavanetc

Posted
  • Author
Posted (edited) 
(defun C:CPP (/ PNT1 P1X P1Y STDY DY COORD PTXT)
    (setq PNT1 (getpoint
      "\nPick coordinate point: "))
    (setq P1X (car pnt1)) ;x coord
    (setq P1Y (cadr pnt1)) ;y coord
    (setq P1Z (caddr pnt1)) ;z coord
    (setq STDX (rtos P1X 2 3))
    (setq STDY (rtos P1Y 2 3))
    (setq STDZ (rtos P1Z 2 3))
    (setq COORD (strcat "E"  STDX)
          COORD1(strcat "N" STDY)
          COORD2(strcat "EL" STDZ))
    (setq PTXT (getpoint PNT1
      "\nPick text location: "))
    (command "LEADER" PNT1 PTXT ""
      COORD COORD1 COORD2 "" "" "")
    (princ)) ; end


 

Edited by SLW210
Added Code Tags!!
EnM4st3r Enthusiast

EnM4st3r

Posted
Posted

like this? 
  

(defun c:XYText (/ pt str box)
  (while (setq pt (getpoint "\nPick point for coordinate text: "))
    (setq str (strcat
                "X=" (rtos (car pt) 2 4)
                "\nY=" (rtos (cadr pt) 2 4)
                "\nZ=" (rtos (caddr pt) 2 4)))
    (vla-addmtext (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) (vlax-3d-point pt) 0 str)
  )
  (princ)
)

 

Tsuky Community Regular

Tsuky

Posted
Posted

You can also use fields with selection of points? 

(defun make_field (ent / pt obj)
  (setq pt (trans (cdr (assoc 10 (entget ent))) 1 0))
  (mapcar
    '(lambda (lx)
      (apply
        '(lambda (ins_point value_field att_point txt_height dwg_dir name_layer txt_rot / nw_obj)
          (setq nw_obj
            (vla-addMtext Space
              (vlax-3d-point (trans ins_point 1 0))
              0.0
              (strcat
                "{\\f@Arial Unicode MS|b0|i0|c0|p34;\\Q15;"
                "%<\\AcObjProp.16.2 Object(%<\\_ObjId "
                (itoa (vla-get-ObjectID (vlax-ename->vla-object ent)))
                value_field
                "}"
              )
            )
          )
          (mapcar
            '(lambda (pr val)
              (vlax-put nw_obj pr val)
            )
            (list 'AttachmentPoint 'Height 'DrawingDirection 'InsertionPoint 'Layer 'Rotation)
            (list att_point txt_height dwg_dir ins_point name_layer txt_rot)
          )
        )
        lx
      )
    )
    (list
      (list
        (mapcar '+  (trans pt 1 0) (list (getvar "TEXTSIZE") (+ (* (getvar "TEXTSIZE") 1.25) (getvar "TEXTSIZE")) 0.0))
        ">%).Coordinates \\f \"%lu2%pt1%pr3%ps[X:,]\">%"
        4
        (getvar "TEXTSIZE")
        5
        "Id-XY"
        rtx
      )
      (list
        (mapcar '+ (trans pt 1 0) (list (getvar "TEXTSIZE") 0.0 0.0))
        ">%).Coordinates \\f \"%lu2%pt2%pr3%ps[Y:,]\">%"
        4
        (getvar "TEXTSIZE")
        5
        "Id-XY"
        rtx
      )
      (list
        (mapcar '- (trans pt 1 0) (list (- (getvar "TEXTSIZE")) (+ (* (getvar "TEXTSIZE") 1.25) (getvar "TEXTSIZE")) 0.0))
        ">%).Coordinates \\f \"%lu2%pt4%pr3%ps[Z:,]\">%"
        4
        (getvar "TEXTSIZE")
        5
        "Id-Z"
        rtx
      )
    )
  )
)
(defun c:point-xyz_field ( / htx rtx AcDoc Space ncol ss n)
  (initget 6)
  (setq htx (getdist (getvar "VIEWCTR") (strcat "\nSpecify the height of the field <" (rtos (getvar "TEXTSIZE")) ">: ")))
  (if htx (setvar "TEXTSIZE" htx))
  (if (not (setq rtx (getorient (getvar "VIEWCTR") "\nSpecify the orientation of the field <0.0>: "))) (setq rtx 0.0))
  (vl-load-com)
  (setq
    AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
    Space
    (if (= 1 (getvar "CVPORT"))
      (vla-get-PaperSpace AcDoc)
      (vla-get-ModelSpace AcDoc)
    )
    ncol '(96 174)
  )
  (foreach n '("Id-XY" "Id-Z")
    (cond
      ((null (tblsearch "LAYER" n))
        (vlax-put (vla-add (vla-get-layers AcDoc) n) 'color (car ncol))
      )
    )
    (setq ncol (cdr ncol))
  )
  (while (null (setq ss (ssget '((0 . "POINT"))))))
  (repeat (setq n (sslength ss))
    (make_field (ssname ss (setq n (1- n))))
  )
  (prin1)
)

 

  • Like 1
CivilTechSource Enthusiast

CivilTechSource

Posted
Posted

Just use a point and insert Field in Mtext and format it how you want. When copying both point and text it will keep the new copied items linked. Regen to update the coordinates.

  • Like 1
pavanetc Rookie

pavanetc

Posted
  • Author
Posted
22 hours ago, Tsuky said:

You can also use fields with selection of points?

2.png.0c561555b24939a492cbf1efb13d5ad7.png

 

 

22 hours ago, Tsuky said:

You can also use fields with selection of points? 

(defun make_field (ent / pt obj)
  (setq pt (trans (cdr (assoc 10 (entget ent))) 1 0))
  (mapcar
    '(lambda (lx)
      (apply
        '(lambda (ins_point value_field att_point txt_height dwg_dir name_layer txt_rot / nw_obj)
          (setq nw_obj
            (vla-addMtext Space
              (vlax-3d-point (trans ins_point 1 0))
              0.0
              (strcat
                "{\\f@Arial Unicode MS|b0|i0|c0|p34;\\Q15;"
                "%<\\AcObjProp.16.2 Object(%<\\_ObjId "
                (itoa (vla-get-ObjectID (vlax-ename->vla-object ent)))
                value_field
                "}"
              )
            )
          )
          (mapcar
            '(lambda (pr val)
              (vlax-put nw_obj pr val)
            )
            (list 'AttachmentPoint 'Height 'DrawingDirection 'InsertionPoint 'Layer 'Rotation)
            (list att_point txt_height dwg_dir ins_point name_layer txt_rot)
          )
        )
        lx
      )
    )
    (list
      (list
        (mapcar '+  (trans pt 1 0) (list (getvar "TEXTSIZE") (+ (* (getvar "TEXTSIZE") 1.25) (getvar "TEXTSIZE")) 0.0))
        ">%).Coordinates \\f \"%lu2%pt1%pr3%ps[X:,]\">%"
        4
        (getvar "TEXTSIZE")
        5
        "Id-XY"
        rtx
      )
      (list
        (mapcar '+ (trans pt 1 0) (list (getvar "TEXTSIZE") 0.0 0.0))
        ">%).Coordinates \\f \"%lu2%pt2%pr3%ps[Y:,]\">%"
        4
        (getvar "TEXTSIZE")
        5
        "Id-XY"
        rtx
      )
      (list
        (mapcar '- (trans pt 1 0) (list (- (getvar "TEXTSIZE")) (+ (* (getvar "TEXTSIZE") 1.25) (getvar "TEXTSIZE")) 0.0))
        ">%).Coordinates \\f \"%lu2%pt4%pr3%ps[Z:,]\">%"
        4
        (getvar "TEXTSIZE")
        5
        "Id-Z"
        rtx
      )
    )
  )
)
(defun c:point-xyz_field ( / htx rtx AcDoc Space ncol ss n)
  (initget 6)
  (setq htx (getdist (getvar "VIEWCTR") (strcat "\nSpecify the height of the field <" (rtos (getvar "TEXTSIZE")) ">: ")))
  (if htx (setvar "TEXTSIZE" htx))
  (if (not (setq rtx (getorient (getvar "VIEWCTR") "\nSpecify the orientation of the field <0.0>: "))) (setq rtx 0.0))
  (vl-load-com)
  (setq
    AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
    Space
    (if (= 1 (getvar "CVPORT"))
      (vla-get-PaperSpace AcDoc)
      (vla-get-ModelSpace AcDoc)
    )
    ncol '(96 174)
  )
  (foreach n '("Id-XY" "Id-Z")
    (cond
      ((null (tblsearch "LAYER" n))
        (vlax-put (vla-add (vla-get-layers AcDoc) n) 'color (car ncol))
      )
    )
    (setq ncol (cdr ncol))
  )
  (while (null (setq ss (ssget '((0 . "POINT"))))))
  (repeat (setq n (sslength ss))
    (make_field (ssname ss (setq n (1- n))))
  )
  (prin1)
)

 

 

pavanetc Rookie

pavanetc

Posted
  • Author
Posted

thank you your time and great work. Actually, I need exactly 2 after selection of all points to shown in each point something like 2

2.png

BIGAL Grand Master

BIGAL

Posted
Posted

If the points are not to be moved @EnM4st3r has given you an answer, a little homework for you is a lisp task, change the (while to use a Selection set and a (repeat then all done.

  • Like 1
pavanetc Rookie

pavanetc

Posted
  • Author
Posted

Thank you for your time, i'm waiting for updated 

EnM4st3r Enthusiast

EnM4st3r

Posted
Posted

@pavanetc he meant for you to try it yourself. since its not that difficult. Just look into ssget and selectionset looping

  • Like 1
Steven P Grand Master

Steven P

Posted
Posted

Not quite sure what the question is to be 'exactly like 2' - is it the text to be offset to one side? (only difference I can see really), else EnM4st3r works for me.

 

If you want to offset the text from the selected point, use the mapcar function, have a go at changing the code offered perhaps changing this line

(vla-addmtext (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) (vlax-3d-point pt) 0 str)

use (mapcar '+ '(x y z) pt) instead of pt where x, y and z are the offset distances (numbers) in each direction

Hint with LISPs, 'pt' or very similar is often used as a variable for a point, you can check earlier in the code to confirm, getpoint is the LISP command to return a selected point, pt is set to be the output from getpoint... so a good guess would be this is the point to change

 

Have a go, your first steps to write LISPs is to try, if it all goes wrong ask and we are all more than happy to guide you if you are happy to change things yourself.

  • Like 1
pavanetc Rookie

pavanetc

Posted
  • Author
Posted

sorry engineers. I am posting this again to clarify my exact requirement. Please check the attached DWG file.
The text placement location may be at the top, bottom, or canter, but it must be positioned close to the points and without arrows.
I need the XYZ coordinates for all points displayed in a single SHOT

 

Thanks for your time

SAMPLE 2.dwg

Saxlle Community Regular

Saxlle

Posted
Posted (edited)

@pavanetc

 

I hope this is what you want to accomplish. Try this code:

  

(prompt "\nTo run a LISP type: XYZTEXT")
(princ)

(defun c:XYZTEXT ( / old_osmode ss len x_spacing i pt)

  (setq old_osmode (getvar 'osmode))
  (setvar 'osmode 0)

  (if (not (tblsearch "LAYER" "Coor Text"))
    (command-s "-layer" "m" "Coor Text" "c" 7 "" "")
    (setvar 'clayer "Coor Text")
    )

  (prompt "\nSelect the POINTS:")
  (princ)
  
  (setq ss (ssget (list (cons 0 "POINT")))
	len (sslength ss)
	x_spacing 1
	i 0
	)
  
  (while (< i len)
    
    (setq pt (strcat "X=" (rtos (cadr (assoc 10 (entget (ssname ss i)))) 2 2) "\n" "Y=" (rtos (caddr (assoc 10 (entget (ssname ss i)))) 2 2) "\n" "Z=" (rtos (cadddr (assoc 10 (entget (ssname ss i)))) 2 2)))
    
    (entmake (list (cons 0 "MTEXT") (cons 100 "AcDbEntity") (cons 100 "AcDbMText") (cons 10 (list (+ (cadr (assoc 10 (entget (ssname ss i)))) x_spacing) (caddr (assoc 10 (entget (ssname ss i)))) (cadddr (assoc 10 (entget (ssname ss i))))))
		   (cons 1 pt) (cons 40 0.20) (cons 50 0) (cons 71 4)))
    
    (setq i (1+ i))
    
    )

  (setvar 'osmode old_osmode)
  
  (prompt "\nThe X, Y and Z values were added near the points!")
  (princ)
  
  )

 

You will get something like this from picture below (the yellow XYZ values is what you will get, the white text behind the yellow is your's).

 

image.png.5efcadb6f35630f8c349046afeca6b22.png

 

Best regards.

Edited by Saxlle
SLW210 Grand Master

SLW210

Posted
Posted
1 hour ago, pavanetc said:

sorry engineers. I am posting this again to clarify my exact requirement. Please check the attached DWG file.
The text placement location may be at the top, bottom, or canter, but it must be positioned close to the points and without arrows.
I need the XYZ coordinates for all points displayed in a single SHOT

 

Thanks for your time

SAMPLE 2.dwg 34.05 kB · 2 downloads

 

Why did you report my post? It was meant for an example for you to learn to help yourself.

 

Do you even know what you want? Your first example drawing doesn't show XYZ for the "NEED SOMETHING LIKE AT ALL POINT".

 

Not sure why you want someone to do a bunch of work for you for free and you can't be bothered to provide a well though out request and provide appropriate examples and comments.

  • Agree 1
BIGAL Grand Master

BIGAL

Posted
Posted (edited)

@Saxlle just a suggestion as the "Points' may not be just that a Autocad "Point" often they are a block.

  

(setq ss (ssget (list (cons 0 "POINT")))
	len (sslength ss)
	x_spacing 1
	i 0
	)
  
  (while (< i len)

  

(setq ss (ssget (list (cons 0 "POINT")))
(if (= ss nil)
  (progn
  (alert "You have not selected any Points \nWill now exit please check objects ")
  (exit)
  )
)
(setq len (sslength ss)
	x_spacing 1
	i 0
	)
  
  (repeat len

 

Edited by BIGAL

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...