Easting and Northing Lisp Routine

November 16, 2007

Hello All

I'm a newbie to this forum so forgive me if this has been asked previously (i did a search and did not have any luck finding what i was after).

Does anybody now of a lisp routine etc. that can generate X and Y co-ordinates at the same time and place one above the other with the option of a leader or circle indicating the origin point (see attached gif).

I have to produce setting out plans all the time at work for setting out of buildings, car parks, roads.

I know about the AutoCAD ordinate command but this only does the X or the Y not both together.

I would also like the option of producing the co-ordinates in meters or mm. I tend to work in mm but produce the co-ords in meters as its less numbers to display.

Your help / advice would be greatly appreciated.

Regards

CAD Monkey Champion 2007

November 16, 2007

I have a couple, both mm and m. But no leader. Also I have one that also provides the Z value as an RL. If you want them, just yell.

November 16, 2007

Hi

Sounds like they might be of use, If i could have a copy that would be great, i might be able to customise it a little.

Cheers

November 16, 2007

Okay, here you go. The original ones are metres, and need the associated config files. The other two (suffix mm) were rewritten for Tiger only very recently, for mm. I consider them much, much better than the originals I wrote.

coords.zip

November 16, 2007

Thanks for your help

CAD Monkey

November 19, 2007

Have you considered updating a fancy block with the info, we do that just copy block then pick point. X,Y,Z atrributes are updated.

November 29, 2007

Are you looking to be able to pick a point and have a leader with the northing and easting associted to it? If so I have a routine that does this, let me know if you need it..

November 30, 2007

This sounds like a job for a block with fields using the insertion point of the block as their attributes, or something similar.

November 30, 2007

Give this a try

 (defun layer_set (lyr col ltp)
 (setvar "cmdecho" 0)  
 (if (tblsearch "layer" lyr)
 (command "._-layer" "t" lyr "u" lyr "on" lyr  "s" lyr "")
 (command "._-layer" "m" lyr "c" col lyr "lt" ltp lyr ""))
 )

(or (vl-load-com))

