help to improve lisp routine, (coordinate grid)

2025-11-04T15:36:40Z

Hello everyone.
I need to improve a Lisp routine. I've had this routine for a few years; a coworker gave it to me.
It's a Lisp routine for generating a coordinate grid from a selection of three points.
I need to eliminate the insertion of three points (vertices). I want to be able to select a closed polyline with a single click and generate the grid.
I want to keep the entire structure of the Lisp; I only want to change the vertex selection.
I should mention that I have no experience programming AutoLISP.
Please, if you can help me with this.

(defun strpto (aa / largo)
	(setq largo (strlen aa))
	(cond ((< largo 4) aa)
		((= largo 6) (strcat (substr aa 1 3) "." (substr aa 4 3)))
		((= largo 7) (strcat (substr aa 1 1) "." (substr aa 2 3) "." (substr aa 5 3)))
		(t aa)
	)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; DatosLineas : obtiene los coeficientes necesarios para determinar las
;;               rectas que definen el area a cuadricular. Las cuales son
;;               de la forma :  a*x + b*y = c
;;
(Defun DatosLineas (p1 p2 p3 p4)
   (setq a1 (- (cadr p2)(cadr p1))
         a2 (- (cadr p4)(cadr p2))
         a3 (- (cadr p3)(cadr p4))
         a4 (- (cadr p1)(cadr p3))
         b1 (- (car p1)(car p2))
         b2 (- (car p2)(car p4))
         b3 (- (car p4)(car p3))
         b4 (- (car p3)(car p1))
         c1 (- (* (car p1)(cadr p2))(* (car p2)(cadr p1)))
         c2 (- (* (car p2)(cadr p4))(* (car p4)(cadr p2)))
         c3 (- (* (car p4)(cadr p3))(* (car p3)(cadr p4)))
         c4 (- (* (car p3)(cadr p1))(* (car p1)(cadr p3)))
   )
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Punto de la recta dada por a,b,c dada la cordenada Y
;;
(Defun CalculaX (a b c y)
   (if (= 0.0 a)            ; no hay interseccion
       nil
       (/ (- c (* b y)) a)
   )
)

(Defun IntersecX ( / l lista)
   (setq l ()
         lista (list (CalculaX a1 b1 c1 startY) (CalculaX a2 b2 c2 startY)
                     (CalculaX a3 b3 c3 startY) (CalculaX a4 b4 c4 startY)
               )
   )
   (while (/= lista nil)
       (setq x (car lista))
       (if (and (/= x nil) (<= x maxX) (>= x minX))
           (setq l (append l (list x)))
       )
       (setq lista (cdr lista))
   )
   (list (min (car l)(cadr l)) (max (car l)(cadr l)))
)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Interseccion dada la cordenada X
;;
(Defun CalculaY (a b c x)
   (if (= 0.0 b)                 ; no hay interseccion
       nil
       (/ (- c (* a x)) b)
   )
)

(Defun IntersecY ( / l lista)
   (setq l ()
         lista (list (CalculaY a1 b1 c1 startX) (CalculaY a2 b2 c2 startX)
                     (CalculaY a3 b3 c3 startX) (CalculaY a4 b4 c4 startX)
               )
   )
   (while (/= lista nil)
       (setq y (car lista))
       (if (and (/= y nil) (<= y maxY) (>= y minY))
           (setq l (append l (list y)))
       )
       (setq lista (cdr lista))
   )
   (list (min (car l)(cadr l)) (max (car l)(cadr l)))
)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Programa principal
;;
(Defun c:grilla (/ p1 p2 p3 p4 paux incx incy l h n maldato base
                   alfa startX startY minX minY maxX maxY)
  (setvar "CMDECHO" 0)
  (command "_.undo" "_begin")
  (command "osnap" "off")
  (command "units" "2" "3" "3" "4" "e" "n")
  (command "LAYER" "M" "TO-GRILLA" "C" "8" "" "")
  (command "style" "romand" "romand" 0 1 0 "N" "N" "N")
  (setq incrx 0)
  (setq p1 (getpoint "\nIngrese un vertice de la region ")
        p2 (getpoint p1 "\nIngrese el otro vertice ")
  )
  (command "LINE" p1 p2 "")
  (if (> (cadr p1)(cadr p2))              ; siempre el p1 abajo
      (setq paux p1 p1 p2 p2 paux)
  )
  (setq p3 (getpoint p1 "\nIngrese punto para Ancho de la region ")
        l (distance p1 p3)        ; calculo de puntos p3 y p4 , paralelos
        alfa (angle p1 p2)        ; a p1 y p2 a distancia l
        alfa (+ (/ pi 2) alfa)
  )
  (if (> (car p3) (car p1))
         (setq alfa (+ pi alfa))
  )
  (if (= (car p1) (car p3))
      (if (< (* (- (car p2)(car p1)) (- (cadr p3)(cadr p1))) 0.0)
          (setq alfa (+ pi alfa))
      )
  )
  (setq p3 (list (+ (car p1)(* l (cos alfa))) (+ (cadr p1)(* l (sin alfa))))
        p4 (list (+ (car p2)(* l (cos alfa))) (+ (cadr p2)(* l (sin alfa))))
  )
  (command "LINE" p1 p2 p4 p3 "C")                 ; marco exterior
  (if (< (cadr p3) (cadr p1))                      ; punto1 siempre mas bajo
      (setq  paux p1 p1 p3 p3 paux paux p2 p2 p4 p4 paux)
  )
  (setq minX (min (car p2) (car p3))
        maxX (max (car p2) (car p3))
        minY (cadr p1)
        maxY (cadr p4)
        l (- maxX minX)
        h (- maxY minY)
        malDato 1
  )
  (while (= malDato 1)
         (setq incx (getreal "\nIncremento malla (m) :"))
         (if (< (abs (/ l 3)) incrx)
             (print "\nIncremento muy grande")
             (setq malDato 0)
         )
  )

  (setq incy incx)

  (setq n (fix (/ minX incx))             ; posiciones donde comenzar
        startX (* (1+ n) incx)            ; el cuadriculado
        n (fix (/ minY incy))             ; tanto en X como en Y
        startY (* (1+ n) incy)
        largoMax (max (distance p1 p3)    ; el largo maximo de la region
                      (distance p1 p4)
                 )
  )
  (if (< minX 0)
      (setq startX (- startX incx))
  )
  (if (< minY 0)
      (setq startY (- startY incy))
  )

  (setq ff     (getreal "\nIngrese Alto (mm) :"))
  (setq escala (getreal "\nEscala            : "))
  (setq alto (* (/ ff 1000) escala)) ; alto de los caracteres

  (setq angP1P3 (angle p1 p3)
        angP1P2 (angle p1 p2)
        angBorde (min (abs angP1P3)(abs angP1P2))
        dh (min (/ incx 40.0)(/ incy 40.0))
        x1 minX              ; el caso en que no hay que rotar
        x2 maxX
        y1 minY
        y2 maxY
  )
  (if (or (= (cadr p1)(cadr p2)) (= (car p1)(car p3)) (= (car p1)(car p2)))
      (setq revisar 0
            dl (min (/ incx 30.0)(/ incy 30.0))
      )
      (setq revisar 1
            dl (* (* alto (/ (cos angBorde)(sin angBorde))) 2)
      )

  )
  (DatosLineas p1 p2 p3 p4)
  (while (< startY maxY)
         (if (= revisar 1)
            (setq ptos (IntersecX)
                  x1 (car ptos)
                  x2 (cadr ptos)
            )
         )
         (setq coordY (rtos startY 2 0)
               coordY (strcat "N-" (strpto coordY))
         )
         (command "LINE" (list x1 startY) (list x2 startY) "")
         (cond ((> (- maxY startY) (* 2 alto))
                (command "TEXT" (list (+ x1 dl) (+ startY dh)) alto 0 coordY)
                (command "TEXT" "R" (list (- x2 dl) (+ startY dh)) alto 0 coordY)
               )
         )
         (setq startY (+ startY incy))
  )
  (while (< startX maxX)
         (if (= revisar 1)
             (setq ptos (IntersecY)
                   y1 (car ptos)
                   y2 (cadr ptos)
             )

         )
         (setq coordX (rtos startX 2 0)
               coordX (strcat "E-" (strpto coordX))
         )
         (command "LINE" (list startX y1) (list startX y2) "")
         (cond ((> (- startX minX) (* 2 alto))
                (command "TEXT" (list (- startX dh) (+ y1 dl)) alto 100 coordX)
                (command "TEXT" "R" (list (- startX dh) (- y2 dl)) alto 100 coordX)
               )
         )
         (setq startX (+ startX incx))
  )
  (if (> (distance p1 p3) (distance p1 p2))
      (setq alfa angP1P3)
      (setq alfa angP1P2)
  )
  (if (or (/= alfa pi) (/= alfa 0.0))
      (setq alfarad (* -1 alfa)
            alfa (* -1 (/ (* 200 alfa) pi))
            p4 (list (- (* (car p4)(cos alfarad)) (* (cadr p4) (sin alfarad)))
                     (+ (* (car p4)(sin alfarad)) (* (cadr p4) (cos alfarad)))
               )
            p1 (list (- (* (car p1)(cos alfarad)) (* (cadr p1)(sin alfarad)))
                     (+ (* (car p1)(sin alfarad)) (* (cadr p1)(cos alfarad)))
               )
            base (list 0.0 0.0)   ; el origen
       )
  )
    (command "_.undo" "end")
    (command "_.undo" "auto" "on")
;;  (command "units" "2" "3" "3" "4" "n" "y")
)

2025-11-04T21:58:58Z

6 hours ago, Omar ugarte said:

Hello everyone.
I need to improve a Lisp routine. I've had this routine for a few years; a coworker gave it to me.
It's a Lisp routine for generating a coordinate grid from a selection of three points.
I need to eliminate the insertion of three points (vertices). I want to be able to select a closed polyline with a single click and generate the grid.
I want to keep the entire structure of the Lisp; I only want to change the vertex selection.
I should mention that I have no experience programming AutoLISP.
Please, if you can help me with this.

(defun strpto (aa / largo)
	(setq largo (strlen aa))
	(cond ((< largo 4) aa)
		((= largo 6) (strcat (substr aa 1 3) "." (substr aa 4 3)))
		((= largo 7) (strcat (substr aa 1 1) "." (substr aa 2 3) "." (substr aa 5 3)))
		(t aa)
	)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; DatosLineas : obtiene los coeficientes necesarios para determinar las
;;               rectas que definen el area a cuadricular. Las cuales son
;;               de la forma :  a*x + b*y = c
;;
(Defun DatosLineas (p1 p2 p3 p4)
   (setq a1 (- (cadr p2)(cadr p1))
         a2 (- (cadr p4)(cadr p2))
         a3 (- (cadr p3)(cadr p4))
         a4 (- (cadr p1)(cadr p3))
         b1 (- (car p1)(car p2))
         b2 (- (car p2)(car p4))
         b3 (- (car p4)(car p3))
         b4 (- (car p3)(car p1))
         c1 (- (* (car p1)(cadr p2))(* (car p2)(cadr p1)))
         c2 (- (* (car p2)(cadr p4))(* (car p4)(cadr p2)))
         c3 (- (* (car p4)(cadr p3))(* (car p3)(cadr p4)))
         c4 (- (* (car p3)(cadr p1))(* (car p1)(cadr p3)))
   )
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Punto de la recta dada por a,b,c dada la cordenada Y
;;
(Defun CalculaX (a b c y)
   (if (= 0.0 a)            ; no hay interseccion
       nil
       (/ (- c (* b y)) a)
   )
)

(Defun IntersecX ( / l lista)
   (setq l ()
         lista (list (CalculaX a1 b1 c1 startY) (CalculaX a2 b2 c2 startY)
                     (CalculaX a3 b3 c3 startY) (CalculaX a4 b4 c4 startY)
               )
   )
   (while (/= lista nil)
       (setq x (car lista))
       (if (and (/= x nil) (<= x maxX) (>= x minX))
           (setq l (append l (list x)))
       )
       (setq lista (cdr lista))
   )
   (list (min (car l)(cadr l)) (max (car l)(cadr l)))
)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Interseccion dada la cordenada X
;;
(Defun CalculaY (a b c x)
   (if (= 0.0 b)                 ; no hay interseccion
       nil
       (/ (- c (* a x)) b)
   )
)

(Defun IntersecY ( / l lista)
   (setq l ()
         lista (list (CalculaY a1 b1 c1 startX) (CalculaY a2 b2 c2 startX)
                     (CalculaY a3 b3 c3 startX) (CalculaY a4 b4 c4 startX)
               )
   )
   (while (/= lista nil)
       (setq y (car lista))
       (if (and (/= y nil) (<= y maxY) (>= y minY))
           (setq l (append l (list y)))
       )
       (setq lista (cdr lista))
   )
   (list (min (car l)(cadr l)) (max (car l)(cadr l)))
)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Programa principal
;;
(Defun c:grilla (/ p1 p2 p3 p4 paux incx incy l h n maldato base
                   alfa startX startY minX minY maxX maxY)
  (setvar "CMDECHO" 0)
  (command "_.undo" "_begin")
  (command "osnap" "off")
  (command "units" "2" "3" "3" "4" "e" "n")
  (command "LAYER" "M" "TO-GRILLA" "C" "8" "" "")
  (command "style" "romand" "romand" 0 1 0 "N" "N" "N")
  (setq incrx 0)
  (setq p1 (getpoint "\nIngrese un vertice de la region ")
        p2 (getpoint p1 "\nIngrese el otro vertice ")
  )
  (command "LINE" p1 p2 "")
  (if (> (cadr p1)(cadr p2))              ; siempre el p1 abajo
      (setq paux p1 p1 p2 p2 paux)
  )
  (setq p3 (getpoint p1 "\nIngrese punto para Ancho de la region ")
        l (distance p1 p3)        ; calculo de puntos p3 y p4 , paralelos
        alfa (angle p1 p2)        ; a p1 y p2 a distancia l
        alfa (+ (/ pi 2) alfa)
  )
  (if (> (car p3) (car p1))
         (setq alfa (+ pi alfa))
  )
  (if (= (car p1) (car p3))
      (if (< (* (- (car p2)(car p1)) (- (cadr p3)(cadr p1))) 0.0)
          (setq alfa (+ pi alfa))
      )
  )
  (setq p3 (list (+ (car p1)(* l (cos alfa))) (+ (cadr p1)(* l (sin alfa))))
        p4 (list (+ (car p2)(* l (cos alfa))) (+ (cadr p2)(* l (sin alfa))))
  )
  (command "LINE" p1 p2 p4 p3 "C")                 ; marco exterior
  (if (< (cadr p3) (cadr p1))                      ; punto1 siempre mas bajo
      (setq  paux p1 p1 p3 p3 paux paux p2 p2 p4 p4 paux)
  )
  (setq minX (min (car p2) (car p3))
        maxX (max (car p2) (car p3))
        minY (cadr p1)
        maxY (cadr p4)
        l (- maxX minX)
        h (- maxY minY)
        malDato 1
  )
  (while (= malDato 1)
         (setq incx (getreal "\nIncremento malla (m) :"))
         (if (< (abs (/ l 3)) incrx)
             (print "\nIncremento muy grande")
             (setq malDato 0)
         )
  )

  (setq incy incx)

  (setq n (fix (/ minX incx))             ; posiciones donde comenzar
        startX (* (1+ n) incx)            ; el cuadriculado
        n (fix (/ minY incy))             ; tanto en X como en Y
        startY (* (1+ n) incy)
        largoMax (max (distance p1 p3)    ; el largo maximo de la region
                      (distance p1 p4)
                 )
  )
  (if (< minX 0)
      (setq startX (- startX incx))
  )
  (if (< minY 0)
      (setq startY (- startY incy))
  )

  (setq ff     (getreal "\nIngrese Alto (mm) :"))
  (setq escala (getreal "\nEscala            : "))
  (setq alto (* (/ ff 1000) escala)) ; alto de los caracteres

  (setq angP1P3 (angle p1 p3)
        angP1P2 (angle p1 p2)
        angBorde (min (abs angP1P3)(abs angP1P2))
        dh (min (/ incx 40.0)(/ incy 40.0))
        x1 minX              ; el caso en que no hay que rotar
        x2 maxX
        y1 minY
        y2 maxY
  )
  (if (or (= (cadr p1)(cadr p2)) (= (car p1)(car p3)) (= (car p1)(car p2)))
      (setq revisar 0
            dl (min (/ incx 30.0)(/ incy 30.0))
      )
      (setq revisar 1
            dl (* (* alto (/ (cos angBorde)(sin angBorde))) 2)
      )

  )
  (DatosLineas p1 p2 p3 p4)
  (while (< startY maxY)
         (if (= revisar 1)
            (setq ptos (IntersecX)
                  x1 (car ptos)
                  x2 (cadr ptos)
            )
         )
         (setq coordY (rtos startY 2 0)
               coordY (strcat "N-" (strpto coordY))
         )
         (command "LINE" (list x1 startY) (list x2 startY) "")
         (cond ((> (- maxY startY) (* 2 alto))
                (command "TEXT" (list (+ x1 dl) (+ startY dh)) alto 0 coordY)
                (command "TEXT" "R" (list (- x2 dl) (+ startY dh)) alto 0 coordY)
               )
         )
         (setq startY (+ startY incy))
  )
  (while (< startX maxX)
         (if (= revisar 1)
             (setq ptos (IntersecY)
                   y1 (car ptos)
                   y2 (cadr ptos)
             )

         )
         (setq coordX (rtos startX 2 0)
               coordX (strcat "E-" (strpto coordX))
         )
         (command "LINE" (list startX y1) (list startX y2) "")
         (cond ((> (- startX minX) (* 2 alto))
                (command "TEXT" (list (- startX dh) (+ y1 dl)) alto 100 coordX)
                (command "TEXT" "R" (list (- startX dh) (- y2 dl)) alto 100 coordX)
               )
         )
         (setq startX (+ startX incx))
  )
  (if (> (distance p1 p3) (distance p1 p2))
      (setq alfa angP1P3)
      (setq alfa angP1P2)
  )
  (if (or (/= alfa pi) (/= alfa 0.0))
      (setq alfarad (* -1 alfa)
            alfa (* -1 (/ (* 200 alfa) pi))
            p4 (list (- (* (car p4)(cos alfarad)) (* (cadr p4) (sin alfarad)))
                     (+ (* (car p4)(sin alfarad)) (* (cadr p4) (cos alfarad)))
               )
            p1 (list (- (* (car p1)(cos alfarad)) (* (cadr p1)(sin alfarad)))
                     (+ (* (car p1)(sin alfarad)) (* (cadr p1)(cos alfarad)))
               )
            base (list 0.0 0.0)   ; el origen
       )
  )
    (command "_.undo" "end")
    (command "_.undo" "auto" "on")
;;  (command "units" "2" "3" "3" "4" "n" "y")
)

Hi Omar. Bienvenido

Try this

(defun strpto (aa / largo)
  (setq largo (strlen aa))
  (cond	((< largo 4) aa)
	((= largo 6) (strcat (substr aa 1 3) "." (substr aa 4 3)))
	((= largo 7)
	 (strcat (substr aa 1 1)
		 "."
		 (substr aa 2 3)
		 "."
		 (substr aa 5 3)
	 )
	)
	(t aa)
  )
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; DatosLineas : obtiene los coeficientes necesarios para determinar las
;;               rectas que definen el area a cuadricular. Las cuales son
;;               de la forma :  a*x + b*y = c
;;
(Defun DatosLineas (p1 p2 p3 p4)
  (setq	a1 (- (cadr p2) (cadr p1))
	a2 (- (cadr p4) (cadr p2))
	a3 (- (cadr p3) (cadr p4))
	a4 (- (cadr p1) (cadr p3))
	b1 (- (car p1) (car p2))
	b2 (- (car p2) (car p4))
	b3 (- (car p4) (car p3))
	b4 (- (car p3) (car p1))
	c1 (- (* (car p1) (cadr p2)) (* (car p2) (cadr p1)))
	c2 (- (* (car p2) (cadr p4)) (* (car p4) (cadr p2)))
	c3 (- (* (car p4) (cadr p3)) (* (car p3) (cadr p4)))
	c4 (- (* (car p3) (cadr p1)) (* (car p1) (cadr p3)))
  )
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Punto de la recta dada por a,b,c dada la cordenada Y
;;
(Defun CalculaX	(a b c y)
  (if (= 0.0 a)				; no hay interseccion
    nil
    (/ (- c (* b y)) a)
  )
)

(Defun IntersecX (/ l lista)
  (setq	l     ()
	lista (list (CalculaX a1 b1 c1 startY)
		    (CalculaX a2 b2 c2 startY)
		    (CalculaX a3 b3 c3 startY)
		    (CalculaX a4 b4 c4 startY)
	      )
  )
  (while (/= lista nil)
    (setq x (car lista))
    (if	(and (/= x nil) (<= x maxX) (>= x minX))
      (setq l (append l (list x)))
    )
    (setq lista (cdr lista))
  )
  (list (min (car l) (cadr l)) (max (car l) (cadr l)))
)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Interseccion dada la cordenada X
;;
(Defun CalculaY	(a b c x)
  (if (= 0.0 b)				; no hay interseccion
    nil
    (/ (- c (* a x)) b)
  )
)

(Defun IntersecY (/ l lista)
  (setq	l     ()
	lista (list (CalculaY a1 b1 c1 startX)
		    (CalculaY a2 b2 c2 startX)
		    (CalculaY a3 b3 c3 startX)
		    (CalculaY a4 b4 c4 startX)
	      )
  )
  (while (/= lista nil)
    (setq y (car lista))
    (if	(and (/= y nil) (<= y maxY) (>= y minY))
      (setq l (append l (list y)))
    )
    (setq lista (cdr lista))
  )
  (list (min (car l) (cadr l)) (max (car l) (cadr l)))
)

(defun dameEsquinas (e / le lp)
  (if (= (cdr (assoc 0 (setq le (entget e)))) "LWPOLYLINE")
    (foreach l le
      (if (= (car l) 10)
	(setq lp (cons (cdr l) lp))
      )
    )
  )
  (if lp (vl-sort lp '(lambda(a b) (< (car a) (car b)))))
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Programa principal
;;
(Defun c:grilla	(/	p1     p2     p3     p4	    paux   incx
		 incy	l      h      n	     maldato	   base
		 alfa	startX startY minX   minY   maxX   maxY
		)
  (setvar "CMDECHO" 0)
  (command "_.undo" "_begin")
  (command "osnap" "off")
  (command "units" "2" "3" "3" "4" "e" "n")
  (command "LAYER" "M" "TO-GRILLA" "C" "8" "" "")
  (command "style" "romand" "romand" 0 1 0 "N" "N" "N")
  (setq incrx 0)
;;;  (setq	p1 (getpoint "\nIngrese un vertice de la region ")
;;;	p2 (getpoint p1 "\nIngrese el otro vertice ")
;;;  )
;;;  (command "LINE" p1 p2 "")
  (if (not (setq e (car (entsel "\nSelecciona el marco para la grilla..."))))
    (exit)
  )
  (setq l (dameEsquinas e)
	p1 (car l)
	p2 (cadr l)
	p3 (caddr l)
	l nil
  )
  (if (> (cadr p1) (cadr p2))		; siempre el p1 abajo
    (setq paux p1
	  p1 p2
	  p2 paux
    )
  )
  (setq	p3   (getpoint p1 "\nIngrese punto para Ancho de la region ")
	l    (distance p1 p3)		; calculo de puntos p3 y p4 , paralelos
	alfa (angle p1 p2)		; a p1 y p2 a distancia l
	alfa (+ (/ pi 2) alfa)
  )
  (if (> (car p3) (car p1))
    (setq alfa (+ pi alfa))
  )
  (if (= (car p1) (car p3))
    (if	(< (* (- (car p2) (car p1)) (- (cadr p3) (cadr p1))) 0.0)
      (setq alfa (+ pi alfa))
    )
  )
  (setq	p3 (list (+ (car p1) (* l (cos alfa)))
		 (+ (cadr p1) (* l (sin alfa)))
	   )
	p4 (list (+ (car p2) (* l (cos alfa)))
		 (+ (cadr p2) (* l (sin alfa)))
	   )
  )
  (command "LINE" p1 p2 p4 p3 "C")	; marco exterior
  (if (< (cadr p3) (cadr p1))		; punto1 siempre mas bajo
    (setq paux p1
	  p1 p3
	  p3 paux
	  paux p2
	  p2 p4
	  p4 paux
    )
  )
  (setq	minX	(min (car p2) (car p3))
	maxX	(max (car p2) (car p3))
	minY	(cadr p1)
	maxY	(cadr p4)
	l	(- maxX minX)
	h	(- maxY minY)
	malDato	1
  )
  (while (= malDato 1)
    (setq incx (getreal "\nIncremento malla (m) :"))
    (if	(< (abs (/ l 3)) incrx)
      (print "\nIncremento muy grande")
      (setq malDato 0)
    )
  )

  (setq incy incx)

  (setq	n	 (fix (/ minX incx))	; posiciones donde comenzar
	startX	 (* (1+ n) incx)	; el cuadriculado
	n	 (fix (/ minY incy))	; tanto en X como en Y
	startY	 (* (1+ n) incy)
	largoMax (max (distance p1 p3)	; el largo maximo de la region
		      (distance p1 p4)
		 )
  )
  (if (< minX 0)
    (setq startX (- startX incx))
  )
  (if (< minY 0)
    (setq startY (- startY incy))
  )

  (setq ff (getreal "\nIngrese Alto (mm) :"))
  (setq escala (getreal "\nEscala            : "))
  (setq alto (* (/ ff 1000) escala))	; alto de los caracteres

  (setq	angP1P3	 (angle p1 p3)
	angP1P2	 (angle p1 p2)
	angBorde (min (abs angP1P3) (abs angP1P2))
	dh	 (min (/ incx 40.0) (/ incy 40.0))
	x1	 minX			; el caso en que no hay que rotar
	x2	 maxX
	y1	 minY
	y2	 maxY
  )
  (if (or (= (cadr p1) (cadr p2))
	  (= (car p1) (car p3))
	  (= (car p1) (car p2))
      )
    (setq revisar 0
	  dl	  (min (/ incx 30.0) (/ incy 30.0))
    )
    (setq revisar 1
	  dl	  (* (* alto (/ (cos angBorde) (sin angBorde))) 2)
    )

  )
  (DatosLineas p1 p2 p3 p4)
  (while (< startY maxY)
    (if	(= revisar 1)
      (setq ptos (IntersecX)
	    x1	 (car ptos)
	    x2	 (cadr ptos)
      )
    )
    (setq coordY (rtos startY 2 0)
	  coordY (strcat "N-" (strpto coordY))
    )
    (command "LINE" (list x1 startY) (list x2 startY) "")
    (cond ((> (- maxY startY) (* 2 alto))
	   (command "TEXT"
		    (list (+ x1 dl) (+ startY dh))
		    alto
		    0
		    coordY
	   )
	   (command "TEXT"
		    "R"
		    (list (- x2 dl) (+ startY dh))
		    alto
		    0
		    coordY
	   )
	  )
    )
    (setq startY (+ startY incy))
  )
  (while (< startX maxX)
    (if	(= revisar 1)
      (setq ptos (IntersecY)
	    y1	 (car ptos)
	    y2	 (cadr ptos)
      )

    )
    (setq coordX (rtos startX 2 0)
	  coordX (strcat "E-" (strpto coordX))
    )
    (command "LINE" (list startX y1) (list startX y2) "")
    (cond ((> (- startX minX) (* 2 alto))
	   (command "TEXT"
		    (list (- startX dh) (+ y1 dl))
		    alto
		    100
		    coordX
	   )
	   (command "TEXT"
		    "R"
		    (list (- startX dh) (- y2 dl))
		    alto
		    100
		    coordX
	   )
	  )
    )
    (setq startX (+ startX incx))
  )
  (if (> (distance p1 p3) (distance p1 p2))
    (setq alfa angP1P3)
    (setq alfa angP1P2)
  )
  (if (or (/= alfa pi) (/= alfa 0.0))
    (setq alfarad (* -1 alfa)
	  alfa	  (* -1 (/ (* 200 alfa) pi))
	  p4	  (list	(- (* (car p4) (cos alfarad)) (* (cadr p4) (sin alfarad)))
			(+ (* (car p4) (sin alfarad)) (* (cadr p4) (cos alfarad)))
		  )
	  p1	  (list	(- (* (car p1) (cos alfarad)) (* (cadr p1) (sin alfarad)))
			(+ (* (car p1) (sin alfarad)) (* (cadr p1) (cos alfarad)))
		  )
	  base	  (list 0.0 0.0)	; el origen
    )
  )
  (command "_.undo" "end")
  (command "_.undo" "auto" "on")
  ;;  (command "units" "2" "3" "3" "4" "n" "y")
)

The "command" calls in your code are designed for an English version of AutoCAD, and mine is in Spanish.
For this reason, and due to lack of time, I haven't tested the code sufficiently.

Try it yourself and then comment on the results.

2025-11-05T00:11:26Z

Could you post a sample drawing of what you would use this on and what your looking for. Rather then picking points for the grid you could do a selection and run the bounding box

(defun C:foo ()
  (if (setq SS (ssget))
    (BBOX)
    (command "_.RECTANG" LL UR)
    (prompt (strcat "El rectángulo mide: " (car L&W) " x " (cadr L&W)))
  )
  (princ)
)
;;----------------------------------------------------------------------------;;
;; Length and Width of a Selection 
(defun BBox (/ ptslst)
  (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
    (vla-getboundingbox (vlax-ename->vla-object ent) 'minpt 'maxpt)
    (setq ptslst (cons (vlax-safearray->list minpt) ptslst)
          ptslst (cons (vlax-safearray->list maxpt) ptslst)
    )
  )
  (setq LL (apply 'mapcar (cons 'min ptslst))
        UR (apply 'mapcar (cons 'max ptslst))
        L&W (mapcar '- UR LL)
  )
  (princ)
)

Sign In

help to improve lisp routine, (coordinate grid)

Recommended Posts

Omar ugarte

GLAVCVS

mhupp

Join the conversation

Tutorials

Forums

Activity