Autolisp program to generate grid lines

[skipo4us]

Please, I need an Autolisp program to generate grid lines at specified intervals of a defined area (probably, using windows to capture the area) in any AutoCAD version.
Look forward to receiving your responses.
Thanks

[GE13579]

Can you use ARRAY for this? You could then define your window and I think the command was EXTRIM to trim all lines outside the boundary...?

[Raggi_Thor]

hatch?
user defined and double.

[jason tay]

u may try this vpgrid.lsp
http://209.85.175.104/search?q=cache...lnk&cd=4&gl=my

hope can help

[fixo]

Here is my 2¢...

(defun c:grd()
(setvar "cmdecho" 0)
  (setq osm (getvar "osmode"))
(setvar "osmode" 0)
(setq p1 (getpoint "\nLower left corner point: ")
      p2 (getcorner p1 "\nOpposite corner: ")
xd (abs (- (car p2)(car p1)))
yd (abs (- (cadr p2)(cadr p1)))
st (getdist "\nStep : ")
nx (fix (/ xd st))
ny (fix ( / yd st))	
)
(if (or (>= st (/ xd 2))(>= st (/ yd 2)))
  (progn
  (alert "Wrong parameters defined")(exit)(princ)))
  (command "rectang" p1 p2)
  (setq r1 (list (car p1)(+ (cadr p1) st)(caddr p1))
	r2 (list (car p2)(cadr r1)(caddr p2)))
(command "pline" r1 r2 "")
(command "array" "L" "" "R" ny 1 st "")
   (setq c1 (list (+ (car p1)st)(cadr p1)(caddr p1))
	c2  (list (car c1)(cadr p2)(caddr p2)))
(command "pline" c1 c2 "")
(command "array" "L" "" "R" 1 nx st "") 
(setvar "cmdecho" 1)
  (setvar "osmode" osm)
)

This one should create simmetric grid:

            (defun C:GCL (/)
            (setvar "cmdecho" 0)
            (setq osm (getvar "osmode"))
            (setvar "osmode" 0)
            (prompt "\nPick always first lower left corner point!")
            (setq p1 (getpoint "\nPick first corner point")

            p2 (getcorner p1 "\nPick opposite corner point")
            step (getdist  "\nEnter step : ")      
            pc (mapcar (function (lambda (x y)(* (+ x y) 0.5)))
            p1
            p2
            )
            x1 (list (car p1) (/ (+ (cadr p1)(cadr p2) 2)))
            x2 (list (car p2) (/ (+ (cadr p1)(cadr p2) 2)))
            y1 (list (/ (+ (car p1)(car p2) 2))(cadr p1))
            x2 (list (/ (+ (car p1)(car p2) 2))(cadr p2))
            len (abs (distance (list (car p1) (cadr p1))(list (car p2)(cadr 
            p1))))
            wid (abs (distance (list (car p1) (cadr p1))(list (car p1)(cadr 
            p2))))
            deltax (rem len step)
            deltay (rem wid step)
            xcount (fix (/ len step))
            ycount (fix (/ wid step)))
            
            (if (zerop deltax)(progn (setq oddx t)(setq oddx nil))) 
            (if (zerop deltay)(progn (setq oddy t) (setq oddy nil)))
            (if (or (and (> (car p2)(car p1))
            (< (cadr p2)(cadr p1)))
            (and (< (car p2)(car p1))
            (< (cadr p2)(cadr p1))))
            (progn
            (setq way t)(setq way nil)))

            (if way
            (progn 
            (setq ll (list (car p1)(cadr p2))
            ul p1
            ur (list (car p2)(cadr p1))
            lr p2))
            (progn 
            (setq ll p1
            ul (list (car p1)(cadr p2))
            ur p2
            lr (list (car p2)(cadr p1)))))
            (if oddy
            (progn
            (command "line" ll lr "")
            (command "-array" (entlast) "" "R" ycount 1 step))
            (progn (command "line" ll lr "") 
            (command "copy" (entlast) "" ll (list (car ll)(+ ( cadr ll)(/ deltay 
            2))))
            (command "-array" (entlast) "" "R" (1+ ycount) 1 step)
            (command "copy" (entlast) "" ll (list (car ll)(+ ( cadr ll)(/ deltay 
            2))))))
            (if oddx
            (progn
            (command "line" ll ul "")
            (command "-array" (entlast) "" "R" 1 xcount step))
            (progn (command "line" ll ul "") 
            (command "copy" (entlast) "" ll (list (+ (car ll)(/ deltax 2))( cadr 
            ll)))
            (command "-array" (entlast) "" "R" 1 (1+ xcount) step)
            (command "copy" (entlast) "" ll (list (+ (car ll)(/ deltax 2))( cadr 
            ll)))))
            (setvar "osmode" osm)

            (setvar "cmdecho" 1)
            (princ)
            )
            (prompt "\n\t\t***\tType GCL to execute \t***\n")
            (princ)

