TilingHath. Sombreado de baldosas paramétrico

Si en la entrega anterior veíamos el programa de sombreados de ladrillo paramétrico, en esta vamos a ver a su hermano gemelo pero con baldosas.

Los dos programas se crearon juntos y en el mismo archivo, y se han ido reformando y mejorando con el tiempo, los he separado por motivos de programación y por poner un poco de orden en el proyecto.

El concepto es exactamente el mismo que con BricsHatch, poder crear todo tipo de sombreados de baldosas con distintas medidas y separaciones entre ellas.

Compativilidad

Probado en AutoCAD v.2015-2017 (x64) y BricsCAD v.15 (x64)

Como siempre: Si lo probáis en otras versiones y/o plataformas os agradecería que me informaseis de los resultados para poder contrastar y solucionar posibles problemas.

Funcionamiento

Utilice TILING_HATCH en la línea de comandos para ejecutar la aplicación.
Utilice el Icono de Sombreados y Tipos de Línea en la cinta de opciones, en la barra de herramientas o en el menú desplegable.

• Modificar las Opciones necesarias en el cuadro de dialogo del programa.
• Aceptar y generar el sombreado con las opciones clásicas de AutoCAD. El programa guardara los datos y pasara el control al comando "SOMBREA"("_HATCH") de AutoCAD.

Opciones

Ver Cuadro de dialogo de opciones Ancho: Anchura real para cada baldosa Alto: Altura real para cada baldosa Separación: Separación entre baldosas: Iguales: Si se activa la casilla, desactivara el campo de separación vertical y la medida que se indique en horizontal, se aplicara tambíen a vertical. Horizontal: Separación horizontal entre baldosas (puede ser 0). Vertical: Separación vertical entre baldosas (puede ser 0). Punto de origen: Punto de origen del sombreado que se creará en el dibujo. "Designar >>" cierra temporalmente el cuadro de dialogo para indicar un punto de origen de sombreado en el dibujo.

Ejemplos:

Ejemplo 1

Ejemplo 2

Ejemplo 3

Ver

Ejemplos de sombreados con TilingHatch

Los patrones personalizados se guardan en el directorio Custom_patterns, integrado dentro de las rutas de la marmita, de manera que si el programa detecta que el patrón de sombreado ya existe no lo genera, utiliza el existente.

Nota: El directorio Custom_patterns ha de estar en las rutas de soporte de Autocad. Las funciones auxiliares del proyecto que se cargan automáticamente al inicio, añaden esta ruta a las rutas de soporte sin que tengamos que hacerlo manualmente.

El nombre generado para el patrón de sombreado utiliza el siguiente criterio:

Ejemplo de nombre de patrón: BAL_03000x025000_h01500-v01500.PAT

//  PREFIJO         ANCHO        ALTO        SEP.HORIZONTAL      SEP.VERTICAL       EXT  
//---------------------------------------------------------------------------------------
     "BAL"   "_"   "03000" "x" "025000"  "_"    "h01500"    "-"   "v01500"    "."  "PAT"
//---------------------------------------------------------------------------------------
       

Codigo y descarga.

Código

Select all

