Leaderboard

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.

I also deleted your posts in the old thread you resurrected, no need for having a conversation in two separate threads.

Where did you get the UK version? This was originally Australian and USA, it was modified in 2017 for UK by www.stylemarkdesigns.co.uk (that website is no longer active). I use the original AL's Steel Mill, the Wisey's I have was last modified in 2013, that update is missing in your version. My best guess would be there is some incomplete UK data, you should look at the Aus and USA supplied data and compare.