Coordinate grids

[dani-perez]

Hello all

I have a problem with this code:

(defun c:coo ()
 (setvar "cmdecho" 0)
   (if (not lxg) (setq lxg 100.0))
   (if (not lts) (setq lts 2.5))
   (if (not llt) (setq llt 10.0))
   (setq p nil)
   (setq p (append p (list (getpoint "\nBottom left corner: "))))
   (setq p (append p (list (getpoint (nth 0 p) "\nBottom right corner: "))))
   (setq bg (+ (angle (nth 0 p) (nth 1 p)) (/ pi 2)))
   (setq cp (getpoint (nth 0 p) "\nHeight: "))
   (setq dis (distance cp (inters cp (polar cp bg 10.0) (nth 0 p) (nth 1 p) nil)))
   (setq p (append p (list (polar (nth 1 p) bg dis))))
   (setq p (append p (list (polar (nth 0 p) bg dis))))
   (setq p (append p (list (nth 0 p))))
   (setq abase (getvar "angbase") adir (getvar "angdir"))
   (setvar "angbase" (/ pi 2))
   (setvar "angdir" 1)
   (setvar "blipmode" 0)
   (setq xg (getreal (strcat "\nGrid interval <" (rtos lxg 2 0) ">: ")))
   (if (not xg) (setq xg lxg) (setq lxg xg))
   (setq ts (getreal (strcat "\nText height <" (rtos lts 2 2) ">: ")))
   (if (not ts) (setq ts lts) (setq lts ts))
   (setq lt (getreal (strcat "\nTick length <" (rtos llt 2 2) ">: ")))
   (if (not lt) (setq lt llt) (setq llt lt))
   (setq minx (car (nth 0 p)) miny (cadr (nth 0 p)) maxx minx maxy miny)
   (setq n 1)
   (repeat 3
      (progn
         (if (< (car (nth n p)) minx) (setq minx (car (nth n p))))
         (if (< (cadr (nth n p)) miny) (setq miny (cadr (nth n p))))
         (if (> (car (nth n p)) maxx) (setq maxx (car (nth n p))))
         (if (> (cadr (nth n p)) maxy) (setq maxy (cadr (nth n p))))
         (setq n (1+ n))
      )
   )
   (setq xs (+ xg (* (fix (/ minx xg)) xg)) ys (+ xg (* (fix (/ miny xg)) xg)))
;;;do 'x' grid  (bearing = pi/2)
   (while (<= xs maxx)
      (setq n 0 plist nil)
      (repeat 4   ;;;;; find the 2 intersecting grid points with boundary
       (progn
         (if (setq ip (inters (list xs miny) (list xs maxy) (nth n p) (nth (1+ n) p)))
            (setq plist (append plist (list ip)))
         )
         (setq n (1+ n))
       )
      )
      (if (> (cadr (nth 0 plist)) (cadr (nth 1 plist)))
         (setq p2 (nth 0 plist) p1 (nth 1 plist))
         (setq p1 (nth 0 plist) p2 (nth 1 plist))
      )
      (command "linea" p1 (polar p1 (/ pi 2) lt) "")
      (command "texto" (polar p1 (/ pi 2 ) (* ts 3.0)) ts (angtos (/ pi 2)) (strcat "E " (rtos xs 2 0) ))
      (setq xs (+ xs xg))
   ) ;;; end while
;;;do 'y' grid  (bearing = 0)
   (while (<= ys maxy)
      (setq n 0 plist nil phil "done")
      (repeat 4   ;;;;; find the 2 intersecting grid points with boundary
       (progn
         (if (setq ip (inters (list minx ys) (list maxx ys) (nth n p) (nth (1+ n) p)))
            (setq plist (append plist (list ip)))
         )
         (setq n (1+ n))
       )
      )
      (if (> (car (nth 0 plist)) (car (nth 1 plist)))
         (setq p2 (nth 0 plist) p1 (nth 1 plist))
         (setq p1 (nth 0 plist) p2 (nth 1 plist))
      )
;;;do '+' grid marks
      (setq sx (car p1) ex (car p2) fx (+ xg (* (fix (/ sx xg)) xg)))
      (while (<= fx ex)
         (setq p0 (list fx ys))
         (command "linea" (polar p0 pi (/ lt 2.0)) (polar p0 0.0 (/ lt 2.0)) "")
         (command "linea" (polar p0 (/ pi 2) (/ lt 2.0)) (polar p0 (* pi 1.5) (/ lt 2.0)) "")
         (setq fx (+ fx xg))
         (command "texto" (polar p0 0 (* ts 3.0)) ts (angtos 0) (strcat "N "(rtos ys 2 0) ))
      )
      (setq ys (+ ys xg))    
   ) ;;; end while

   (setvar "angbase" abase)
   (setvar "angdir" adir)
   (setvar "blipmode" 1)
   (princ)
)

East coordinates are not showed, and I dont know the reason.

Could someone have a look?

[devitg]

as to be test in native ACAD , change  the spanish Command to english with an underscore 

"_LINE"

"_text" 

[dani-perez]

Hello devitg

