Jump to content

Survey Grid Lisp


Hallen11

Recommended Posts

Hello there,

 

This is my first post so forgive me if it's in the wrong place or something.

 

I've been looking for a lisp routine that draws a survey grid, at user specified

intervals, to the exents of my viewports. Or just to a rectangle would do.

And if anyone knows of a routine that allows me to zoom my viewports to

a model space rectangle, I'd be much obliged.

 

Many thanks for any help offered and if anyone requires further clarification

just let me know.

 

Cheers!

Link to comment
Share on other sites

I am afraid that I cannot help you with your request. My lisp was written 20 years ago, and my brain has shrunk since then. I also do not use Paper Space, but I expect there is someone out there who could help. Or you could even write your own lisp to do exactly as you want it to 8)

Link to comment
Share on other sites

Ok thanks anyway.

Hallen11's to do list;

1) Learn lisp

2) Write Grid lisp

:)

 

Could you send me what you have and I can see if I can sort of "crowbar" it into doing what I want?

I have got a very basic knowledge of lisp and this could be a good learning excercise for me. Plus

it'll give me something to do!

Link to comment
Share on other sites

Sorry, I sounded a bit ungrateful before. I do appriciate the help and, eldon, I'm currently trying to see

if I can customise what you offered me to get it to do what I need. I'll let you know the results.

And thanks again for the help.

Link to comment
Share on other sites

This is what I'd like the end result to look like

 

Drawing1_Model_(1)_page_001.jpg

 

With the text round the edges, prefarably with the green highlighting at 50m intervals, all drawn to

