Need A lisp to label Coordinates all at once

Need A lisp to label Coordinates all at once

Mohammedshebintk
Explorer Explorer
3,167 Views
12 Replies
Message 1 of 13

Need A lisp to label Coordinates all at once

Mohammedshebintk
Explorer
Explorer

  Hello , Is it possible to label Easting & Northing at once for all selected points 

 
0 Likes
Accepted solutions (2)
3,168 Views
12 Replies
Replies (12)
Message 2 of 13

hosneyalaa
Advisor
Advisor
0 Likes
Message 3 of 13

john.uhden
Mentor
Mentor

@Mohammedshebintk 

When you say "selected points" do you mean AutoCAD "POINT" objects, or line endpoints, or polyline vertices, or block insertions, or what?  I presume you mean by window or crossing, yes?

My favorite these days is to use multileaders that are horizontal in a twisted view, but we always use N/E instead of E/N, but that's easy to change or to provide the option along with the precision.

John F. Uhden

0 Likes
Message 4 of 13

Sea-Haven
Mentor
Mentor

If the leader is made as a block can use Field for insertion point values to be displayed. 

 

This was a good video that I stumbled upon.

 

AUTOCAD XYZ COORDINATE LEADER - YouTube

0 Likes
Message 5 of 13

Mohammedshebintk
Explorer
Explorer
That's exactly what I meant, can I select several points or vertices at the same time and get the E&N in a leader, I do have a lisp to do that one by one, thanks
0 Likes
Message 6 of 13

Mohammedshebintk
Explorer
Explorer
Sorry, but that isn't what I'm looking for, thanks for your efforts
0 Likes
Message 7 of 13

Sea-Haven
Mentor
Mentor

Thats ok.

 

You can get points and vertices as 1 selection to be used but you need to do some smart coding looking at what objects were picked, you would have to use different methods for say a pline or line, points, same with a circle. Yes can be done. The other issue with auto select is where do you place the leader always top right ? Or do you prompt move for each one.

 

John appears to have an answer you should post a sample dwg so can see what objects are involved.

0 Likes
Message 8 of 13

CADaSchtroumpf
Advisor
Advisor
Accepted solution

For vertex of LWPOLYLINE you can try this

(vl-load-com)
(defun make_mlead (pt str / tmp ptlst arr nw_obj)
  (initget 9)
  (setq
    tmp (getpoint (trans pt 0 1) "\nLeader position: ")
    ptlst (append pt (polar pt (angle pt (trans tmp 1 0)) (distance pt (trans tmp 1 0))))
    arr (vlax-make-safearray vlax-vbdouble (cons 0 (- (length ptlst) 1)))
  )
  (vlax-safearray-fill arr ptlst)
  (setq nw_obj (vla-addMLeader Space (vlax-make-variant arr) 0))
  (vla-put-contenttype nw_obj acMTextContent)
  (vla-put-textstring nw_obj 
    (strcat
      "{\\fArial|b0|i0|c0|p34;"
      str
      "}"
    )
  )
  (vla-put-layer nw_obj "LABEL-BEARING")
  (vla-put-ArrowheadSize nw_obj (* (getvar "TEXTSIZE") 0.5))
  (vla-put-TextHeight nw_obj (getvar "TEXTSIZE"))
  (if (> (car pt) (car (trans tmp 1 0)))
    (progn
      (vla-SetDogLegDirection nw_obj 0 (vlax-3D-point '(-1.0 0.0 0.0)))
      (vla-put-TextJustify nw_obj acAttachmentPointMiddleRight)
      (vla-setLeaderLineVertices nw_obj 0 (vlax-make-variant arr))
    )
    (vla-put-TextJustify nw_obj acAttachmentPointMiddleLeft)
  )
  (vla-update nw_obj)
)
(defun c:label-bearing ( / l_var js htx AcDoc Space n ename); obj pr pt val_txt)
  (setq l_var (mapcar 'getvar '("AUNITS" "AUPREC" "LUPREC" "LUNITS")))
  (mapcar 'setvar '("AUNITS" "AUPREC" "LUPREC" "LUNITS") '(4 3 2 2))
  (princ "\nSelect polylines.")
  (while (null (setq js (ssget '((0 . "LWPOLYLINE")))))
    (princ "\nSelection is empty or not are LWPOLYLINE!")
  )
  (initget 6)
  (setq htx (getdist (getvar "VIEWCTR") (strcat "\nSpecify text height <" (rtos (getvar "TEXTSIZE")) ">: ")))
  (if htx (setvar "TEXTSIZE" htx))
  (setq
    AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
    Space
    (if (= 1 (getvar "CVPORT"))
      (vla-get-PaperSpace AcDoc)
      (vla-get-ModelSpace AcDoc)
    )
  )
  (vla-startundomark AcDoc)
  (cond
    ((null (tblsearch "LAYER" "LABEL-BEARING"))
      (vlax-put (vla-add (vla-get-layers AcDoc) "LABEL-BEARING") 'color 7)
    )
  )
  (repeat (setq n (sslength js))
    (setq
      ename (ssname js (setq n (1- n)))
      obj (vlax-ename->vla-object ename)
      pr -1
    )
    (repeat (if (eq (vlax-get obj 'Closed) -1) (fix (vlax-curve-getEndParam ename)) (1+ (fix (vlax-curve-getEndParam ename))))
      (setq
        pt (vlax-curve-GetPointAtParam ename (setq pr (1+ pr)))
        val_txt (strcat "E " (rtos (car pt) 2 3) "\\PN " (rtos (cadr pt) 2 3))
      )
      (make_mlead pt val_txt)
    )
  )
  (vla-endundomark AcDoc)
  (mapcar 'setvar '("AUNITS" "AUPREC" "LUPREC" "LUNITS") l_var)
  (prin1)
)
0 Likes
Message 9 of 13

calderg1000
Mentor
Mentor
Accepted solution

Regards @Mohammedshebintk 

Try this code, quick build.
Before its application, you must configure the style of multilrader (text height, arrow, landing Gap).

(defun c:cml (/ s lp i x y tx)
  (setq s  (car (entsel "select Lwpolyline: "))
        ld (getreal "Enter leader length: ")
        lp (mapcar 'cdr
                   (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget s))
           )
  )
  (foreach i lp
    (setq x  (rtos (car i) 2 3)
          y  (rtos (cadr i) 2 3)
          tx (strcat "E " x "\n" "N " y)
    )
    (initcommandversion 1)
    (command "._mleader"
             "o"
             "m"
             2
             "x"
             "_none"
             i
             "_none"
             (polar i (/ pi 4) ld)
             tx
    )
  )
)

 


Carlos Calderon G
EESignature
>Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.

0 Likes
Message 10 of 13

Mohammedshebintk
Explorer
Explorer
Thank you so much for your support
0 Likes
Message 11 of 13

Mohammedshebintk
Explorer
Explorer
Thank you so much for your support
0 Likes
Message 12 of 13

calderg1000
Mentor
Mentor
Glad to help...

Carlos Calderon G
EESignature
>Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.

0 Likes
Message 13 of 13

surveyor1WT8P5
Community Visitor
Community Visitor

You are the lisp expert.

0 Likes