~'J'~

[motee-z]

here is my lisp

(defun c:mknet (/ p1 p2 l w nx ny p3 p4 i k)
  (command "._undo" "_BE") 
(setq obm (getvar "blipmode")) 
(setq osmd (getvar "osmode"))
(setq andr(getvar"angdir"))
(setvar "angdir"1)
(setq andb(getvar"angbase")) 
(setvar "angbase"(/ pi 2))
(setq aunt(getvar"aunits"))  
(setvar "aunits"2)
(setvar "dimaunit"2)
(setvar"dimadec"4)
(setq clyr(getvar"clayer"))
  (setq d (getdist "\n enter length of square: "))
  (setvar"snapmode"1)
  (setvar"snapbase"(list 0 0))
  (setvar"snapunit"(list d d))
  (setvar"osmode"0)
  (setq p1 (getpoint "\n enter upper left corner"))
  (setvar"snapbase"(list(car p1)(cadr p1)))
  (setvar"snapunit"(list d d))
  (setq p2 (getcorner p1"\n enter other corner"))
  (setq lyr(strcat"net"(rtos d 2 0)"0"))
(setq l (abs(-(car p2)(car p1))))
(setq w (abs(-(cadr p1)(cadr p2))))
(setq nx (/ l d))
(setq ny (/ w d))
(setq nx1 (fix nx))
(setq ny1 (fix ny))
(setq p3 (list (car p1)(cadr p2)))
(setq p4 (list(car p2)(cadr p1)))
(setq p5 (list(+(car p1)(* nx1 d))(cadr p1)))
(setq p6 (list(car p1)(-(cadr p1)(* ny1 d))))
(setq sfa (* 0.025 d))
(command "layer" "m" lyr "c" "54" "" "L" "continuous" "" "LW" 0.15 "" "")
(command "layer" "m" "nettxt" "c" "white" "" "L" "continuous" "" "LW" 0.20 "" "")  
(setq i 0)
(while(<= i nx1)
  (setvar "osmode"0)
   
  (command"layer" "s" lyr "")
  (command"color" "bylayer")
  (command "line" (list(+(car p1)(* i d))(cadr p1))(list(+(car p1)(* i d))(cadr p6)) "")
  
  (setq pnx (list(+(car p1)(* i d))(cadr p1)))
  (setq pnx1 (list(+(car pnx)(* 0.01 d))(-(cadr pnx)(* 0.01 d))))
  
  (command"layer" "s" "nettxt" "")
  (command"color" "bylayer")
  (command "text" pnx1 sfa 200 (strcat"X="(rtos(car pnx)2 0)))
  
  (setq i (+ 1 i))
  )
(setq k 0)
(while(<= k ny1)
  
  (command"layer" "s" lyr "")
  (command "line" (list(car p1)(-(cadr p1)(* k d)))(list(car p5)(-(cadr p5)(* k d)))"")
  
  (setq pny (list(car p1)(-(cadr p1)(* k d))))
  (setq pny1 (list(+(car pny)(* 0.01 d))(+(cadr pny)(* 0.01 d))))
  
  (command"layer" "s" "nettxt" "")
  (command "text" pny1 sfa 100 (strcat"Y="(rtos(cadr pny)2 0)))
  
  (setq k (+ 1 k))
  
  )
  (command "._undo" "_END")
  (setvar"clayer"clyr)
  (setvar"angbase"andb)
  (setvar "angdir"andr)
  (setvar"aunits"aunt)
  (setvar"snapmode"0)
  (setvar "osmode"osmd)
)