Jump to content

quick xyz coordinates text placed from selected points

pavanetc

By pavanetc
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

pavanetc Newbie

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 Newbie

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 Newbie

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 Newbie

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 Newbie

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

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...