RUTINA CREA GRILLA EN VIEWPORT

Hola encontre esta rutina excelente en internet y quisiera modificarla ya que genera unas cruces en el centro y solo necesitaria los extremos con su linea base sin el N y E y que pueda escoger poner la coordenada izquierda inferior, aca les dejo la rutina:

Código:

;; vpgrid.lsp
;;places a grid in a Viewport with co-ordinates.

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

(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 <R>: "))
(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 <F>: "))


)
;;;-----------------------------------------------------------------------------

(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 (<= gr_tx gr_lx)
(setq gr_xlist (append gr_xlist (list gr_tx))
gr_tx (+ gr_tx gr_int)
)
)
(while (<= gr_ty gr_ly)
(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) (< gr_brg (* pi 0.5)))
(setq gr_ebr 0.0
gr_nbr (* pi 1.5)
)
)
((and (> gr_brg (* pi 0.5)) (< gr_brg pi))
(setq gr_ebr 0.0
gr_nbr (* pi 0.5)
)
)
((and (> gr_brg pi) (< gr_brg (* pi 1.5)))
(setq gr_ebr pi
gr_nbr (* pi 0.5)
)
)
((and (> gr_brg (* pi 1.5)) (< gr_brg (* pi 2.0)))
(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 "E" (rtos gr_tx 2 0) )
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)) (<= gr_tbr (* pi 1.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)) (<= gr_tbr (* pi 1.5)))
(setq gr_txtbr (+ gr_txtbr pi)
gr_hjust 2
)
(setq gr_hjust 0)
)
)
(progn
(if (and (> gr_tbr (* pi 0.5)) (<= gr_tbr (* pi 1.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 "N" (rtos gr_ty 2 0) )
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)) (<= gr_tbr (* pi 1.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)) (<= gr_tbr (* pi 1.5)))
(setq gr_txtbr (+ gr_txtbr pi)
gr_hjust 2
)
(setq gr_hjust 0
)
)
)
(progn
(if (and (> gr_tbr (* pi 0.5)) (<= gr_tbr (* pi 1.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) pi) (>= (- gr_brg1 gr_brg2) 0)) (<= (- gr_brg1 gr_brg2) (- 0 pi)))
(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:VPGRID2 ()
(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)
)

Por favor sube o envía el DWG donde quieres aplicar el LISP.

mi correo

devitg en gmail