(defun C:lne (/	*debug*	*error*	acsp	adoc	ang	anno	atp
	col	lead	lyr	mtextobj	mtpt	nodpt
	ort	osm	pt	ptlist	ss	tmparray
	tmpvar	txh	xval	yval
       )

 (defun *Error* (msg)
 (cond	((not msg))
((member msg '("Function cancelled" "quit / exit abort")))
((princ (strcat "\nError: " msg))
 (cond (*Debug* (vl-bt)))
)
 )
 (setvar "cmdecho" 1)
 (setvar "delobj" 1)
 (if osm (setvar "osmode" osm))
 (if ort (setvar "orthomode" ort))
 (if lyr (setvar "clayer" lyr))
 (if col (setvar "cecolor" col))
   
 (vla-endundomark
(vla-get-activedocument (vlax-get-acad-object))
     )
)
 

 (or adoc
     (setq adoc (vla-get-activedocument
	   (vlax-get-acad-object)
	 )
     )
 )
 (or acsp
     (setq acsp (if (= (getvar "TILEMODE") 0)
	   (vla-get-paperspace
	     adoc
	   )
	   (vla-get-modelspace
	     adoc
	   )
	 )
     )
 )
 (vla-endundomark adoc)
 (vla-startundomark adoc)
 
 (setq osm (getvar "osmode"))
 (setq lyr (getvar "clayer"))    
 (setq ort (getvar "orthomode"))    
 (setq col (getvar "cecolor"))
 (setvar "cmdecho" 0)
 (setvar "osmode" 0)

 (initget 6)
 (setq txh (getreal (strcat "\n  Enter New Value For Text Height <" (rtos (getvar "dimtxt")) "> :")))
 (if (not txh)(setq txh (getvar "dimtxt")))    
 (setvar "textsize" txh)
 (if (not (tblsearch "block" "ArrowDonut"))
     (progn
      (setq ss (ssadd))
      (setvar "delobj" 1)
      (layer_set "ANNO-LEADER" "10" "Continuous")  
      (setvar "cecolor" "256")
      (command "._circle" "0,0,0" 1.0);<-change outer diameter of donut here
      (ssadd (entlast) ss)
      (command "._circle" "0,0,0" 0.75);<-change inner diameter of donut here
      (ssadd (entlast) ss)
      (command "._-block" "ArrowDonut" "0,0,0" ss "")
 )
   )

      
 (while
 (setq pt (getpoint "\nSpecify the starting point of the leader (press Enter to exit): \n"))

 (setq ptlist (cons pt ptlist))
 (while (setq
   pt (getpoint "\nSpecify next point press Enter to finish: " pt)
 )
   (setq ptlist (cons pt ptlist)
   )
 )
 
 (setq ptlist (reverse ptlist))
 (setq ang (angle (car ptlist )(cadr ptlist)))

 (if (< (/ pi 2) ang (* pi 1.5))
   (setq atp acAttachmentPointMiddleRight)
   (setq atp acAttachmentPointMiddleLeft))
 (setq nodpt (car ptlist)
xval (rtos (car nodpt) 2 3); easting
yval (rtos (cadr nodpt) 2 3);northing
anno (strcat "N " yval "\\PE " xval)
mtpt (vlax-3d-point (cadr ptlist)))
 (layer_set "ANNO-TEXT" "2" "Continuous")
 (setvar "cecolor" "256")
 (setq	mtextobj (vla-addmtext
	   acsp
	   mtpt
	   0.0
	   anno
	 )
 )
(vla-put-height mtextobj txh)
(vla-put-attachmentPoint mtextobj atp)
(vla-put-insertionPoint mtextobj mtpt)
 (setq ptlist (apply 'append ptlist))
 (setq	tmparray
 (vlax-make-safearray
   vlax-vbdouble
   (cons 0 (- (length ptlist) 1))
 )
 )
 (vlax-safearray-fill tmparray ptlist)
 (setq tmpvar (vlax-make-variant tmparray))
 (layer_set "ANNO-LEADER" "10" "Continuous")  
 (setvar "cecolor" "256") 
 (setq lead (vla-addleader acsp tmpvar mtextobj acLineWithArrow))
 (vla-put-verticaltextposition lead acvertcentered)

 (vla-put-arrowheadblock lead "arrowdonut")
 (vla-put-arrowheadsize lead (* 0.5 txh)) 
 (vla-update lead)
 (setq ptlist nil);optional
   )

 (vla-regen adoc acactiveviewport);optional
 (*Error* nil)
 (princ)
)
(princ "\n\t\t\t   |-----------------------------|\n")
(princ "\n\t\t\t  <|  Start with LNE to execute  |>\n")
(princ "\n\t\t\t   |-----------------------------|\n")

~'J'~

November 30, 2007

nice lisp

March 20, 2008

I am looking also for a lisp routine for coords with a leader.

can you help me

Thanks

March 20, 2008

Heres one i found the other day:

 ;get id
;this routine gets the id of a point and places text (with or without a leader) at that pont
;alan thompson (6.4.07)
(DEFUN C:PID()
(princ "\nNorthing & Easting Text Labeler")
(setq answer (strcase (getstring "\nLeader/No leader <Leader>: ")))
(cond     ((= answer "L")        (setq kopy 1))
       ((= answer "leader")    (setq kopy 1))
       ((= answer "")        (setq kopy 1))
       ((= answer "N")        (setq kopy 2))
       ((= answer "No")    (setq kopy 2))
       (t nil)
) ; End of Cond
(if (= kopy 1)
(progn
(WHILE
 (setq pt (getpoint "\nSelect point to identify: "))
 (setq pt2 (getpoint pt "\nSelect point for text placement: "))
 (setq ptascii-x (car pt))
 (setq ptascii-x (rtos ptascii-x))
 (setq ptascii-y (cadr pt))
 (setq ptascii-y (rtos ptascii-y))
 (setq ptascii-z (caddr pt))
 (setq ptascii-z (rtos ptascii-z))
 (setq textstr1 (strcat  "NORTHING: "  ptascii-y ))
 (setq textstr2 (strcat "EASTING: " ptascii-x ))
 (setq textsize-flag (getvar "TEXTSIZE"))
 (if (/= textsize-flag nil)
   (progn
(command "leader" pt pt2 "" "" "" textstr1 textstr2 "")
   )
 )
 (if (= textsize-flag nil)
   (progn
(command "leader" pt pt2 "" "" "" textstr1 textstr2 "")
   )
 )
)
) ; End of Progn
) ; End of If
(if (= kopy 2)
(progn
(WHILE
 (setq pt (getpoint "\nSelect point to identify: "))
 (setq ptascii-x (car pt))
 (setq ptascii-x (rtos ptascii-x))
 (setq ptascii-y (cadr pt))
 (setq ptascii-y (rtos ptascii-y))
 (setq ptascii-z (caddr pt))
 (setq ptascii-z (rtos ptascii-z))
 (setq textstr1 (strcat  "NORTHING: "  ptascii-y ))
 (setq textstr2 (strcat "EASTING: " ptascii-x ))
 (setq textsize-flag (getvar "TEXTSIZE"))
 (if (/= textsize-flag nil)
   (progn
(command "-mtext" pt "w" "0" textstr1 textstr2 "")
   )
 )
 (if (= textsize-flag nil)
   (progn
(command "-mtext" pt "w" "0" textstr1 textstr2 "")
   )
 )
)

) ; End of Progn
) ; End of If
(princ))

March 20, 2008

http://www.cadtutor.net/forum/showthread.php?t=10812&highlight=ordi

There is X,Y coodinates if you want I can alterate it.

March 21, 2008

Here you go...You have to load both lisp for it to work, It works perfect for me.

 
(defun c:NEL
      (/ ANNOTATION LEADERPOINT NEWMLEADER POINT POINTS)
 (vl-load-com)
 (setq Point     (getpoint "\nSpecify point: ")
Point     (list (car Point) (cadr Point) 0.0)
LeaderPoint (getpoint Point "\nSpecify Leader End Point: ")
LeaderPoint (list (car LeaderPoint) (cadr LeaderPoint) 0.0)
Points     (vlax-make-safearray vlax-vbDouble '(0 . 5))
Points     (vlax-safearray-fill Points (append Point LeaderPoint))
Annotation
     (strcat "N "
      (rtos (cadr Point))
      "[url="file://PE/"]\\PE[/url] "
      (rtos (car Point))
     )
Annotation
     (vlax-invoke-method
       (findSpace)
       'AddMtext
       (vlax-safearray-fill
  (vlax-make-safearray vlax-vbDouble '(0 . 2))
  LeaderPoint
       )
       0
       Annotation
     )
 )
 (vlax-put-property
   Annotation
   'Height
   (* (getvar "dimscale") (getvar "dimtxt"))
 )
 (vlax-invoke-method
   (FindSpace)
   'AddLeader
   Points
   Annotation
   acLineWithArrow
 )
)

 
 (defun
       FINDSPACE
                (/ *DOC*)
   (vl-load-com)
   (setq *DOC* (vla-get-activedocument (vlax-get-acad-object)))
   (setq SPACE (if (= 1 (vla-get-activespace *DOC*))
                 (vla-get-modelspace *DOC*) ;we're in modelspace
                 (if (= (vla-get-mspace *DOC*) :vlax-true)
                   (vla-get-modelspace *DOC*) ;we're in modelspace
         ;thru paperspace VPort
                   (vla-get-paperspace *DOC*) ;we're in paperspace
                 ) ;_ end of if
               ) ;_ end of if
   ) ;_ end of setq
 ) ;_ end of defun

May 4, 2008

i use this in part of program i use at work, you'll have to change it a bit though

    

(defun C:Ref()


(Setq Ref_point nil)

   (while (= Ref_point nil)
       (Setq Ref_point (getpoint "\nSelect point of reference\n"))
      
           (cond
               ( (= Ref_point nil)
                   (alert "No point selected")
               )
          
           )
         )




    (setq precis 0)

    (setq Xval (car Ref_point) Yval (cadr Ref_point))

         (setq Xtxt (rtos Xval 2 precis))

          (setq Xco1(substr Xtxt 1 3))
        (setq Xco2(substr Xtxt 4 6))
           (Setq X_Final(strcat "X: "Xco1","Xco2))

       (setq Ytxt (rtos Yval 2 precis))
    
          (setq Yco1(substr Ytxt 1 3))
          (setq Yco2(substr Ytxt 4 6))
             (Setq Y_Final(strcat "Y: "Yco1","Yco2))



     ;Ordinance detail;

         (Setq Ord1 (substr Xco1 1 1))
         (Setq Ord2 (substr Yco1 1 1))
     (Setq Ordref (strcat Ord1 Ord2))

         (Setq Ordinance_convert (atoi Ordref))


(Setq Ordinance "_-_-_-_-_-_-_-WRMGB_-_-_XSNHC_-_-_YTOJD_-_-_ZU-K")

  
     (Setq Ordinance_letter (substr Ordinance Ordinance_convert 1))
    
       (Setq Ord_numX (Substr Xtxt 2 2))
       (Setq Ord_numY (Substr Ytxt 2 2))

(Setq Ordinance_final( strcat "(N" Ordinance_letter ": " Ord_numX Ord_numY ")")) 


   ;Printing Text;




  (command "text""s""Standard" Ref_point"" X_final)
         (Setq X_print (entlast))


 (command "text" ""Y_final)
         (Setq Y_print (entlast))

 (command "text" ""Ordinance_final)
         (Setq Ord_print (entlast))

)

The ordinance string is just a lazy way for me to set the grid letters

i have to give credit to daiharv for the part that turns the point into a string

May 4, 2008

Heres one i found the other day:

 ;get id
;this routine gets the id of a point and places text (with or without a leader) at that pont
;alan thompson (6.4.07)
(DEFUN C:PID()
(princ "\nNorthing & Easting Text Labeler")
(setq answer (strcase (getstring "\nLeader/No leader <Leader>: ")))
(cond     ((= answer "L")        (setq kopy 1))
       ((= answer "leader")    (setq kopy 1))
       ((= answer "")        (setq kopy 1))
       ((= answer "N")        (setq kopy 2))
       ((= answer "No")    (setq kopy 2))
       (t nil)
) ; End of Cond
(if (= kopy 1)
(progn
(WHILE
 (setq pt (getpoint "\nSelect point to identify: "))
 (setq pt2 (getpoint pt "\nSelect point for text placement: "))
 (setq ptascii-x (car pt))
 (setq ptascii-x (rtos ptascii-x))
 (setq ptascii-y (cadr pt))
 (setq ptascii-y (rtos ptascii-y))
 (setq ptascii-z (caddr pt))
 (setq ptascii-z (rtos ptascii-z))
 (setq textstr1 (strcat  "NORTHING: "  ptascii-y ))
 (setq textstr2 (strcat "EASTING: " ptascii-x ))
 (setq textsize-flag (getvar "TEXTSIZE"))
 (if (/= textsize-flag nil)
   (progn
(command "leader" pt pt2 "" "" "" textstr1 textstr2 "")
   )
 )
 (if (= textsize-flag nil)
   (progn
(command "leader" pt pt2 "" "" "" textstr1 textstr2 "")
   )
 )
)
) ; End of Progn
) ; End of If
(if (= kopy 2)
(progn
(WHILE
 (setq pt (getpoint "\nSelect point to identify: "))
 (setq ptascii-x (car pt))
 (setq ptascii-x (rtos ptascii-x))
 (setq ptascii-y (cadr pt))
 (setq ptascii-y (rtos ptascii-y))
 (setq ptascii-z (caddr pt))
 (setq ptascii-z (rtos ptascii-z))
 (setq textstr1 (strcat  "NORTHING: "  ptascii-y ))
 (setq textstr2 (strcat "EASTING: " ptascii-x ))
 (setq textsize-flag (getvar "TEXTSIZE"))
 (if (/= textsize-flag nil)
   (progn
(command "-mtext" pt "w" "0" textstr1 textstr2 "")
   )
 )
 (if (= textsize-flag nil)
   (progn
(command "-mtext" pt "w" "0" textstr1 textstr2 "")
   )
 )
)

) ; End of Progn
) ; End of If
(princ))

wow, that's the first time i've ever seen any of my work posted somewhere that i didn't post. wild. anyway, i thought i'd update it a little bit. it still uses cond instead of keywords (just being sloppy). however, now it will use qleader instead of leader and will reset the qleader settings to what they were beforehand.

btw, Least, where did you find that posted (just curious)?

here's the updated code: enjoy

;get id
;this routine gets the id of a point and places text (with or without a leader) at that pont
;created by: alan thompson (12.4.07)
;edited by: alan thopmson  (5.4.08)  updated just to work a little better, stopped using leader and uses qleader
;                     will also reset qleader settings to what the were before.
(DEFUN C:PID()
(setvar "cmdecho" 0)
(setq qsettings (ql-get))
(princ "\nNorthing & Easting Text Labeler")
(setq answer (strcase (getstring "\nLeader/No leader <Leader>: ")))
(cond     ((= answer "L")        (setq kopy 1))
       ((= answer "leader")    (setq kopy 1))
       ((= answer "")        (setq kopy 1))
       ((= answer "N")        (setq kopy 2))
       ((= answer "No")    (setq kopy 2))
       (t nil)
) ; End of Cond
(if (= kopy 1)
(progn
(WHILE
 (setq pt (getpoint "\nSelect point to identify: "))
 (setq pt2 (getpoint pt "\nSelect point for text placement: "))
 (setq ptascii-x (car pt))
 (setq ptascii-x (rtos ptascii-x))
 (setq ptascii-y (cadr pt))
 (setq ptascii-y (rtos ptascii-y))
 (setq ptascii-z (caddr pt))
 (setq ptascii-z (rtos ptascii-z))
 (setq textstr1 (strcat  "NORTHING: "  ptascii-y ))
 (setq textstr2 (strcat "EASTING: " ptascii-x ))
 (setq textsize-flag (getvar "TEXTSIZE"))
   (progn
   (ql-set '((3 . "") (40 . 0.0) (60 . 0) (61 . 0) (62 . 2) (63 . 2) (64 . 0) (65 . 0) (66 . 0) (67 . 3) (68 . 0) (69 . 0) (70 . 0) (71 . 0) (72 . 0) (170 . 0)))
   (command "qleader" pt pt2 "" textstr1 textstr2 "")
   (ql-set qsettings)
   );progn
) ; while
) ; End of Progn
) ; End of If
(if (= kopy 2)
(progn
(WHILE
 (setq pt (getpoint "\nSelect point to identify: "))
 (setq ptascii-x (car pt))
 (setq ptascii-x (rtos ptascii-x))
 (setq ptascii-y (cadr pt))
 (setq ptascii-y (rtos ptascii-y))
 (setq ptascii-z (caddr pt))
 (setq ptascii-z (rtos ptascii-z))
 (setq textstr1 (strcat  "NORTHING: "  ptascii-y ))
 (setq textstr2 (strcat "EASTING: " ptascii-x ))
 (setq textsize-flag (getvar "TEXTSIZE"))
 (command "mtext" pt "w" "0" textstr1 textstr2 "")
) ; while
) ; End of Progn
) ; End of If
(princ))


(DEFUN QL-GET (/ XR COD ITM REPLY)
 (IF (SETQ XR (DICTSEARCH (NAMEDOBJDICT) "AcadDim"))
   (PROGN
     (FOREACH COD
          '(3 40 60 61 62 63 64 65 66 67 68 69 70 71 72 170 340)
   (IF (SETQ ITM (ASSOC COD XR))
     (SETQ REPLY (APPEND REPLY (LIST ITM)))
   )
     )
     REPLY
   )
   '((3 . "")
     (40 . 0.0)
     (60 . 0)
     (61 . 0)
     (62 . 1)
     (63 . 1)
     (64 . 0)
     (65 . 1)
     (66 . 0)
     (67 . 3)
     (68 . 0)
     (69 . 0)
     (70 . 0)
     (71 . 0)
     (72 . 0)
     (170 . 0)
    )
 )
)

(DEFUN QL-SET (ARG / CUR PRM)
 (SETQ CUR (QL-GET))
 (WHILE ARG
   (SETQ PRM (CAR ARG)
     ARG (CDR ARG)
     CUR (SUBST PRM (ASSOC (CAR PRM) CUR) CUR)
   )
   (IF    (= 3 (CAR PRM))
     (SETVAR "DIMLDRBLK" (CDR PRM))
   )
 )
 (DICTREMOVE (NAMEDOBJDICT) "AcadDim")
 (SETQ
   CUR    (APPEND    '((0 . "XRECORD") (100 . "AcDbXrecord") (90 . 990106))
       CUR
   )
 )
 (DICTADD (NAMEDOBJDICT) "ACADDIM" (ENTMAKEX CUR))
 (QL-GET)
)

February 9, 2017

however, now it will use qleader instead of leader and will reset the qleader settings to what they were beforehand.

Is there a way to set the Text Style? every time i use it, it places Standard text style even though it's not my default.

February 9, 2017

Is there a way to set the Text Style? every time i use it, it places Standard text style even though it's not my default.

Oh man, that code is embarrassing!

For Leaders/QLeaders, the textstyle is set in the active dimension style. However, you can temporarily override it by setting the DIMTXSTY system variable. Just be sure to reset when done.

All that being said, if you're running 2016, I would hope you are using MLeaders.

Sign In

Easting and Northing Lisp Routine

Recommended Posts

CAD Monkey Champion 2007

Guest Alan Cullen

CAD Monkey Champion 2007

Guest Alan Cullen

CAD Monkey Champion 2007

BIGAL

smorales02

NBC

fixo

chulse

komfort

Least

ASMI

smorales02

ollie

alanjt

RubberDinero

alanjt

Join the conversation

Tutorials

Forums

Activity