;;******************************** C:TILING_HACH ************************************;;
;; Versión 7.0  12/2015 (C:TILING_HACH)  (LaMarmita)                                 ;;
;; JOse Luis García Galan (r)                                                        ;;
;; Versión 6.0  12/2011  (C:BALDOSAS)                                                ;;
;; JOse Luis García Galan (r)                                                        ;;
;; Versión 5.0 1991 - 2011  (C:BALDOSAS)                                             ;;
;; JOse Luis García Galan (r)                                                        ;;
;;                                                                                   ;;
;; Rutina para crear hatch de baldosas parametrizados                                ;;
;; **********************************************************************************;;
(defun C:TILING_HATCH ( / ;|diccionario|; cod_imgl alt_b anc_b llh llv
             ValsDLG Dir NamePat RutaPat *error*
            ;|functions|;  WritePat_Baldosa_Complex _rt _rt2
        )
  ;;__________________________________________________________________________________
  (defun _rt (val)
   (jlgg-rtos val 2 6)
  )

  ;;__________________________________________________________________________________
  (defun _rt2 (val / Retval)
   (if (zerop val)
    "0" 
    (vl-string-subst "" "." (jlgg-rtos val 2 4))
   )
  )
  ;------------------------------ WritePat_Baldosa_Complex ------------------------------
  ;                         ESCTRIURA EN ARCHIVO DE Baldosa TIPO                         
  ;--------------------------------------------------------------------------------------
  (defun WritePat_Baldosa_Complex (a h llh llv / arch lin sepH sepV)
   ;--------------------------
   (setq Descripcion (strcat ";; Baldosas. "
        "Medidas " (_rt a) " x " (_rt h)
        " Llagas h=" (_rt llh) ", v=" (_rt llv)))
   (setq arch (open RutaPat "w"))
   (write-line Descripcion arch)
   (write-line "" arch)
   (write-line (strcat "*" NamePat ", Baldosas.") arch)
   ;;______________________________________________________
   (setq sepH (if (not (equal llh 0.0 1.0e-006))
         (strcat ", " (_rt h) "," (_rt (- llh)))
         ""))
   (setq sepV (if (not (equal llv 0.0 1.0e-006))
         (strcat ", " (_rt a) "," (_rt (- llv)))
         ""))
   (setq lin (strcat "0, 0,0, 0," (_rt (+ h llh)) sepV)) ;primera linea Horizontal
   (write-line lin arch)
   (if (/= sepH "") ;Dibujar segunda linea Horizontal
    (progn
     (setq lin (strcat "0, 0," (_rt h) ", 0," (_rt (+ h llh)) sepV))
     (write-line lin arch)
    )
   )
   (setq lin (strcat "90, 0,0, 0," (_rt (+ a llv)) sepH)) ;primera linea Vertical
   (write-line lin arch)
   (if (/= sepV "") ;Dibujar segunda linea Vertical
    (progn
     (setq lin (strcat "90, " (_rt a) ",0, 0," (_rt (+ a llv)) sepH))
     (write-line lin arch)
    )
   )
   (close arch)
  );defun
 
 
 ;;--------------------------- MAIN ------------------------------------------------------
 (setq *error* LMT:error)
 (vl-doc-set '*NameAppRun* "Tiling_Hatch")
 (jlgg-Init_Vars (list
      '("snapmode" 0)
      (list "luprec" (if (< (getvar "luprec") 4) 4 (getvar "luprec")))
      '("cmdecho" 0)))
 
 ;;Valores iniciales desde el cuadro de dialogo:
 (cond
  ((not (setq Dir (LMC-Path-CustPAT)))
   (alert "\nNo se encontro una ruta registrada, para guardar los patrones.\n")
  )
  ((setq ValsDLG (BALDOSA_DLG T))
   ;;(("cod_imgl" . 0) ("alt_b" . 0.115) ("anc_b" . 0.24) ("llh" . 0.0) ("llv" . 0.1))
   (mapcar '(lambda (x) (set (read (car x)) (cdr x))) ValsDLG)
   (setq NamePat (strcat "BAL_"
         (_rt2 anc_b) "x" (_rt2 alt_b) "_"
         "h" (_rt2 llh) "-" "v" (_rt2 llv)))
   (setq RutaPat (strcat Dir NamePat ".PAT"))
   (cond
 ((findfile RutaPat))
 (T (WritePat_Baldosa_complex anc_b alt_b llh llv))
   );c.cond
   ;;----------------version 2000+ -------------------------
   (command "_.-bhatch" "_P" NamePat 1.0 0.0 "")
   (initdia)
   (command "_.bhatch")
  )
 );c.cond
 (jlgg-res_vars)
 (princ)
)

;;---------------------------------------------------------------------------------
;; Función del cuadro de dialogo                                                   
;; Utilizar: (BALDOSA_DLG nil) para pruebas sin guardar datos                      
;;---------------------------------------------------------------------------------
(defun BALDOSA_DLG (SaveVals
      /
      ;|diccionario|;  alt_b anc_b chk_igual llh llv
      accion base_l$ base_l PtTmp RetVal 
      ;|Funciones|; baldosa_ok ImgBald_1: Do_chk_igual
                    do_num_l dcl_draw_line WriteDialogBaldosa GetValBaldosa
        )
 
 ;;;---------------------- GetValBaldosa ------------------------------
 ;;; Obtenemos valores de  Baldosas desde diccionario                  
 ;;;-------------------------------------------------------------------
  (defun GetValBaldosa ( / LisVal)
  (if (or (null (setq LisVal (vlax-ldata-get "DICT_LaMarmita" "BALDOSA")))
    (/= (length LisVal) 5))
   (setq LisVal (list  '("alt_b" . 0.30)
        '("anc_b" . 0.30)
        '("chk_igual" . "1")
        '("llh" . 0.0)
        '("llv" . 0.0))
   LisVal (vlax-ldata-put "DICT_LaMarmita" "BALDOSA" LisVal))
   );c.if
  LisVal
 );c.defun 
 ;;------------------------------ WriteDialogBaldosa ----------------------------------------------
 ;;                    Definir archivo de cuadro de dialogo                                         
 ;;-------------------------------------------------------------------------------------------------
 (DEFUN WriteDialogBaldosa ( / Dir openFile FichDlg)
  (setq Dir (getvar "TEMPPREFIX"))    
  (setq FichDlg (strcat Dir "$PAT_Baldosas$" ".dcl"))
  (cond
   ;;(T ;;Forzar reescribir el cuadro (programando)
   ((not (findfile FichDlg))
    (setq openFile (open FichDlg "w"))
   (write-line "// ---------------------------------------------------------------" openFile)
   (write-line "// CUADRO DE DIALOGO DE HATCH DE BALDOSAS                         " openFile)
   (write-line "// ---------------------------------------------------------------" openFile)
   (write-line "baldosa : dialog {" openFile)
   (write-line " label = \"Sombreado de Baldosas\";" openFile)
   (write-line " : boxed_column {" openFile)
   (write-line "   //children_fixed_width = true;" openFile)
   (write-line "   : row {" openFile)
   (write-line "     children_alignment = bottom;" openFile)
   (write-line "     : image {" openFile)
   (write-line "       key = \"img_b\";" openFile)
   (write-line "       width = 20;" openFile)
   (write-line "       fixed_width = true;" openFile)
   (write-line "       color = graphics_background;" openFile)
   (write-line "       aspect_ratio = 0.6;" openFile)
   (write-line "     }" openFile)
   (write-line "     : column {" openFile)
   (write-line "       fixed_height = true;" openFile)
   (write-line "       : edit_box {" openFile)
   (write-line "         label = \"A&cho:\";" openFile)
   (write-line "         key = \"anc_b\";" openFile)
   (write-line "         edit_width = 8;" openFile)
   (write-line "       }" openFile)
   (write-line "       : edit_box {" openFile)
   (write-line "         label = \"&Alto:\";" openFile)
   (write-line "         key = \"alt_b\";" openFile)
   (write-line "         edit_width = 8;" openFile)
   (write-line "       }" openFile)
   (write-line "     }//c.column" openFile)
   (write-line "   }//c.row" openFile)
   (write-line "   : row {" openFile)
   (write-line "     fixed_width = true;" openFile)
   (write-line "     : text {label = \"Separación:\";}" openFile)
   (write-line "     : toggle {label = \"&Iguales:\"; key = \"chk_igual\";}" openFile)
   (write-line "   }//c.row" openFile)
   (write-line "   : row {" openFile)
   (write-line "     fixed_width = true;" openFile)
   (write-line "     : edit_box {" openFile)
   (write-line "       label = \"&Horizontal:\";" openFile)
   (write-line "       key = \"llh\";" openFile)
   (write-line "       edit_width = 7;" openFile)
   (write-line "     }" openFile)
   (write-line "     : edit_box {" openFile)
   (write-line "       label = \"&Vertical:\";" openFile)
   (write-line "       key = \"llv\";" openFile)
   (write-line "       edit_width = 7;" openFile)
   (write-line "     }" openFile)
   (write-line "   }" openFile)
   (write-line " }//c.boxed_column" openFile)
   (write-line " : boxed_column {" openFile)
   (write-line "   label = \"Punto de origen.\";       " openFile)
   (write-line "   alignment = centered;" openFile)
   (write-line "   : button {" openFile)
   (write-line "     label = \"&Designar >>\";" openFile)
   (write-line "     key = \"p_bal\"; " openFile)
   (write-line "     alignment = centered;" openFile)
   (write-line "   }" openFile)
   (write-line "   : text {label = \"\"; key = \"t_bal\";}" openFile)
   (write-line "  }//c.boxed_column" openFile)
   (write-line " spacer_1;" openFile)
   (write-line " ok_cancel_err;" openFile)
   (write-line "}//c.DCL" openFile)
   (write-line "" openFile)
   (close openFile)
  )
    );c.cond
  FichDlg
 );c.defun
 
 ;;------------------------ do_num_l ----------------------------------
 ;;  accion de chequeo de numeros                                      
 ;;--------------------------------------------------------------------
 (defun do_num_l ( ll mens cod / r)
   (cond
    ((setq r (jlgg-test_numr (get_tile ll) mens cod)) ; si es valida
     (set_tile "error" "")
  (set (read ll) r)
     (set_tile ll (jlgg-rtos r nil nil))
  T
    )
   );c.cond
 ) 
 ;;_________________________________________________________________________________
    (defun dcl_draw_line (Col listOfListVect)
      (mapcar (function (lambda (l)(apply 'vector_image (append l (list col))))) listOfListVect)
    ) 
 ;;__________________________________________________________________________________
 (defun baldosa_ok()
   (cond ((not (jlgg-test_numr (get_tile "alt_b") "Altura de baldosa "  6)))
   ((not (jlgg-test_numr (get_tile "anc_b") "Anchura de baldosa " 6)))
   ((not (jlgg-test_numr (get_tile "llh"  ) "Llaga Horizontal "   4)))
   ((not (jlgg-test_numr (get_tile "llv"  ) "Llaga Vertical "     4)))
   (t (setq p_dia (done_dialog 1))))
 );c.defun
 
 ;;__________________________________________________________________________________
 ;; ImgBald_1: Imagen de Baldosas                                                    
 (defun ImgBald_1: ( keyImg / l a)
  (start_image keyImg)
  (setq l (dimx_tile keyImg)  ;;120
        a (dimy_tile keyImg)  ;;72
  )
  (fill_image 0 0 l a -2)
  (dcl_draw_line 31 '((0 2 13 2)(13 2 13 35)(13 35 0 35)))
  (dcl_draw_line 31 '((15 2 48 2)(48 2 48 35)(48 35 15 35)(15 35 15 2)))
  (dcl_draw_line 31 '((50 2 83 2)(83 2 83 35)(83 35 50 35)(50 35 50 2)))
  (dcl_draw_line 31 '((85 2 118 2)(118 2 118 35)(118 35 85 35)(85 35 85 2)))
  
  (dcl_draw_line 31 '((0 37 13 37)(13 37 13 70)(13 70 0 70)))
  (dcl_draw_line 31 '((15 37 48 37)(48 37 48 70)(48 70 15 70)(15 70 15 37)))
  (dcl_draw_line 31 '((50 37 83 37)(83 37 83 70)(83 70 50 70)(50 70 50 37)))
  (dcl_draw_line 31 '((85 37 118 37)(118 37 118 70)(118 70 85 70)(85 70 85 37)))
  (end_image)
 );defun ImgBald_1:
        
 ;;__________________________________________________________________________________
 (defun Do_chk_igual ()
  (cond
   ((= chk_igual "1")
    (setq llv llh)
    (set_tile "llv" (jlgg-rtos llv nil nil))
   )
  )
  (mode_tile "llv" (atoi chk_igual))
 )
 ;;--------------------------- MAIN ------------------------------------------------------
 (setq base_l$ (getvar "snapbase")
       base_l base_l$)
 
 ;;Valores iniciales y de diccionario: alt_b anc_b cod_imgl llh llv
 (mapcar '(lambda (x) (set (read (car x)) (cdr x))) (GetValBaldosa))
 (setq n_dia (load_dialog (WriteDialogBaldosa))
       accion T)
 (if (null p_dia)(setq p_dia '(-1 -1)))
 (while accion
  (if (not (new_dialog "baldosa" n_dia "" p_dia)) (exit))

  ;;asignaciones de cuadro de dialogo
  (ImgBald_1: "img_b")
  (set_tile "alt_b"     (jlgg-rtos alt_b nil nil))
  (set_tile "anc_b"     (jlgg-rtos anc_b nil nil))
  (set_tile "chk_igual" chk_igual                ) 
  (set_tile "llh"       (jlgg-rtos llh   nil nil))
  (set_tile "llv"       (jlgg-rtos llv   nil nil))
  (Do_chk_igual)
  (set_tile "t_bal" (strcat "X= " (jlgg-rtos (car base_l) nil nil) "  Y= " (jlgg-rtos (last base_l) nil nil)))
  
  ;;acciones de cuadro de dialogo
  (action_tile "alt_b"     "(do_num_l $key \"Altura de baldosa \"     6)")
  (action_tile "anc_b"     "(do_num_l $key \"Anchura de baldosa \"    6)")
  (action_tile "chk_igual" "(setq chk_igual $value)(Do_chk_igual)")
  (action_tile "llh"       "(if (do_num_l $key \"Separación Horizontal \" 4) (Do_chk_igual))")
  (action_tile "llv"       "(do_num_l $key \"Separación Vertical \"   4)")

  (action_tile "p_bal"  "(setq p_dia (done_dialog 2))")
  (action_tile "cancel" "(setq p_dia (done_dialog 0))")
  (action_tile "accept" "(baldosa_ok)")
  
  (setq accion (start_dialog)) ;; activa el c. de dialogo
  (cond                            
   ((= accion 2)               ;; Si punto base se ha señalado...
    (redraw)
    (cond
  ((and (setq PtTmp (vl-catch-all-apply (function getpoint) (list "\nPunto base para hatch de Baldosas: ")))
     (not (vl-catch-all-error-p PtTmp)))
      (jlgg-grdx PtTmp 51 150)
      (princ)
      (setq base_l (list (car PtTmp) (cadr PtTmp)))
      (if (>= (distof (substr (getvar "acadver") 1 4)) 16.2)
       (progn
  (if (not (IsBricsCAD))(setvar "HPORIGINMODE" 0))
        (setvar "HPORIGIN" base_l)
       );c.prg
       (setvar "snapbase" base_l)
      );c.if
     )
    );c.cond
   );c.cond de accion 2
   ((= accion 0)                               ;si cancel es señalado
    (setvar "snapbase" base_l$)
    (setq accion nil)
    (unload_dialog n_dia)
   );c.cond de accion 0
   ((= accion 1)                               ;si es todo correcto
    (setq accion nil)
    (unload_dialog n_dia)
 (setq RetVal 
  (list (cons "chk_igual" chk_igual)
     (cons "alt_b"    alt_b     )
     (cons "anc_b"    anc_b     )
     (cons "llh"      llh       )
     (cons "llv"      llv       )
  )
 )
 (if SaveVals
  ;;Valores al diccionario
  (vlax-ldata-put "DICT_LaMarmita" "BALDOSA" RetVal)
 )
   ) 
  );c.cond
 );c.while
 RetVal
);c.defun

(princ)
                

Descarga.

Tiling_Hatch.lsp

Size: 14 KB.

Actualizado: 13/07/2016.

El programa necesitará que estén cargadas y actualizadas las funciones comunes para los programas publicados en La Marmita.

Estas utilidades y han sido incorporadas al proyecto de “La Marmita”, integradas en el menú, en la ruta de archivos y en la carga automática de funciones y comandos.

Se puede descargar el proyecto completo desde: Proyecto "La Marmita".

Como siempre, espero sea de utilidad.
Un saludo a tod@s desde España.