Jump to content

VPGrid.lsp???


anthraxx

Recommended Posts

I was given a Lisp routine at work called VPGrid, its ment to place a grid in a Viewport with co-ordinates. At the moment its being quiet random, sometimes it will place the grid with no co-ordinates, or it will work fine. Ive gone through and done everything i can to see what is tripping it up, if anyone has used this or knows of a better version, can you please let me know. Thanks

Erin

Link to comment
Share on other sites

;; vpgrid.lsp

;;

 

;;;-----------------------------------------------------------------------------

 

(defun gr_verify ()

(setvar "cmdecho" 0)

(setq gr_boss (ssget "x" (list (cons 0 "LWPOLYLINE")

(cons 8 "GRID_BORDER")

)

)

gr_tiss (ssget "x" (list (cons 0 "LINE")

(cons 8 "GRID_TICKS")

)

)

gr_tess (ssget "x" (list (cons 0 "TEXT")

(cons 8 "GRID_TEXT")

)

)

gr_con nil

)

(if (and gr_boss gr_tiss gr_tess)

(progn

(initget "Append Replace eXit")

(setq gr_con (getkword "\nGrid exists.\nAppend/Replace/eXit : "))

(if (not gr_con)

(setq gr_con "REPLACE")

(setq gr_con (strcase gr_con))

)

)

)

)

 

;;;-----------------------------------------------------------------------------

 

(defun gr_select ()

(setq gr_type nil)

(while (not (= gr_type "VIEWPORT"))

(setq gr_pp (entsel "\nSelect viewport: "))

(if gr_pp

(progn

(setq gr_ename (car gr_pp)

gr_ent (entget gr_ename)

gr_type (cdr (assoc 0 gr_ent))

)

(if (not (= gr_type "VIEWPORT"))

(prompt "\nObject selected is not a viewport")

)

)

)

)

)

 

;;;-----------------------------------------------------------------------------

 

(defun gr_fullortic()

(setq gr_gtype (getword "\nFull/Ticks : "))

 

 

)

;;;-----------------------------------------------------------------------------

 

(defun gr_settings ()

(initget 7)

(setq gr_int (getreal "\nGrid interval (m): "))

(setq gr_col "7" ;Grid layers color (paper space dimension)

gr_btick 20.0 ;Border tick length (paper space dimension)

gr_ctick 10.0 ;Centre tick length (paper space dimension)

gr_txthgt 2.5 ;Text height (paper space dimension)

)

)

(defun gr_del ()

(if (= gr_con "REPLACE")

(progn

(setq gr_ssl (1- (sslength gr_boss)))

(while (> gr_ssl -1)

(setq gr_ent (ssname gr_boss gr_ssl))

(entdel gr_ent)

(setq gr_ssl (1- gr_ssl))

)

(setq gr_ssl (1- (sslength gr_tiss)))

(while (> gr_ssl -1)

(setq gr_ent (ssname gr_tiss gr_ssl))

(entdel gr_ent)

(setq gr_ssl (1- gr_ssl))

)

(setq gr_ssl (1- (sslength gr_tess)))

(while (> gr_ssl -1)

(setq gr_ent (ssname gr_tess gr_ssl))

(entdel gr_ent)

(setq gr_ssl (1- gr_ssl))

)

)

)

)

 

;;;-----------------------------------------------------------------------------

 