(defun c:coo ()
 (setvar "cmdecho" 0)
   (if (not lxg) (setq lxg 100.0))
   (if (not lts) (setq lts 2.5))
   (if (not llt) (setq llt 10.0))
   (setq p nil)
   (setq p (append p (list (getpoint "\nBottom left corner: "))))
   (setq p (append p (list (getpoint (nth 0 p) "\nBottom right corner: "))))
   (setq bg (+ (angle (nth 0 p) (nth 1 p)) (/ pi 2)))
   (setq cp (getpoint (nth 0 p) "\nHeight: "))
   (setq dis (distance cp (inters cp (polar cp bg 10.0) (nth 0 p) (nth 1 p) nil)))
   (setq p (append p (list (polar (nth 1 p) bg dis))))
   (setq p (append p (list (polar (nth 0 p) bg dis))))
   (setq p (append p (list (nth 0 p))))
   (setq abase (getvar "angbase") adir (getvar "angdir"))
   (setvar "angbase" (/ pi 2))
   (setvar "angdir" 1)
   (setvar "blipmode" 0)
   (setq xg (getreal (strcat "\nGrid interval <" (rtos lxg 2 0) ">: ")))
   (if (not xg) (setq xg lxg) (setq lxg xg))
   (setq ts (getreal (strcat "\nText height <" (rtos lts 2 2) ">: ")))
   (if (not ts) (setq ts lts) (setq lts ts))
   (setq lt (getreal (strcat "\nTick length <" (rtos llt 2 2) ">: ")))
   (if (not lt) (setq lt llt) (setq llt lt))
   (setq minx (car (nth 0 p)) miny (cadr (nth 0 p)) maxx minx maxy miny)
   (setq n 1)
   (repeat 3
      (progn
         (if (< (car (nth n p)) minx) (setq minx (car (nth n p))))
         (if (< (cadr (nth n p)) miny) (setq miny (cadr (nth n p))))
         (if (> (car (nth n p)) maxx) (setq maxx (car (nth n p))))
         (if (> (cadr (nth n p)) maxy) (setq maxy (cadr (nth n p))))
         (setq n (1+ n))
      )
   )
   (setq xs (+ xg (* (fix (/ minx xg)) xg)) ys (+ xg (* (fix (/ miny xg)) xg)))
;;;do 'x' grid  (bearing = pi/2)
   (while (<= xs maxx)
      (setq n 0 plist nil)
      (repeat 4   ;;;;; find the 2 intersecting grid points with boundary
       (progn
         (if (setq ip (inters (list xs miny) (list xs maxy) (nth n p) (nth (1+ n) p)))
            (setq plist (append plist (list ip)))
         )
         (setq n (1+ n))
       )
      )
      (if (> (cadr (nth 0 plist)) (cadr (nth 1 plist)))
         (setq p2 (nth 0 plist) p1 (nth 1 plist))
         (setq p1 (nth 0 plist) p2 (nth 1 plist))
      )
      (command "_line" p1 (polar p1 (/ pi 2) lt) "")
      (command "_text" (polar p1 (/ pi 2 ) (* ts 3.0)) ts (angtos (/ pi 2)) (strcat "E " (rtos xs 2 0) ))
      (setq xs (+ xs xg))
   ) ;;; end while
;;;do 'y' grid  (bearing = 0)
   (while (<= ys maxy)
      (setq n 0 plist nil phil "done")
      (repeat 4   ;;;;; find the 2 intersecting grid points with boundary
       (progn
         (if (setq ip (inters (list minx ys) (list maxx ys) (nth n p) (nth (1+ n) p)))
            (setq plist (append plist (list ip)))
         )
         (setq n (1+ n))
       )
      )
      (if (> (car (nth 0 plist)) (car (nth 1 plist)))
         (setq p2 (nth 0 plist) p1 (nth 1 plist))
         (setq p1 (nth 0 plist) p2 (nth 1 plist))
      )
;;;do '+' grid marks
      (setq sx (car p1) ex (car p2) fx (+ xg (* (fix (/ sx xg)) xg)))
      (while (<= fx ex)
         (setq p0 (list fx ys))
         (command "_line" (polar p0 pi (/ lt 2.0)) (polar p0 0.0 (/ lt 2.0)) "")
         (command "_line" (polar p0 (/ pi 2) (/ lt 2.0)) (polar p0 (* pi 1.5) (/ lt 2.0)) "")
         (setq fx (+ fx xg))
         (command "_text" (polar p0 0 (* ts 3.0)) ts (angtos 0) (strcat "N "(rtos ys 2 0) ))
      )
      (setq ys (+ ys xg))    
   ) ;;; end while

   (setvar "angbase" abase)
   (setvar "angdir" adir)
   (setvar "blipmode" 1)
   (princ)
)

here is the new code.

[Moshe-A]

@dani-perez  hi,

the code work good.

if you want to improve it. wrap it with undo begin & undo end (so you can undo it with one U)

declare all variables to local, this may prevent errors at forward runs.

moshe

[dani-perez]

Hello Moshe-A

Do you see East coordinate? I want the code to label each grid point with its respective North and East coordinates. But I only see North coordinate.

Coud you help me?

[dlanorh]

You are fighting AutoCAD, and not working with it; and it is overcomplicating your code.

You don't need three point to define the area, only two : bottom left ( ll ) and top right ( ur ).

From these you can find min x min y max x and max y

  (setq minx (* (fix (/ (car ll) xg)) xg)
        miny (* (fix (/ (cadr ll) xg)) xg)
        maxx (* (1+ (fix (/ (car ur) xg))) xg)
        maxy (* (1+ (fix (/ (cadr ur) xg))) xg)
        x_cnt minx
        y_cnt miny
  )
 (while (<= y_cnt maxy)
   (while (<= x_cnt maxx)

      ;;;;DO YOUR STUFF HERE
      ;;;;INTERSECTION POINT IS (list x_cnt y_cnt 0.0) 
      ;;;; Justify text Bottom Left (BL)
 
     (setq x_cnt (+ x_cnt xg));;increment x_cnt
   );end_while
   (setq x_cnt minx y_cnt (+ y_cnt xg));;Reset x_cnt and increment y_cnt
);end_while 

Text will either be 90 or 0. When inserting the text (angtos 0) = "0" and (angtos (/ pi 2)) = "90"

You don't need to change angbase or angdir they should both be 0 (zero)

and as @Moshe-A  said, localise your variables.