a user defined rectangle (which I'll be copying and pasting from my viewport).

 

Cheers.

Link to comment
Share on other sites

One practical point is that different surveys do not necessarily have the same coordinates, so each of your viewports would be a one off.

 

I would do it manually (takes less than a minute using my lisp as a basis) instead of having the need to do everything with one push of a button. :shock:

 

But if you want to spend time writing the lisp, then you can share it afterwards :D

Link to comment
Share on other sites

The thing is that in my last job I was spoiled rotten. One of the lads there was a lisp GENIUS! I think he must have dreamed in lisp! And he'd written a spank-load of lisp routines that I'd just taken for granted. One of them was his grid command that could draw a grid pretty much however you wanted it. Now in my new job I've got to start from scratch and I'm starting to understand just how much he did! :oops:

Rest assured though, if I manage to get my grid routine off the ground I'll be sharing it with everyone (along with anything else I come up with!)....got to get them working first though! :?

Link to comment
Share on other sites

Try this one, no idea who wrote it.

I use a different one but I can't post it as it's copyrighted.

(defun c:addgrid()
(SETVAR "SNAPANG" 0)
(SETQ space (GETreal "\n Input Grid Interval :- "))
(setq pt1 (getpoint "\n Pick Bottom Left Corner for Grid :- "))
(setq pt2 (getcorner pt1 "\n Pick Top Right Corner for Grid :- "))
(setq scale (getreal "\n Scale for Grid Information :- "))
(SETVAR "CMDECHO" 0)
(SETVAR "ANGBASE" 0)
(SETVAR "ANGDIR" 0)
(setq csize (* 10.0 (/ scale 1000.0)))
(setq X1 (CAR PT1))
(SETQ Y1 (CADR PT1))
(SETQ X2 (CAR PT2))
(SETQ Y2 (CADR PT2))
(SETQ X1A (/ X1 SPACE))
(SETQ X1b (FIX X1A))
(SETQ X1c (- X1A X1b))
(SETQ X1c (* X1c SPACE));remainder
(SETQ y1A (/ y1 SPACE))
(SETQ y1b (FIX y1A))
(SETQ y1c (- y1A y1b))
(SETQ y1c (* y1c SPACE));remainder
(SETQ y2A (/ y2 SPACE))
(SETQ y2b (FIX y2A))
(SETQ y2c (- y2A y2b))
(SETQ y2c (* y2c SPACE));remainder
(SETQ X2A (/ X2 SPACE))
(SETQ X2b (FIX X2A))
(SETQ X2c (- X2A X2b))
(SETQ X2c (* X2c SPACE));remainder
(setq x1b (* (+ x1b 1) space))
(setq y1b (* (+ y1b 1) space))
(setq x2b (* x2b space))
(setq y2b (* y2b space))
(setq xarr (- x2b x1b))
(setq xarr (/ xarr space))
(setq yarr (- y2b y1b))
(setq yarr (/ yarr space))
(setq orig (list x1b y1b))
(command "line" (list x1b (- y1b csize)) (list x1b (+ y1b csize)) "")
(setq l1 (entlast))
(command "line" (list (- x1b csize) y1b) (list (+ x1b csize) y1b) "")
(setq l2 (entnext l1))
(setq yarr (fix yarr)) (setq xarr (fix xarr))
(command "array" l1 l2 "" "r" (+ 1 yarr) (+ 1 xarr) space space)
(setq east x1b)
(setq inner (/ 1.0 (/ 1000.0 scale)))
(setq tsize (/ 1.5 (/ 1000.0 scale)))
(repeat (+ xarr 1)
(setq texor (list (+ east inner) (- y2 inner)))
(setq val (rtos east 2 3))
(SETQ VAL (STRCAT VAL "E"))
(command "text" texor tsize "270" val)
(setq east (+ east space))
)
(setq east x1b)
(repeat (+ xarr 1)
(setq texor (list (+ east inner) (+ y1 inner)))
(setq val (rtos east 2 3))
(setq val (strcat val "E"))
(command "text" "r" texor tsize "270" val)
(setq east (+ east space))
)
(setq north y1b)
(repeat (+ 1 yarr)
(setq texor (list (+ x1 inner) (+ north inner)))
(setq val (rtos north 2 3))
(SETQ VAL (STRCAT VAL "N"))
(command "text" texor tsize "0" val)
(setq north (+ north space))
)
(setq north y1b)
(repeat (+ 1 yarr)
(setq texor (list (- x2 inner) (+ north inner)))
(setq val (rtos north 2 3))
(SETQ VAL (STRCAT VAL "N"))
(command "text" "r" texor tsize "0" val)
(setq north (+ north space))
)
(SETVAR "CMDECHO" 1)
)

Link to comment
Share on other sites

Close enough Least cheers! I think I'll have a little play about with it to see if I can personalise it somewhat. I may even keep on with mine just for the hell of it (if I can be bothered! :whistle:)

Thanks again to everyone who's helped me out!

Link to comment
Share on other sites

  • 1 month later...

I finally got round to finishing my grid lisp! I must admit i'm actually quite proud of it.

The code is a bit untidy but the command itself seems to work fine. (And that'll do for

me!)

So, for those of you who are interested here it is. Any feedback will be appreciated.

gridR.lsp

Link to comment
Share on other sites

See what you can do when you put your mind to it. Congratulations :D

 

If it works as you want it to, then it is perfect.

Link to comment
Share on other sites

Had a look at your code and have done a lot of stuff re scales it looked to me that you may be able to simplify the scale stuff by just working out a scale factor rather than working it out for every scale just remember for metric which it appears to be that 1m = 1000 millimetres

 

Work out a variable say setsc as 1000/scale then you just need to fator say your line spacing as setsc*distance between lines etc

 

heres an example and it uses "repeat" rather than a "while" to loop you can have repeat inside a repeat which makes it easier to do grid stuff 3*X 4*Y

(repeat X (Repeat Y etc ))

 

(setvar "cLAYER" GRID--2)
(setq IP1 (getpoint "\nSTARTING POINT  (TOP LEFT CORNER): "))(terpri)
(setq X(car IP1)) (setq Y(cadr IP1))
(setq EWLIST(list X)) (setq NSLIST(list Y))
(setq #EW(getint"Number of GRIDS across: "))(terpri)
(setq EW1(getint"Dimension for first GRID: "))(terpri)
(setq EWD(+ X EW1)) (setq EWLIST(append EWLIST (list EWD)))
(setq EW2(itoa EW1))
(setq #BAY 2)
(repeat (- #EW 1)
(setq $BAY(itoa #BAY))
(setq FISH(strcat "Dimension for Grid " $BAY ": <RETURN> to repeat previous: "))
(setq EW3(getstring FISH)) (TERPRI)
(if (= (ascii EW3) 0)(setq EW3 EW2))
(setq EW1(atoi EW3)) (setq EW2(itoa EW1))
(setq EWD(+ EWD EW1))
(setq EWLIST(append EWLIST (list EWD)))
(setq #BAY(+ #BAY 1))
)
(setq EWD(+ EWD 2000))
(setq #NS(getint"Number of Grids down: "))(terpri)
(setq NS1(getint"Dimension for first Grid: "))(terpri)
(setq NSD(- Y NS1)) (setq NSLIST(append NSLIST (list NSD)))
(setq NS2(itoa NS1)) (setq #BAY 2)
(repeat (- #NS 1)
(setq $BAY(itoa #BAY))
(setq NS3(getstring"..And next Grid <RETURN> to repeat previous: "))(terpri)
(if (= (ascii NS3) 0)(setq NS3 NS2))
(setq NS1(atoi NS3)) (setq NS2(itoa NS1))
(setq NSD(- NSD NS1))
(setq NSLIST(append NSLIST (list NSD)))
)
(setq NSD(- NSD 2000))
(setq NUM 0)
(repeat (+ #EW 1)
(command "LINE" (list (nth NUM EWLIST)(+ Y 2000))(list (nth NUM EWLIST) NSD))(command)
(setq NUM(+ NUM 1))
(setq #BAY(+ #BAY 1))
)
(setq NUM 0)
(repeat (+ #NS 1)
(command "LINE" (list (- X 2000) (nth NUM NSLIST)) (list EWD (nth NUM NSLIST))) (command)
(setq NUM(+ NUM 1))
)

 

hope this helps for other projects as a first go pretty good effort

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