(defun gr_data ()

(setq gr_ent (entget gr_ename '("ACAD"))

gr_vwp (cdr (assoc 40 gr_ent))

gr_vhp (cdr (assoc 41 gr_ent))

gr_vid (cdr (assoc 69 gr_ent))

gr_xdata (cadr (assoc -3 gr_ent))

gr_vta (cdr (nth 6 gr_xdata))

gr_vhm (cdr (nth 7 gr_xdata))

gr_vx (cdr (nth 8 gr_xdata))

gr_vy (cdr (nth 9 gr_xdata))

gr_gbr (- (* pi 0.5) gr_vta)

gr_xp (/ gr_vhp gr_vhm)

gr_vwm (/ gr_vwp gr_xp)

gr_vxy (list gr_vx gr_vy)

gr_hh (- (/ gr_vhm 2.0) (/ 1.0 gr_xp))

gr_hw (- (/ gr_vwm 2.0) (/ 1.0 gr_xp))

gr_btick (/ gr_btick gr_xp)

gr_ctick (/ gr_ctick gr_xp)

gr_txthgt (/ gr_txthgt gr_xp)

gr_txty1o (* gr_txthgt 0.5)

gr_txty2o (* gr_txthgt 1.5)

gr_txtxo (* gr_txthgt 1.0)

)

(command "mspace")

(setvar "cvport" gr_vid)

(setq gr_wxy (trans gr_vxy 2 0))

(command "pspace")

(setq gr_tmp (polar gr_wxy gr_gbr gr_hh)

gr_pnt1 (polar gr_tmp (+ gr_gbr (* pi 0.5)) gr_hw)

gr_pnt2 (polar gr_tmp (+ gr_gbr (* pi 1.5)) gr_hw)

gr_tmp (polar gr_wxy (+ gr_gbr (* pi 1.0)) gr_hh)

gr_pnt3 (polar gr_tmp (+ gr_gbr (* pi 1.5)) gr_hw)

gr_pnt4 (polar gr_tmp (+ gr_gbr (* pi 0.5)) gr_hw)

gr_minx (min (car gr_pnt1) (car gr_pnt2) (car gr_pnt3) (car gr_pnt4))

gr_maxx (max (car gr_pnt1) (car gr_pnt2) (car gr_pnt3) (car gr_pnt4))

gr_miny (min (cadr gr_pnt1) (cadr gr_pnt2) (cadr gr_pnt3) (cadr gr_pnt4))

gr_maxy (max (cadr gr_pnt1) (cadr gr_pnt2) (cadr gr_pnt3) (cadr gr_pnt4))

gr_no (fix (/ gr_minx gr_int))

gr_fx (* (1+ gr_no) gr_int)

gr_no (/ gr_maxx gr_int)

gr_nof (fix gr_no)

)

(if (equal gr_no gr_nof 0.00000001)

(setq gr_no (-1 gr_nof))

(setq gr_no gr_nof)

)

(setq gr_lx (* gr_no gr_int)

gr_no (fix (/ gr_miny gr_int))

gr_fy (* (1+ gr_no) gr_int)

gr_no (/ gr_maxy gr_int)

gr_nof (fix gr_no)

)

(if (equal gr_no gr_nof 0.00000001)

(setq gr_no (-1 gr_nof))

(setq gr_no gr_nof)

)

(setq gr_ly (* gr_no gr_int)

gr_tx gr_fx

gr_ty gr_fy

gr_xlist nil gr_ylist nil

)

(while (

(setq gr_xlist (append gr_xlist (list gr_tx))

gr_tx (+ gr_tx gr_int)

)

)

(while (

(setq gr_ylist (append gr_ylist (list gr_ty))

gr_ty (+ gr_ty gr_int)

)

)

)

 

;;;-----------------------------------------------------------------------------

 

(defun gr_border ()

(command "-layer" "m" "grid_border" "c" gr_col "grid_border" "")

(command "-layer" "P" "N" "grid_border" "")

(setq gr_pl (list (cons 0 "LWPOLYLINE")

(cons 100 "AcDbEntity")

(cons 67 0)

(cons 100 "AcDbPolyline")

(cons 90 5)

(cons 70 128)

(cons 38 0)

(cons 10 gr_pnt1)

(cons 10 gr_pnt2)

(cons 10 gr_pnt3)

(cons 10 gr_pnt4)

(cons 10 gr_pnt1)

)

)

(entmake gr_pl)

)

(defun gr_edge (a b)

(setq gr_brg (angle a b))

(cond

((equal gr_brg (* pi 2.0) 0.0000048)

(setq gr_ebr nil

gr_nbr (* pi 1.5)

)

)

((equal gr_brg 0.0 0.0000048)

(setq gr_ebr nil

gr_nbr (* pi 1.5)

)

)

((equal gr_brg (* pi 0.5) 0.0000048)

(setq gr_ebr 0.0

gr_nbr nil

)

)

((equal gr_brg pi 0.0000048)

(setq gr_ebr nil

gr_nbr (* pi 0.5)

)

)

((equal gr_brg (* pi 1.5) 0.0000048)

(setq gr_ebr pi

gr_nbr nil

)

)

((and (> gr_brg 0.0) (

(setq gr_ebr 0.0

gr_nbr (* pi 1.5)

)

)

((and (> gr_brg (* pi 0.5)) (

(setq gr_ebr 0.0

gr_nbr (* pi 0.5)

)

)

((and (> gr_brg pi) (

(setq gr_ebr pi

gr_nbr (* pi 0.5)

)

)

((and (> gr_brg (* pi 1.5)) (

(setq gr_ebr pi

gr_nbr (* pi 1.5)

)

)

)

(setq gr_e1 a

gr_e2 b

)

(if gr_nbr

(progn

(foreach a gr_xlist

(setq gr_tx a

gr_t1xy (list gr_tx gr_miny 0.0)

gr_t2xy (list gr_tx gr_maxy 0.0)

gr_bxy (inters gr_e1 gr_e2 gr_t1xy gr_t2xy)

)

(if gr_bxy

(progn

(setq gr_cxy (polar gr_bxy gr_nbr (/ 20.0 gr_xp)))

(command "-layer" "m" "grid_ticks" "c" gr_col "grid_ticks" "")

(gr_makeline gr_bxy gr_cxy)

(setq gr_txt (strcat (rtos gr_tx 2 0) "E")

gr_txty (polar gr_bxy gr_nbr gr_txtxo)

gr_txtbr (* pi 0.5)

gr_tbr (+ gr_txtbr gr_vta)

)

(while (>= gr_tbr (* pi 2.0))

(setq gr_tbr (- gr_tbr (* pi 2.0)))

)

(cond

((= gr_ebr 0.0)

(setq gr_txtxy (polar gr_txty gr_ebr gr_txty1o))

)

((= gr_ebr pi)

(setq gr_txtxy (polar gr_txty gr_ebr gr_txty2o))

)

((and (> gr_tbr (* pi 0.5)) (

(setq gr_txtxy (polar gr_txty 0.0 gr_txty1o))

)

(T

(setq gr_txtxy (polar gr_txty pi gr_txty1o))

)

)

(if (= gr_nbr (* pi 0.5))

(progn

(if (and (> gr_tbr (* pi 0.5)) (

(setq gr_txtbr (+ gr_txtbr pi)

gr_hjust 2

)

(setq gr_hjust 0)

)

)

(progn

(if (and (> gr_tbr (* pi 0.5)) (

(setq gr_txtbr (+ gr_txtbr pi)

gr_hjust 0

)

(setq gr_hjust 2)

)

)

)

(command "-layer" "m" "grid_text" "c" gr_col "grid_text" "")

(gr_maketext)

)

)

)

)

)

(if gr_ebr

(progn

(foreach a gr_ylist

(setq gr_ty a

gr_t1xy (list gr_minx gr_ty 0.0)

gr_t2xy (list gr_maxx gr_ty 0.0)

gr_bxy (inters gr_e1 gr_e2 gr_t1xy gr_t2xy)

)

(if gr_bxy

(progn

(setq gr_cxy (polar gr_bxy gr_ebr gr_btick))

(command "-layer" "m" "grid_ticks" "c" gr_col "grid_ticks" "")

(gr_makeline gr_bxy gr_cxy)

(setq gr_txt (strcat (rtos gr_ty 2 0) "N")

gr_txty (polar gr_bxy gr_ebr gr_txtxo)

gr_txtbr 0.0

gr_tbr (+ gr_txtbr gr_vta)

)

(cond

((= gr_nbr (* pi 0.5))

(setq gr_txtxy (polar gr_txty gr_nbr gr_txty1o))

)

((= gr_nbr (* pi 1.5))

(setq gr_txtxy (polar gr_txty gr_nbr gr_txty2o))

)

((and (> gr_tbr (* pi 0.5)) (

(setq gr_txtxy (polar gr_txty (* pi 1.5) gr_txty1o))

)

(T

(setq gr_txtxy (polar gr_txty (* pi 0.5) gr_txty1o))

)

)

(if (= gr_ebr 0.0)

(progn

(if (and (> gr_tbr (* pi 0.5)) (

(setq gr_txtbr (+ gr_txtbr pi)

gr_hjust 2

)

(setq gr_hjust 0

)

)

)

(progn

(if (and (> gr_tbr (* pi 0.5)) (

(setq gr_txtbr (+ gr_txtbr pi)

gr_hjust 0

)

(setq gr_hjust 2

)

)

)

)

(command "-layer" "m" "grid_text" "c" gr_col "grid_text" "")

(gr_maketext)

)

)

)

)

)

)

 

;;;-----------------------------------------------------------------------------

 

(defun gr_ticks ()

(foreach a gr_xlist

(setq gr_tx a)

(foreach b gr_ylist

(setq gr_ty b

gr_txy (list gr_tx gr_ty)

gr_v1 nil gr_v2 nil gr_v3 nil gr_v4 nil

)

(gr_kink gr_pnt1 gr_pnt2)

(setq gr_v1 gr_v)

(gr_kink gr_pnt2 gr_pnt3)

(setq gr_v2 gr_v)

(gr_kink gr_pnt3 gr_pnt4)

(setq gr_v3 gr_v)

(gr_kink gr_pnt4 gr_pnt1)

(setq gr_v4 gr_v)

(if (and gr_v1 gr_v2 gr_v3 gr_v4)

(progn

(setq gr_dxy (polar gr_txy 0 (* gr_ctick 0.5))

gr_exy (polar gr_txy pi (* gr_ctick 0.5))

)

(command "-layer" "m" "grid_ticks" "c" gr_col "grid_ticks" "")

(gr_makeline gr_dxy gr_exy)

(setq gr_dxy (polar gr_txy (* pi 0.5) (* gr_ctick 0.5))

gr_exy (polar gr_txy (* pi 1.5) (* gr_ctick 0.5))

)

(gr_makeline gr_dxy gr_exy)

)

)

)

)

)

(defun gr_kink (x y)

(setq gr_brg1 (angle x y)

gr_brg2 (angle x gr_txy)

)

(if (or (and (= (- gr_brg1 gr_brg2) 0)) (

(setq gr_v T)

(setq gr_v nil)

)

)

(defun gr_makeline (a b)

(setq gr_linelist (list (cons 0 "LINE")

(cons 100 "AcDbEntity")

(cons 67 0)

(cons 100 "AcDbLine")

(cons 10 a)

(cons 11 b)

)

)

(entmake gr_linelist)

)

(defun gr_maketext ()

(setq gr_txtlist (list (cons 0 "TEXT")

(cons 100 "AcDbEntity")

(cons 67 0)

(cons 100 "AcDbText")

(cons 10 gr_txtxy)

(cons 40 gr_txthgt)

(cons 1 gr_txt)

(cons 50 gr_txtbr)

(cons 41 1.0)

(cons 7 "ISOCP")

(cons 72 gr_hjust)

(cons 11 gr_txtxy)

(cons 73 0)

)

)

(entmake gr_txtlist)

)

 

;;;-----------------------------------------------------------------------------

 

(defun c:VPGRID ()

(gr_verify)

(if (not (= gr_con "EXIT"))

(progn

(gr_select)

(gr_settings)

(gr_data)

(gr_del)

(gr_border)

(command "style" "isocp" "isocp.shx" "0.0" "1.0" "0" "n" "n")

(gr_edge gr_pnt1 gr_pnt2)

(gr_edge gr_pnt2 gr_pnt3)

(gr_edge gr_pnt3 gr_pnt4)

(gr_edge gr_pnt4 gr_pnt1)

(gr_ticks)

(command "-layer" "m" "0" "")

)

)

(princ)

)

Link to comment
Share on other sites

Seems to work OK here, the only problem I had is that I do not have "isocp.shx", so I changed that.

 

I have run it several times in a row (AutoCAD 2006)

 

What exactly is it doing wrong for you?

Link to comment
Share on other sites

We have figured it out, it seems that with the drawings at my work, theres something to do with the viewports that VPGrid hates, like it will do the border and the ticks, but not the text. so the method we figured out is that we change the ucs to world in modelspace, then go to paperspace, delete the old view port, create a new viewport and scale it, size it to our needs. Then run VPGrid and it worked perfectly. Seems an awfully long way of going about things though.

Link to comment
Share on other sites

  • 4 years later...

Hi,

I've just started using this lisp...can anyone tell me how to get the grid to be in the current layer rather than just default to "grid"

 

Thanks

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