Es posible crear un patron de sombreado dentro del archivo lsp ?

Me suena haber leido que se podia escribir los codigos de patrones de sombreado o de tipos de linea en la misma rutina pero ahora no encuentro nada.

arielbnvo escribió:Me suena haber leido que se podia escribir los codigos de patrones de sombreado o de tipos de linea en la misma rutina pero ahora no encuentro nada.

No se si este fichero te servira.
Tocando un sombreado transfiere su codigo a un fichero.PAT

Código:

 ; Tocando un sombreado transfiere su codigo a un fichero.PAT
 ; por Vladimir Nesterovsky)
;;;================================================================================================
(defun mxv (m v) (mapcar '(lambda (r) (apply '+ (mapcar '* r v))) m))
;;;================================================================================================
(defun c:model_hatch (/ err zindim ent elst vec rot scale nb ang n first)
  (defun err (msg)
    (if (= msg "Funcion cancelada")
      (princ)
      (princ (strcat "\nError: " msg))
    )
    (setvar "dimzin" zindim)
    (setq *error* m:err
          m:err nil
    )
    (princ)
  )
  (setq m:err *error*
        *error* err
  )
  (while (not (setq ent (entsel "\nSelecione el Hatch: "))))
  (setq elst  (entget (car ent))
        zindim (getvar "dimzin")
  )
  (if (= (getvar "measurement") 1)
    (setvar "dimzin" 8)
    (setvar "dimzin" 12)
  )
  (if (= (cdr (assoc 0 elst)) "HATCH")
    (progn
      (setq descr (strcat "\n*" (cdr (assoc 2 elst)))
            rot  (cdr (assoc 52 elst))
            scale (/ 1.0 (cdr (assoc 41 elst)))
            nb    (cdr (assoc 78 elst))
            first t
      )
      (repeat nb
        (setq elst  (member (assoc 53 elst) elst)
              ang  (cdar elst)
              descr (strcat descr "\n" (angtos (- ang rot) 0 14))
              elst  (cdr elst)
        )
        (repeat 2
          (setq vec ((lambda (a)
                      (mxv (list (list (cos a) (- (sin a)) 0.0)
                                  (list (sin a) (cos a) 0.0)
                                  '(0.0 0.0 1.0)
                            )
                            (list (* scale (cdar elst)) (* scale (cdadr elst)) 0.0)
                      )
                    )
                      (if first
                        (- rot)
                        (- ang)
                      )
                    )
          )
          (setq first nil)
          (setq descr (strcat descr "," (rtos (car vec) 2 14) "," (rtos (cadr vec) 2 14))
                elst  (cddr elst)
          )
        )
        (repeat (cdr (assoc 79 elst))
          (setq elst (cdr elst))
          (setq descr (strcat descr "," (rtos (* scale (cdar elst)) 2 14)))
        )
        (setq first t)
      )
      (textscr)
      (princ descr)
      (initget "Si No")
      (if (and (= (getkword "\nGrabar en un Archivo ? [Si/No] <No>: ") "Si")
              (setq file (getfiled "Seleccione un archivo"
                                    (if (= (getvar "measurement") 1)
                                      (findfile "acadiso.pat")
                                      (findfile "acad.pat")
                                    )
                                    "pat"
                                    33
                          )
              )
          )
        (progn (setq file (open file "a")) (princ (strcat (substr descr 2) "\n") file) (close file))
      )
      (graphscr)
    )
    (t (prompt "\nLa entidad no es un Hatch."))
  )
  (setvar "dimzin" zindim)
  (setq *error* m:err
        m:err nil
  )
  (princ)
)
;;;================================================================================================


Saludos

Dominguez escribió:

arielbnvo escribió:Me suena haber leido que se podia escribir los codigos de patrones de sombreado o de tipos de linea en la misma rutina pero ahora no encuentro nada.

No se si este fichero te servira.
Tocando un sombreado transfiere su codigo a un fichero.PAT

Código:

 ; Tocando un sombreado transfiere su codigo a un fichero.PAT
 ; por Vladimir Nesterovsky)
;;;================================================================================================
(defun mxv (m v) (mapcar '(lambda (r) (apply '+ (mapcar '* r v))) m))
;;;================================================================================================
(defun c:model_hatch (/ err zindim ent elst vec rot scale nb ang n first)
  (defun err (msg)
    (if (= msg "Funcion cancelada")
      (princ)
      (princ (strcat "\nError: " msg))
    )
    (setvar "dimzin" zindim)
    (setq *error* m:err
          m:err nil
    )
    (princ)
  )
  (setq m:err *error*
        *error* err
  )
  (while (not (setq ent (entsel "\nSelecione el Hatch: "))))
  (setq elst   (entget (car ent))
        zindim (getvar "dimzin")
  )
  (if (= (getvar "measurement") 1)
    (setvar "dimzin" 8)
    (setvar "dimzin" 12)
  )
  (if (= (cdr (assoc 0 elst)) "HATCH")
    (progn
      (setq descr (strcat "\n*" (cdr (assoc 2 elst)))
            rot   (cdr (assoc 52 elst))
            scale (/ 1.0 (cdr (assoc 41 elst)))
            nb    (cdr (assoc 78 elst))
            first t
      )
      (repeat nb
        (setq elst  (member (assoc 53 elst) elst)
              ang   (cdar elst)
              descr (strcat descr "\n" (angtos (- ang rot) 0 14))
              elst  (cdr elst)
        )
        (repeat 2
          (setq vec ((lambda (a)
                       (mxv (list (list (cos a) (- (sin a)) 0.0)
                                  (list (sin a) (cos a) 0.0)
                                  '(0.0 0.0 1.0)
                            )
                            (list (* scale (cdar elst)) (* scale (cdadr elst)) 0.0)
                       )
                     )
                      (if first
                        (- rot)
                        (- ang)
                      )
                    )
          )
          (setq first nil)
          (setq descr (strcat descr "," (rtos (car vec) 2 14) "," (rtos (cadr vec) 2 14))
                elst  (cddr elst)
          )
        )
        (repeat (cdr (assoc 79 elst))
          (setq elst (cdr elst))
          (setq descr (strcat descr "," (rtos (* scale (cdar elst)) 2 14)))
        )
        (setq first t)
      )
      (textscr)
      (princ descr)
      (initget "Si No")
      (if (and (= (getkword "\nGrabar en un Archivo ? [Si/No] <No>: ") "Si")
               (setq file (getfiled "Seleccione un archivo"
                                    (if (= (getvar "measurement") 1)
                                      (findfile "acadiso.pat")
                                      (findfile "acad.pat")
                                    )
                                    "pat"
                                    33
                          )
               )
          )
        (progn (setq file (open file "a")) (princ (strcat (substr descr 2) "\n") file) (close file))
      )
      (graphscr)
    )
    (t (prompt "\nLa entidad no es un Hatch."))
  )
  (setvar "dimzin" zindim)
  (setq *error* m:err
        m:err nil
  )
  (princ)
)
;;;================================================================================================


Saludos

gracias por la respuesta !  a mi me parecia que se podia escribir un codigo para el tipo de linea o patron hatch sin generar el fichero .lin o .pat ,pero debi entender mal por que busque bastante y no encontre, asi que voy a probar este codigo que me pasaste haber si me sirve.
muchas gracias!!!

Hola

"Casi" todo se puede crear desde lisp en cuanto que tenemos acceso a la base de datos ordenada de los dibujos de AutoCad. Creo importante recordar la diferencia a nivel interno entre un Hatch y un LType.

El Ltype es un objeto no gráfico -de tabla o colección-, (como las capas, los estilos de texto y de dimensión, las definiciones de bloque, etc) por lo que el dibujo tiene una única definición del LType, y cada entidad que tenga ese tipo de línea solo referencia a esa única definición, y cambiará su apariencia si modificamos dicha definición. Al crearla lo que hacemos es primero escribir en la tabla de tipos de línea (o coleccion si te suena más el lenguaje con ActiveX de Visual lisp) la definición del tipo y luego crear entidades gráficas y asignarles esas propiedad.

Los hatches por el contrario son solamente el objeto gráfico. No hay una tabla o colección de patrones cargados en el dibujo, sino que cada vez que los creas se guarda en la propia entidad la definición del patrón, los contornos y las asociaciones. Incluso creo que dos entidades de hatch podrían referirse a disintos patrones con un mismo nombre.

Entonces el LType requiere verificar si no existe ya el nombre, y si no existe crearlo una única vez y ya puedes referenciarlo en cualquier entidad, mientras que el hatch debes repetir todo el código de creación cada vez que vas a hacer uno.

Puedes crear cualquier hatch con un Entmake si prefieres autolisp (DXF) o con el método AddHatch si usas visuallisp (ActiveX). Para nada requieres el archivo .pat (aunque ayuda mucho consultar en él todos los ángulos y separaciones del patrón para copiarlos al lisp), y en la ayuda de Autocad están ambas referencias.

Sin embargo los tipos de línea no siempre se pueden crear sin el archivo .lin, (y eso parece una limitación hecha a propósito por autodesk). Con entmake o el metodo add de la colección Linetypes puedes crear los que son simples, es decir que no tienen elementos de texto o shapes, sino solo trazos, puntos y agujeros. Para crear un tipo de linea con textos o shapes sí se requiere el .lin necesariamente. Lo bueno es que el .lin fácilmente lo puede crear la rutina temporalmente, cargar el tipo de linea y desechar ese .lin.

Entonces si has leído todo eso te felicito por la paciencia XD. Te dejo un par de ejemplos de cada caso. Un hatch más sencillo y otro más complejo, así como un caso de LType simple con entmake como uno con caracteres creando el .lin temporal. Yo uso DXF para este tipo de cosas, pero si prefieres los métodos add puedes entenderlo un poco con esto y luego ver ejemplos del otro modo en la ayuda del Autocad.

Código:

(defun c:Achu1 ( / centro x1 x2 y1 y2)
 (setq centro (getpoint "Punto central para el hatch")
 x1 (- (car centro) 1.5)
 x2 (+ x1 3.0)
 y1 (- (cadr centro) 1.5)
 y2 (+ y1 3.0)
 )
 ;crear achurado simple (no asociativo)
 (entmake
 (list
 '(0 . "HATCH")
 '(100 . "AcDbEntity")
 '(8 . "_Capa-hatch")
 '(62 . 2)
 '(100 . "AcDbHatch")
 (cons 10 centro)
 '(210 0.0 0.0 1.0)
 '(2 . "SOLID")
 '(70 . 1)
 '(71 . 0)
 '(91 . 1)
 ;contorno
 '(92 . 7)
 '(72 . 1)
 '(73 . 1)
 '(93 . 4)
 (list 10 x1 y1)
 '(42 . 0)
 (list 10 x2 y1)
 '(42 . 0.5)
 (list 10 x2 y2)
 '(42 . 0)
 (list 10 x1 y2)
 '(42 . 0.5)
 ;Estilo
 '(97 . 0)
 '(75 . 1)
 '(76 . 1)
 '(47 . 1.0)
 '(98 . 1)
 (cons 10 centro)
 '(450 . 0)
 '(451 . 0)
 '(460 . 0.0)
 '(461 . 0.0)
 '(452 . 0)
 '(462 . 0.0)
 '(453 . 2)
 '(463 . 0.0)
 '(463 . 1.0)
 '(470 . "LINEAR")
 )
 )
 (princ)
)    

Código:

(defun c:Achu2 ( / centro x1 x2 x3 x4 y1 y2 y3 y4 cuadro texto nent lent hatch ach/2 alt/2 del1 del2 del3)
 (setq centro (getpoint "Punto central para el hatch")
 x1 (- (car centro) 1.5)
 x2 (+ x1 3.0)
 y1 (- (cadr centro) 1.5)
 y2 (+ y1 3.0)
 )
 ;objetos de contorno - un círculo y un cuadrado
 (entmake (list '(0 . "MTEXT") '(100 . "AcDbEntity") '(410 . "Model") '(8 . "_Capa-contornos") '(62 . 3) '(100 . "AcDbMText")
 (cons 10 centro) '(40 . 0.5) '(41 . 2.) '(71 . 5) '(72 . 1) '(1 . "Hola!") '(50 . 0.0) '(73 . 1) '(44 . 1.0)))
 (setq texto (entlast))
 (entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(410 . "Model") '(8 . "_Capa-contornos")
 '(62 . 3)'(100 . "AcDbPolyline")'(90 . 4)'(70 . 1)'(43 . 0.)
 (list 10 x1 y1)(list 10 x2 y1)(list 10 x2 y2)(list 10 x1 y2)
 )
 )
 (setq cuadro (entlast)
 lent (entget texto)
 ach/2 (* (cdr (assoc 42 lent)) 0.5)
 alt/2 (* (cdr (assoc 43 lent)) 0.5)
 x3 (- (car centro) ach/2)
 x4 (+ (car centro) ach/2)
 y3 (- (cadr centro) alt/2)
 y4 (+ (cadr centro) alt/2)
 )
 ;crear achurado asociativo
 (entmake
 (list
 '(0 . "HATCH")
 '(100 . "AcDbEntity")
 '(67 . 0)
 '(410 . "Model")
 '(8 . "_Capa-hatch")
 '(62 . 1)
 '(100 . "AcDbHatch")
 '(10 0. 0. 0.)
 '(210 0.0 0.0 1.0)
 '(2 . "_Mi_ANGLE45")
 '(70 . 0)
 '(71 . 1)
 '(91 . 2)
 ;contorno cuadro
 '(92 . 3)
 '(72 . 0)
 '(73 . 1)
 '(93 . 4)
 (list 10 x1 y1)
 (list 10 x2 y1)
 (list 10 x2 y2)
 (list 10 x1 y2)
 '(97 . 1)
 (cons 330 cuadro)
 ;contorno texto
 '(92 . 24)
 '(93 . 4)
 '(72 . 1)
 (list 10 x3 y3 0.)
 (list 11 x4 y3 0.)
 '(72 . 1)
 (list 10 x4 y3 0.)
 (list 11 x4 y4 0.)
 '(72 . 1)
 (list 10 x4 y4 0.)
 (list 11 x3 y4 0.)
 '(72 . 1)
 (list 10 x3 y4 0.)
 (list 11 x3 y3 0.)
 '(97 . 1)
 (cons 330 texto)
 ;estilo
 '(75 . 0)
 '(76 . 1)
 '(52 . 0.)
 '(41 . 1.)
 '(77 . 0)
 ;Definición del patrón
 '(78 . 2)
 ;trazo 1 (horizontal)
 '(53 . 0.0)
 '(43 . 0.0)
 '(44 . 0.0)
 '(45 . 0.0)
 '(46 . 0.2)
 '(79 . 2)
 '(49 . 0.1)
 '(49 . -0.1)
 ;trazo 2 (diagonal)
 '(53 . 2.356194490192344)
 '(43 . 0.1)
 '(44 . 0.0)
 '(45 . 0.2)
 '(46 . 0.0)
 '(79 . 2)
 '(49 . 0.14142135623731)
 '(49 . -0.14142135623731)
 '(98 . 1)
 '(10 0. 0. 0.)
 )
 )
 ;vincular la asociación
 (setq hatch (entlast))
 (foreach nent (list cuadro texto)
 (setq lent (entget nent))
 (entmod
 (append
 (list
 (setq del1 (assoc -1 lent))
 (setq del2 (assoc 0 lent))
 (setq del3 (assoc 5 lent))
 '(102 . "{ACAD_REACTORS")
 (cons 330 hatch)
 '(102 . "}")
 )
 (vl-remove del1
 (vl-remove del2
 (vl-remove del3
 lent
 )
 )
 )
 )
 )
 )
 (princ)
)

Código:

(defun c:LT1 nil
 ;Crear un tipo de línea simple (solo trazos)
 (if (null (tblsearch "LTYPE" "Mi_Center"))
 (entmake
 '(
 (0 . "LTYPE")
 (100 . "AcDbSymbolTableRecord")
 (100 . "AcDbLinetypeTableRecord")
 (2 . "Mi_Center")
 (70 . 0)
 (3 . "Mi Center _ . _ . _")
 (72 . 65)
 (73 . 4)
 (40 . 1.)
 (49 . 0.5)
 (74 . 0)
 (49 . -0.25)
 (74 . 0)
 (49 . 0)
 (74 . 0)
 (49 . -0.25)
 (74 . 0)
 )
 )
 )
 ;Linea para probarlo
 (entmake
 (list
 '(0 . "LINE")
 '(6 . "Mi_Center")
 (setq tmp (cons 10 (getpoint "Punto izq")))
 (mapcar '+ tmp '(1 4. 0 0))
 )
 )
 (princ)
)

Código:

(defun c:LT2 ( / nf fd ltypes tmp)
;Crear un tipo de línea complejo (Con textos o shapes)
 ;Crear el archivo temporal .lin
 (setq nf (vl-filename-mktemp "ltyp.lin")
 fd (open nf "w")
 )
 (write-line "*Mi_zigzag, Zig Zag /\\/\\/\\/\\/\\/\\/\\/\\/\\/\\/\\/\\/\" fd)
 (write-line "A,0,["|",Standard,y=-0.1,s=0.283,r=-45],-0.4,["|",Standard,y=-0.1,s=0.283,r=45]" fd)
 (close fd)
 ;Crear el estilo de texto base
 (if (null (tblsearch "STYLE" "_RUTINA-LTYPESTXT"))
 (entmake '((0 . "STYLE") (100 . "AcDbSymbolTableRecord") (100 . "AcDbTextStyleTableRecord")
  (2 . "_RUTINA-LTYPESTXT") (70 . 0) (40 . 0) (41 . 1) (50 . 0) (71 . 0) (3 . "txt.shx")))
 )
 ;cargar Tipo de línea desde el archivo .lin
 (setq lTypes (vla-get-linetypes
 (vla-get-activedocument
 (vlax-get-acad-object)
 )
 )
 )
 (if (null (tblsearch "LTYPE" "Mi_zigzag")) (vla-load lTypes "Mi_zigzag" nf))
 ;borrar el archivo .lin
 (vl-file-delete nf)
 ;Linea para probarlo
 (entmake
 (list
 '(0 . "LINE")
 '(6 . "Mi_zigzag")
 (setq tmp (cons 10 (getpoint "Punto izq")))
 (mapcar '+ tmp '(1 4. 0 0))
 )
 )
 (princ)
)

Por aquí te comparto el .lsp con esas mismas funciones
Archivo .lsp

Gerardo se agradece el que compartas excelente código, no sé si es mucho pedir que nos vislumbres con esta porción del código
;Definición del patrón
'(78 . 2)
;trazo 1 (horizontal)
'(53 . 0.0)
'(43 . 0.0)
'(44 . 0.0)
'(45 . 0.0)
'(46 . 0.2)
'(79 . 2)
'(49 . 0.1)
'(49 . -0.1)
;trazo 2 (diagonal)
'(53 . 2.356194490192344)
'(43 . 0.1)
'(44 . 0.0)
'(45 . 0.2)
'(46 . 0.0)
'(79 . 2)
'(49 . 0.14142135623731)
'(49 . -0.14142135623731)
'(98 . 1)
'(10 0. 0. 0.)
)
)
Le agradeceré mucho

Hola Ronald, que bueno que te vaya a servir

Para crear un patrón de achurado necesitamos dos referencias, que juntan su lógica justo en esa porción de código.
1-Como crear una definición de Hatch según se escribe en un archivo .pat
2-Como crear una entidad con la lista DXF que se le pasa a la función entmake de autolisp

Ese hatch que yo me inventé solo para este ejemplo, dentro del .pat se definiría así:

*"_Mi_ANGLE45", cualquier hatch para un ejemplo
0, 0, 0, 0, 0.2, 0.1, -0.1
135, 0.1, 0, 0.2, 0, 0.14142135623731, -0.14142135623731

La primera línea da el nombre del hatch, y una descripción que el cad ignora al cargarlo.
Las otras dos líneas definen el patrón, cada una es un trazo que se repite vectorialmente. La primera me dibuja todas las líneas horizontales y la segunda todas las diagonales, y se define así:

ángulo, origenX, origenY, deltaX, deltaY, trazo1, trazo2, trazo3...

Entonces la primera línea es con ángulo cero (horizontal), inicia en las coordenadas X=0,Y=0, y se repite indefinidamente a 0 en X (es decir todas las lineas horizontales van alineadas verticalmente) y a 0.2 en Y, o sea se copian en matriz a cada 0.2 hacia arriba y hacia abajo. Tiene dos trazos, pueden ser más o podría no tener ninguno si queremos la línea continua. Los trazos son valores iguales a los que usamos al crear el tipo de línea, un positivo es un trazo, un negativo es un espacio en blanco y un cero es un punto. Entonces esa linea que se copia verticalmente @0.2 tiene una rayita de 0.1, seguida de un espacio en blanco de 0.1 y se repite también indefinidamente.

La segunda es la misma lógica, inicia en X=0.1, Y=0, es decir, donde termina el primer trazo de la otra línea, y crece con un angulo de 135° en trazos y huecos de 0.14142 que es la hipotenusa de dos catetos de 0.1 (con eso logro que todas las rayitas a 45° coincidan en un vértice con las horizontales) y se repite a 0.2 en X y 0 en Y, es decir, al final de cada trazo de la horizontal inicia un trazo diagonal

Y eso es todo, luego vemos la referencia de DXF y ahí nos dice cuales códigos se requieren y les damos esos valores.
53-> angulo del trazo, 43 y 44->X y Y del origen, 45 y 46 --> delta X y delta Y de repeticiones, y 49 una longitud de trazo.
Luego el 78 al inicio dice de cuantas líneas se compone el hatch, en este caso 2.
Y el 79 va antes de los trazos indicando cuantos tiene cada línea, en este caso cada una tiene 2 también. Es decir, el 79 dice cuantos 49 vendrán a continuación.

También los 135° pasan a ser 2.356194490192344 radianes en el código 53 ya que en el .pat autocad hace la conversión pero autolisp solo maneja radianes.

Y eso es todo
Ayuda - patrones
Ayuda DXF

Lo mejor si quieres definir un patrón es crearlo primero en un .pat. Ir probando como se va trazando hasta que lo tengás como querés, luego pasar eso a lisp hasta que se dibuje también como se quiere
Además podrías juagar a interpretar los hatches más complejos en el archivo acadiso.pat. Por ejemplo el gravel o el ar-conc. Así identificando de donde sale cada línea del patrón es como una ingeniería inversa para aprender a resolverlos.

muchas gracias Gerardo!!!
Me diste una clase! ni habia mirado la ayuda de autocad... siempre que intente usar entmake nunca me salio nada. Voy a intentar hacer algo usando tu codigo el fin de semana, voy a tener mas tiempo para hacer prueba y error y tambien voy a investigar addhatch, que ni sabia que existia
muchas gracias!