Jump to content

Lisp coordinate grid marks


Dani_Nadir

Recommended Posts

Hello all,

 

I have 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))
      )
      (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) ))
	(command "_text" (polar p0 0 (* ts 3.0)) ts (angtos (/ pi 2)) (strcat "E " (rtos ys 2 0) ))
      )
      (setq ys (+ ys xg))    
   ) ;;; end while

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

It is to draw grid marks with their respective N and E coordinates. N coordinate are well but E are wrong.

And I'd like to center all texts with the grids, as you can see from the dwg.

 

I am really bad at coding I know, but I cant advance.

 

thanks!

1.dwg

Link to comment
Share on other sites

Attached is an example that took a couple of minutes to create using the standard array command and a custom block.

 

1.dwg

Edited by ronjonp
*Attached file without EDU stamp
Link to comment
Share on other sites

  • 5 weeks later...
On 3/1/2019 at 8:57 PM, Dani_Nadir said:

Hello all,

 

I have 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))
      )
      (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) ))
	(command "_text" (polar p0 0 (* ts 3.0)) ts (angtos (/ pi 2)) (strcat "E " (rtos ys 2 0) ))
      )
      (setq ys (+ ys xg))    
   ) ;;; end while

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

It is to draw grid marks with their respective N and E coordinates. N coordinate are well but E are wrong.

And I'd like to center all texts with the grids, as you can see from the dwg.

 

I am really bad at coding I know, but I cant advance.

 

thanks!

1.dwg 40.05 kB · 9 downloads

It syas Command: COO
Bottom left corner:
Bottom right corner:
Height:
Grid interval <100>:
Text height <2.50>:
Tick length <10.00>:
Error: bad argument type: consp nil

pls check what is BAD

Link to comment
Share on other sites

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.

×
×
  • Create New...