coto5001 Posted November 9, 2022 Posted November 9, 2022 Estimados, buenas tardes. Estoy iniciando en el tema lisp, quisiera su apoyo para modificar el estilo de texto de la siguiente rutina, (esta rutina genera una grilla de coordendas este y norte) he logrado que me genere el texto en estilo standar y sin separadores de miles, deseo que el texto quede en estilo romans factor 0.85 y con separadores de miles. Saludos y gracias (defun c:xy () (princ "Inserte Margenes") (if (and hor vert (setq p1 (getpoint "\nEsquina Superior Izquierda:")) ) (setq p2 (getcorner p1 "\nEsquina Inferior Derecha:")) ) (setq hor (getreal "\nIntervalo Horizontal" ));espacio horizontal (setq vert (getreal "\nIntervalo Vertical" )) ;espacio vertical (setq htxt (getreal "\nAltura de Texto" )) ;h texto (setq prec (getint "\nPrecision" ));precision (if (and p1 p2) (progn (mlayer "Grilla" nil nil T) ;si no existe cria layer Grilla ;------------TXT X------------------------------ (setq xi (* hor (fix (/ (+ (* 2 htxt)(car p1)) hor)))) (if (< xi (+ (car p1) (* 2 htxt))) (setq xi (+ hor xi))) (setq n (fix (/ (- (car p2) xi) hor))) (repeat (1+ n) ;TEXTO ARRIBA (setq ptsup (trans (list xi (cadr p1) 0) 1 0) ptinf (trans (list xi (cadr p2) 0) 1 0) ang (angle ptinf ptsup) ) (setq s (strcat " E " (rtos xi 2 prec) " ")) (entmake (list '(0 . "TEXT") ;tipo de entidad '(8 . "Grilla") ;no layer Grilla (cons 1 s ) ;texto (cons 40 htxt) ;alturA (cons 50 ang) ;angulo en rad 90§ '(72 . 2) ;just Horizontal centrar 1 '(73 . 1) ;just Vertical (cons 10 ptsup) (cons 11 ptsup) ) ) ;TEXTO ABAJO (entmake (list '(0 . "TEXT") ;tipo de entidad '(8 . "Grilla") ;no layer Grilla (cons 1 s) ;texto (cons 40 htxt) ;altura (cons 50 ang) ;angulo en rad 90§ '(72 . 0) ;just Horizontal centrar 1 '(73 . 1) ;just Vertical (cons 10 ptinf) (cons 11 ptinf) ) ) (entmake (list '(0 . "LINE") '(8 . "Grilla") ;no layer Grilla (cons 10 ptsup) (cons 11 ptinf) ;dibuja linea '(210 0 0 1) ) ) (setq xi (+ hor xi)) );repeat n+1 ;------------TXT Y------------------------------ (setq yi (* vert (fix (/ (- (cadr p1) (* 2 htxt)) vert)))) (if (> yi (- (cadr p1)(* 2 htxt))) (setq yi (- yi vert))) (setq n (fix (/ (- yi (cadr p2)) vert))) (repeat (1+ n) ;TEXTO IZQUIERDA (setq ptesq (trans (list (car p1) yi 0) 1 0) ptdta (trans (list (car p2) yi 0) 1 0) ang (angle ptesq ptdta) ) (setq s (strcat " N " (rtos yi 2 prec) " ")) (entmake (list '(0 . "TEXT") ;tipo de entidad '(8 . "Grilla") ;no layer Grilla (cons 1 s) ;texto (cons 40 htxt) ;altura (cons 50 ang) ;angulo en rad 90§ '(72 . 0) ;just Horizontal dta '(73 . 1) ;just Vertical acima (cons 10 ptesq) (cons 11 ptesq) ) ) ;TEXTO DERECHA (entmake (list '(0 . "TEXT") ;tipo de entidad '(8 . "Grilla") ;no layer Grilla (cons 1 s) ;texto (cons 40 htxt) ;altura (cons 50 ang) ;angulo n rad 0§ '(72 . 2) ;just Horizontal esq '(73 . 1) ;just Vertical acima (cons 10 ptdta) (cons 11 ptdta) ) ) ;LINEA (entmake (list '(0 . "LINE") '(8 . "Grilla") ;no layer Grilla (cons 10 ptesq) (cons 11 ptdta) ;dibuja linea '(210 0 0 1) ) ) (setq yi (- yi vert)) ;para linea arriba );repeat n+1 );progn );if );defun txttram Quote
mhupp Posted November 10, 2022 Posted November 10, 2022 El texto creado por entmake usa el estilo de texto actual si no se llama. Debe crear un estilo de texto con fuente romans y configurarlo como actual o agregar '(7. "stylename") a entmake. Este es un sitio en inglés, por lo que es posible que no obtenga muchas respuestas si publica en español. Quote
Tsuky Posted November 10, 2022 Posted November 10, 2022 Mira la solicitud de Edwin.Saez para ver si alguna propuesta te puede ir bien entre las variantes o adaptaciones propuestas. Yo soy CADaSchtroumpf (Tsuky aquí) en los foros de Autodesk Quote
ronjonp Posted November 10, 2022 Posted November 10, 2022 (edited) Prueba este ejemplo. No lo probé. Bienvenido al foro! (defun c:xy (/ _maketext ang hor htxt n p1 p2 prec ptdta ptesq ptinf ptsup s vert xi yi) ; <- Localize variables ;; Create a function to reuse ( Crear una función para reutilizar ) (defun _maketext (s htxt ang ptsup /) (entmake (list '(0 . "TEXT") ;tipo de entidad '(8 . "Grilla") ;no layer Grilla (cons 1 s) ;texto (cons 40 htxt) ;alturA (cons 50 ang) ;angulo en rad 90§ '(7 . "Romans") '(72 . 2) ;just Horizontal centrar 1 '(73 . 1) ;just Vertical (cons 10 ptsup) (cons 11 ptsup) ) ) ) (princ "Inserte Margenes") (if (and (setq hor (getreal "\nIntervalo Horizontal")) (setq vert (getreal "\nIntervalo Vertical")) (setq p1 (getpoint "\nEsquina Superior Izquierda:")) (setq p2 (getcorner p1 "\nEsquina Inferior Derecha:")) (setq htxt (getreal "\nAltura de Texto")) (setq prec (getint "\nPrecision")) ) (setq p2 (getcorner p1 "\nEsquina Inferior Derecha:")) ) (setq hor (getreal "\nIntervalo Horizontal")) ;espacio horizontal (setq vert (getreal "\nIntervalo Vertical")) ;espacio vertical (setq htxt (getreal "\nAltura de Texto")) ;h texto (setq prec (getint "\nPrecision")) ;precision (if (and (setq hor (getreal "\nIntervalo Horizontal")) (setq vert (getreal "\nIntervalo Vertical")) (setq p1 (getpoint "\nEsquina Superior Izquierda:")) (setq p2 (getcorner p1 "\nEsquina Inferior Derecha:")) (setq htxt (getreal "\nAltura de Texto")) (setq prec (getint "\nPrecision")) ) (progn ;; Make the romans text style ( Hacer el estilo de texto romanos ) (entmake '((0 . "STYLE") (100 . "AcDbSymbolTableRecord") (100 . "AcDbTextStyleTableRecord") (2 . "Romans") (70 . 0) (40 . 0.0) (41 . 0.85) (50 . 0.0) (71 . 0) (42 . 0.125) (3 . "Romans.shx") (4 . "") ) ) (mlayer "Grilla" nil nil t) ;si no existe cria layer Grilla ;------------TXT X------------------------------ (setq xi (* hor (fix (/ (+ (* 2 htxt) (car p1)) hor)))) (if (< xi (+ (car p1) (* 2 htxt))) (setq xi (+ hor xi)) ) (setq n (fix (/ (- (car p2) xi) hor))) (repeat (1+ n) ;TEXTO ARRIBA (setq ptsup (trans (list xi (cadr p1) 0) 1 0) ptinf (trans (list xi (cadr p2) 0) 1 0) ang (angle ptinf ptsup) ) (setq s (strcat " E " (rtos xi 2 prec) " ")) (_maketext s htxt ang ptsup) ;TEXTO ABAJO (_maketext s htxt ang ptinf) (entmake (list '(0 . "LINE") '(8 . "Grilla") ;no layer Grilla (cons 10 ptsup) (cons 11 ptinf) ;dibuja linea '(210 0 0 1) ) ) (setq xi (+ hor xi)) ) ;repeat n+1 ;------------TXT Y------------------------------ (setq yi (* vert (fix (/ (- (cadr p1) (* 2 htxt)) vert)))) (if (> yi (- (cadr p1) (* 2 htxt))) (setq yi (- yi vert)) ) (setq n (fix (/ (- yi (cadr p2)) vert))) (repeat (1+ n) ;TEXTO IZQUIERDA (setq ptesq (trans (list (car p1) yi 0) 1 0) ptdta (trans (list (car p2) yi 0) 1 0) ang (angle ptesq ptdta) ) (setq s (strcat " N " (rtos yi 2 prec) " ")) (_maketext s htxt ang ptesq) (_maketext s htxt ang ptdta) ;LINEA (entmake (list '(0 . "LINE") '(8 . "Grilla") ;no layer Grilla (cons 10 ptesq) (cons 11 ptdta) ;dibuja linea '(210 0 0 1) ) ) (setq yi (- yi vert)) ;para linea arriba ) ;repeat n+1 ) ;progn ) (princ) ) ;defun txttram Por cierto, no hablo español pero puedo usar el traductor de Google. Edited November 10, 2022 by ronjonp Quote
BIGAL Posted November 10, 2022 Posted November 10, 2022 (edited) Maybe this. 20mm grids to and a twisted view. Not free but very cheap Edited November 10, 2022 by BIGAL Quote
Recommended Posts
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.