Decíamos ayer...
Siento haber tardado en publicar pero lo primero es lo primero y el trabajo me impide dedicarme a la programación todo lo que yo quisiera.
Esta vez os traigo una utilidad que ya publique, allá por el año 1991, reformada, claro está, para los nuevos tiempos que corren.
Siempre buscaba o generaba patrones de sombreado de ladrillo para los alzados y secciones o detalles de proyecto. En ocasiones también tenía que adecuar las fachadas al reparto de ladrillo con determinada separación en vertical y horizontal del mismo. Muchas veces no disponía del patrón adecuado y no había tiempo para generar patrones (algo engorroso) y los dibujaba a mano (líneas o polilíneas).
Así puse manos a la obra para crear un programa que me generase los patrones de ladrillo en base a unos parámetros específicos. Y de paso generar otro programa de sombreados de baldosas (en una próxima entrega).
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 BRICS_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.
|
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: LAD_1_02400x00700_h00150-v00100.PAT
// PREFIJO TIPO ANCHO ALTO SEP.HORIZONTAL SEP.VERTICAL EXT
//-------------------------------------------------------------------------------------------------
"LAD" "_" "1" "_" "02400" "x" "007000" "_" "h00150" "-" "v00100" "." "PAT"
//-------------------------------------------------------------------------------------------------
Codigo y descarga.
Código
Select all
;;******************************** C:BRICS_HACH *************************************;;
;; Versión 7.0 13/2016 (C:BRICS_HACH) (Actualizado para LaMarmita) ;;
;; JOse Luis García Galan (r) ;;
;; Versión 6.0 12/2011 (C:LADRILLO) ;;
;; JOse Luis García Galan (r) ;;
;; Versión 1.0 1991 (C:LADRILLO) ;;
;; JOse Luis García Galan (r) ;;
;; ;;
;; Rutina para crear hatch de ladrillos parametrizados ;;
;; **********************************************************************************;;
(defun C:BRICS_HATCH ( / ;|diccionario|; cod_imgl alt_l anc_l llh llv
ValsDLG Dir NamePat RutaPat *error*
;|functions|; Write_Ladrillo_Sogatiz Write_Ladrillo_Tipo
_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))
)
)
;;------------------------------------ Write_Ladrillo_Sogatiz --------------------------
;; ESCTRIURA EN ARCHIVO DE APAREJO DE LADRILLO TIPO
;;--------------------------------------------------------------------------------------
(defun Write_Ladrillo_Sogatiz ( a h llv llh / Descripcion arch lin)
(setq Descripcion (strcat ";; Ladrillo SOGA-TIZON "
"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 ", Ladrillo SOGA-TIZON") arch)
;---------------
(if (equal llh 0.0 1.0e-006) ;;NO hay llaga Horizontal
(progn
(setq lin (strcat "0, 0,0, 0," (_rt h)))
(write-line lin arch)
)
(progn
;;Linea Horizontal 1
(setq lin (strcat "0, 0,0," ;;Angulo, X,Y
"0," (_rt (* (+ h llh) 2)) ;;Repeticion en X, (Y)
", " (_rt a) "," (_rt (- llv)) ;;Trazo1, NO Trazo1(-)
", " (_rt (/ a 2)) "," (_rt (- llv)) ;;Trazo2, NO Trazo2(-)
))
(write-line lin arch)
;;Linea Horizontal 2
(setq lin (strcat "0, 0," (_rt h) "," ;;Angulo, X,Y
"0," (_rt (* (+ h llh) 2)) ;;Repeticion en X, (Y)
", " (_rt a) "," (_rt (- llv)) ;;Trazo1, NO Trazo1(-)
", " (_rt (/ a 2)) "," (_rt (- llv)) ;;Trazo2, NO Trazo2(-)
))
(write-line lin arch)
;;Linea Horizontal 3
(setq lin (strcat "0," (_rt (+ llv (* a 0.75))) "," (_rt (+ h llh)) "," ;;Angulo, X,Y
"0," (_rt (* (+ h llh) 2)) ;;Repeticion en X, (Y)
", " (_rt a) "," (_rt (- llv)) ;;Trazo1, NO Trazo1(-)
", " (_rt (/ a 2)) "," (_rt (- llv)) ;;Trazo2, NO Trazo2(-)
))
(write-line lin arch)
;;Linea Horizontal 4
(setq lin (strcat "0," (_rt (+ llv (* a 0.75))) "," (_rt (+ h h llh)) ",";;Angulo, X,Y
"0," (_rt (* (+ h llh) 2)) ;;Repeticion en X, (Y)
", " (_rt a) "," (_rt (- llv)) ;;Trazo1, NO Trazo1(-)
", " (_rt (/ a 2)) "," (_rt (- llv)) ;;Trazo2, NO Trazo2(-)
))
(write-line lin arch)
);c.prg
);c.if
;;; ;----------------------- Verticales -----------------------------------------------------
;;Fila1: Linea Vertical 1
(setq lin (strcat "90, 0,0," ;;Angulo, X,Y
"0," (_rt (+ a (/ a 2) (* llv 2))) ;;Repeticion en X, (Y)
", " (_rt h) "," (_rt (- (+ h (* llh 2)))) ;;Trazo1, NO Trazo1(-)
))
(write-line lin arch)
;;Fila1: Linea Vertical 2
(if (not (equal llv 0.0 1.0e-006))
(setq lin (strcat "90," (_rt a) ",0," ;;Angulo, X,Y
"0," (_rt (+ a (/ a 2) (* llv 2))) ;;Repeticion en X, (Y)
", " (_rt h) "," (_rt (- (+ h (* llh 2)))) ;;Trazo1, NO Trazo1(-)
)
lin (write-line lin arch))
);c.if
;;Fila1: Linea Vertical 3
(setq lin (strcat "90," (_rt (+ a llv)) ",0," ;;Angulo, X,Y
"0," (_rt (+ a (/ a 2) (* llv 2))) ;;Repeticion en X, (Y)
", " (_rt h) "," (_rt (- (+ h (* llh 2)))) ;;Trazo1, NO Trazo1(-)
))
(write-line lin arch)
;;Fila1: Linea Vertical 4
(if (not (equal llv 0.0 1.0e-006))
(setq lin (strcat "90," (_rt (+ a (/ a 2) llv)) ",0," ;;Angulo, X,Y
"0," (_rt (+ a (/ a 2) (* llv 2))) ;;Repeticion en X, (Y)
", " (_rt h) "," (_rt (- (+ h (* llh 2)))) ;;Trazo1, NO Trazo1(-)
)
lin (write-line lin arch))
)
;;Fila2: Linea Vertical 1 ----
(setq lin (strcat "90," (_rt (+ (* a 0.75) llv)) "," (_rt (+ h llh)) "," ;;Angulo, X,Y
"0," (_rt (+ a (/ a 2) (* llv 2))) ;;Repeticion en X, (Y)
", " (_rt h) "," (_rt (- (+ h (* llh 2)))) ;;Trazo1, NO Trazo1(-)
))
(write-line lin arch)
;;Fila2: Linea Vertical 2 ----
(if (not (equal llv 0.0 1.0e-006))
(setq lin (strcat "90," (_rt (+ (* a 0.75) llv a)) "," (_rt (+ h llh)) "," ;;Angulo, X,Y
"0," (_rt (+ a (/ a 2) (* llv 2))) ;;Repeticion en X, (Y)
", " (_rt h) "," (_rt (- (+ h (* llh 2)))) ;;Trazo1, NO Trazo1(-)
)
lin (write-line lin arch))
);c.if
;;Fila2: Linea Vertical 3 ----
(setq lin (strcat "90," (_rt (+ (* a 0.75) llv a llv)) "," (_rt (+ h llh)) "," ;;Angulo, X,Y
"0," (_rt (+ a (/ a 2) (* llv 2))) ;;Repeticion en X, (Y)
", " (_rt h) "," (_rt (- (+ h (* llh 2)))) ;;Trazo1, NO Trazo1(-)
))
(write-line lin arch)
;;Fila2: Linea Vertical 4 ----
(if (not (equal llv 0.0 1.0e-006))
(setq lin (strcat "90," (_rt (+ (* a 0.75) llv a llv (/ a 2))) "," (_rt (+ h llh)) "," ;;Angulo, X,Y
"0," (_rt (+ a (/ a 2) (* llv 2))) ;;Repeticion en X, (Y)
", " (_rt h) "," (_rt (- (+ h (* llh 2)))) ;;Trazo1, NO Trazo1(-)
)
lin (write-line lin arch))
);c.if
(close arch)
);defun
;----------------------------------- Write_Ladrillo_Tipo ------------------------------
; ESCTRIURA EN ARCHIVO DE LADRILLO TIPO
;--------------------------------------------------------------------------------------
(defun Write_Ladrillo_Tipo ( a h llv llh / Descripcion arch lin sepV)
(setq Descripcion (strcat ";; Ladrillo TIPO. "
"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 ", Ladrillo TIPO") arch)
;---------------
(setq sepV (if (not (equal llh 0.0 1.0e-006))
(strcat ", " (_rt a) "," (_rt (- llv)))
""))
;;--------------- 1º hilera lineas Hor
(setq lin (strcat "0, 0,0, 0," (_rt (* (+ h llh) 2)) sepV ))
(write-line lin arch)
(setq lin (strcat "0, 0," (_rt h ) ", 0," (_rt (* (+ h llh) 2)) sepV ))
(write-line lin arch)
;;--------------- 2º hilera lineas Hor
(if (not (equal llh 0.0 1.0e-006))
(progn
(setq lin (strcat "0, " (_rt (/ (+ a llv) 2) ) "," (_rt (+ h llh) ) ", 0,"
(_rt (* (+ h llh) 2) ) ", " (_rt a ) "," (_rt (- llv)) ))
(write-line lin arch)
(setq lin (strcat "0, " (_rt (/ (+ a llv) 2) ) "," (_rt (+ (* h 2) llh) ) ", 0,"
(_rt (* (+ h llh) 2) ) ", " (_rt a ) "," (_rt (- llv) )))
(write-line lin arch)
);c.prg
);c.if
;-------------------------- Verticales --------------------------------------------------
(setq lin (strcat "90, 0,0, 0," (_rt (+ a llv) ) ", " (_rt h ) ","
(_rt (- (+ h (* llh 2))) )
)
);c.setq
(write-line lin arch)
;--------------- 1º hilera lineas Vert
(if (not (equal llv 0.0 1.0e-006))
(progn
(setq lin (strcat "90, " (_rt a ) ",0, 0," (_rt (+ a llv) ) ", "
(_rt h ) "," (_rt (- (+ h (* llh 2))) )))
(write-line lin arch)
)
)
;--------------- 2º hilera lineas Vert
(setq lin (strcat "90, " (_rt (/ (+ a llv) 2) ) "," (_rt (+ h llh) ) ", 0,"
(_rt (+ a llv) ) ", " (_rt h ) "," (_rt (- (+ h (* llh 2))) )
)
);c.setq
(write-line lin arch)
(if (not (equal llv 0.0 1.0e-006))
(progn
(setq lin (strcat "90, " (_rt (/ (- a llv) 2) ) "," (_rt (+ h llh) ) ", 0,"
(_rt (+ a llv) ) ", " (_rt h ) "," (_rt (- (+ h (* llh 2))) )))
(write-line lin arch)
)
)
(close arch)
);c.defun
;;--------------------------- MAIN ------------------------------------------------------
(setq *error* LMT:error)
(vl-doc-set '*NameAppRun* "Brics_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 (LADRILLO_DLG T))
;;(("cod_imgl" . 0) ("alt_l" . 0.115) ("anc_l" . 0.24) ("llh" . 0.0) ("llv" . 0.1))
(mapcar '(lambda (x) (set (read (car x)) (cdr x))) ValsDLG)
(setq NamePat (strcat "LAD_" (itoa cod_imgl) "_"
(_rt2 anc_l) "x" (_rt2 alt_l) "_"
"h" (_rt2 llh) "-" "v" (_rt2 llv)))
(setq RutaPat (strcat Dir NamePat ".PAT"))
(cond
((findfile RutaPat))
((= cod_imgl 0)(write_ladrillo_tipo anc_l alt_l llv llh))
((= cod_imgl 1)(write_ladrillo_sogatiz anc_l alt_l llv llh))
);c.cond
;;----------------version 2000+ -------------------------
(command "_.-bhatch" "_P" NamePat 1.0 0.0 "")
(initdia)
(command "_.bhatch")
)
);c.cond
(jlgg-res_vars)
(princ)
)
;;--------------------------------- LADRILLO_DLG ----------------------------------
;; Función del cuadro de dialogo
;; Utilizar: (LADRILLO_DLG nil) para pruebas sin guardar datos
;;---------------------------------------------------------------------------------
(defun LADRILLO_DLG (SaveVals
/
;|diccionario|; cod_imgl alt_l anc_l llh llv
accion base_l$ base_l PtTmp RetVal
;|Funciones|; ladrillo_ok img_ladrillo ImgLad_1: ImgLad_2:
do_num_l dcl_draw_line WriteDialogLadrillo GetValLadrillo
)
;;;---------------------- GetValLadrillo ------------------------------
;;; Obtenemos valores de la Ladrillo desde diccionario
;;;--------------------------------------------------------------------
(defun GetValLadrillo ( / LisVal)
(if (or (null (setq LisVal (vlax-ldata-get "DICT_LaMarmita" "LADRILLO")))
(/= (length LisVal) 5))
(setq LisVal (list '("cod_imgl" . 0 )
'("alt_l" . 0.115)
'("anc_l" . 0.24 )
'("llh" . 0.0 )
'("llv" . 0.0 )
)
LisVal (vlax-ldata-put "DICT_LaMarmita" "LADRILLO" LisVal))
);c.if
LisVal
);c.defun
;;------------------------------ WriteDialogLadrillo ----------------------------------------------
;; Definir archivo de cuadro de dialogo
;;-------------------------------------------------------------------------------------------------
(DEFUN WriteDialogLadrillo ( / Dir openFile FichDlg)
(setq Dir (getvar "TEMPPREFIX"))
(setq FichDlg (strcat Dir "$PAT_Ladrillos$" ".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 LADRILLO " openFile)
(write-line "// ---------------------------------------------------------------" openFile)
(write-line "ladrillo : dialog {" openFile)
(write-line " label = \"Sombreado de Ladrillo\";" openFile)
(write-line " : boxed_column { " openFile)
(write-line " fixed_height = true;" openFile)
(write-line " : row { " openFile)
(write-line " alignment = top;" openFile)
(write-line " : column {" openFile)
(write-line " fixed_height = true;" openFile)
(write-line " : text {label = \"Aparejo:\";}" openFile)
(write-line " : list_box {" openFile)
(write-line " key = \"tipo_l\";" openFile)
(write-line " list = \"Tipo \\nSoga - Tizón\";" openFile)
(write-line " height = 4;" openFile)
(write-line " fixed_height = true;" openFile)
(write-line " }" openFile)
(write-line " }" openFile)
(write-line " : image {" openFile)
(write-line " fixed_height = true;" openFile)
(write-line " fixed_width = true;" openFile)
(write-line " key = \"img_l\";" openFile)
(write-line " width = 17.92;" openFile)
(write-line " height = 4.89;" openFile)
(write-line " color = graphics_background;" openFile)
(write-line " }" openFile)
(write-line " }//c.row" openFile)
(write-line " : edit_box {" openFile)
(write-line " label = \"A&chura Ladrillo:\";" openFile)
(write-line " key = \"anc_l\";" openFile)
(write-line " edit_width = 10;" openFile)
(write-line " }" openFile)
(write-line " : edit_box {" openFile)
(write-line " label = \"&Altura Ladrillo:\";" openFile)
(write-line " key = \"alt_l\";" openFile)
(write-line " edit_width = 10;" openFile)
(write-line " }" openFile)
(write-line " : edit_box {" openFile)
(write-line " label = \"Llaga &Horizontal:\";" openFile)
(write-line " key = \"llh\";" openFile)
(write-line " edit_width = 10;" openFile)
(write-line " }" openFile)
(write-line " : edit_box {" openFile)
(write-line " label = \"Llaga &Vertical:\";" openFile)
(write-line " key = \"llv\";" openFile)
(write-line " edit_width = 10;" 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_lad\"; " openFile)
(write-line " alignment = centered;" openFile)
(write-line " }" openFile)
(write-line " : text { " openFile)
(write-line " label = \"\";" openFile)
(write-line " key = \"t_lad\"; " openFile)
(write-line " }" openFile)
(write-line " }//c.boxed_column" openFile)
(write-line " spacer_1;" openFile)
(write-line " ok_cancel_err;" openFile)
(write-line "}" 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))
)
);c.cond
)
;;_________________________________________________________________________________
(defun dcl_draw_line (Col listOfListVect)
(mapcar (function (lambda (l)(apply 'vector_image (append l (list col))))) listOfListVect)
)
;;__________________________________________________________________________________
(defun ladrillo_ok()
(cond ((not (jlgg-test_numr (get_tile "alt_l") "Altura de Ladrillo " 6)))
((not (jlgg-test_numr (get_tile "anc_l") "Anchura de Ladrillo " 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
;;__________________________________________________________________________________
(defun img_ladrillo (/ long alto img_lad)
(if (= cod_imgl 2) (setq cod_imgl 0))
(setq img_lad (strcat "ImgLad_" (itoa (1+ cod_imgl)) ":"))
(eval (read (strcat "(" img_lad "\"img_l\")")))
(cond
((= img_lad "ImgLad_1:")
(set_tile "tipo_l" "0")
)
((= img_lad "ImgLad_2:")
(set_tile "tipo_l" "1")
)
);c.cond
);c.defun
;;__________________________________________________________________________________
;; ImgLad_1: Imagen de Ladrillo tipo
(defun ImgLad_1: ( keyImg / l a)
(start_image keyImg)
(setq l (dimx_tile keyImg) ;;108
a (dimy_tile keyImg) ;;64
)
(fill_image 0 0 l a -2)
;;'((x y x2 y2)(x y x2 y2)(x y x2 y2)..)
(dcl_draw_line 41 '((1 1 20 1)(20 1 20 15)(20 15 1 15)(1 15 1 1)))
(dcl_draw_line 41 '((23 1 63 1)(63 1 63 15)(63 15 23 15)(23 15 23 1)))
(dcl_draw_line 41 '((65 1 106 1)(106 1 106 15)(106 15 65 15)(65 15 65 1)))
(dcl_draw_line 41 '((1 17 42 17)(42 17 42 30)(42 30 1 30)(1 30 1 17)))
(dcl_draw_line 41 '((44 17 84 17)(84 17 84 30)(84 30 44 30)(44 30 44 17)))
(dcl_draw_line 41 '((87 17 106 17)(106 17 106 30)(106 30 87 30)(87 30 87 17)))
(dcl_draw_line 41 '((1 33 20 33)(20 33 20 46)(20 46 1 46)(1 46 1 33)))
(dcl_draw_line 41 '((23 33 63 33)(63 33 63 46)(63 46 23 46)(23 46 23 33)))
(dcl_draw_line 41 '((65 33 106 33)(106 33 106 46)(106 46 65 46)(65 46 65 33)))
(dcl_draw_line 41 '((1 48 42 48)(42 48 42 62)(42 62 1 62)(1 62 1 48)))
(dcl_draw_line 41 '((44 48 84 48)(84 48 84 62)(84 62 44 62)(44 62 44 48)))
(dcl_draw_line 41 '((87 48 106 48)(106 48 106 62)(106 62 87 62)(87 62 87 48)))
(end_image)
);defun ImgLad_1:
;;__________________________________________________________________________________
;; ImgLad_2: Imagen de Ladrillo Soga-Tizon
(defun ImgLad_2: ( keyImg / l a)
(start_image keyImg)
(setq l (dimx_tile keyImg) ;;108
a (dimy_tile keyImg) ;;64
)
(fill_image 0 0 l a -2)
(dcl_draw_line 31 '((0 2 19 2)(19 2 19 15)(19 15 0 15)))
(dcl_draw_line 31 '((21 2 41 2)(41 2 41 15)(41 15 21 15)(21 15 21 2)))
(dcl_draw_line 31 '((43 2 83 2)(83 2 83 15)(83 15 43 15)(43 15 43 2)))
(dcl_draw_line 31 '((85 2 105 2)(105 2 105 15)(105 15 85 15)(85 15 85 2)))
(dcl_draw_line 31 '((0 17 9 17)(9 17 9 30)(9 30 0 30)))
(dcl_draw_line 31 '((11 17 51 17)(51 17 51 30)(51 30 11 30)(11 30 11 17)))
(dcl_draw_line 31 '((53 17 73 17)(73 17 73 30)(73 30 53 30)(53 30 53 17)))
(dcl_draw_line 31 '((107 17 75 17)(75 17 75 30)(75 30 107 30)))
(dcl_draw_line 31 '((0 33 19 33)(19 33 19 46)(19 46 0 46)))
(dcl_draw_line 31 '((21 33 41 33)(41 33 41 46)(41 46 21 46)(21 46 21 33)))
(dcl_draw_line 31 '((43 33 83 33)(83 33 83 46)(83 46 43 46)(43 46 43 33)))
(dcl_draw_line 31 '((85 33 105 33)(105 33 105 46)(105 46 85 46)(85 46 85 33)))
(dcl_draw_line 31 '((0 48 9 48)(9 48 9 61)(9 61 0 61)))
(dcl_draw_line 31 '((11 48 51 48)(51 48 51 61)(51 61 11 61)(11 61 11 48)))
(dcl_draw_line 31 '((53 48 73 48)(73 48 73 61)(73 61 53 61)(53 61 53 48)))
(dcl_draw_line 31 '((107 48 75 48)(75 48 75 61)(75 61 107 61)))
(end_image)
);defun ImgLad_2:
;;--------------------------- MAIN ------------------------------------------------------
(setq base_l$ (getvar "snapbase")
base_l base_l$)
;;Valores iniciales y de diccionario: alt_l anc_l cod_imgl llh llv
(mapcar '(lambda (x) (set (read (car x)) (cdr x))) (GetValLadrillo))
(setq n_dia (load_dialog (WriteDialogLadrillo))
accion T)
(if (null p_dia)(setq p_dia '(-1 -1)))
(while accion
(if (not (new_dialog "ladrillo" n_dia "" p_dia)) (exit))
;;asignaciones de cuadro de dialogo
(img_ladrillo) ;visualiza el tipo de ladrillo
(set_tile "alt_l" (jlgg-rtos alt_l nil nil))
(set_tile "anc_l" (jlgg-rtos anc_l nil nil))
(set_tile "llh" (jlgg-rtos llh nil nil))
(set_tile "llv" (jlgg-rtos llv nil nil))
(set_tile "t_lad" (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_l" "(do_num_l $key \"Altura de Ladrillo \" 6)")
(action_tile "anc_l" "(do_num_l $key \"Anchura de Ladrillo \" 6)")
(action_tile "llh" "(do_num_l $key \"Llaga Horizontal \" 4)")
(action_tile "llv" "(do_num_l $key \"Llaga Vertical \" 4)")
(action_tile "tipo_l" "(setq cod_imgl (read $value))(img_ladrillo)")
(action_tile "p_lad" "(setq p_dia (done_dialog 2))")
(action_tile "cancel" "(setq p_dia (done_dialog 0))")
(action_tile "accept" "(ladrillo_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 Ladrillo: ")))
(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 "cod_imgl" cod_imgl)
(cons "alt_l" alt_l )
(cons "anc_l" anc_l )
(cons "llh" llh )
(cons "llv" llv )
)
)
(if SaveVals
;;Valores al diccionario
(vlax-ldata-put "DICT_LaMarmita" "LADRILLO" RetVal)
)
)
);c.cond
);c.while
RetVal
);c.defun
(princ)
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.
no veo el lisp que pudiera ayudarme dentro de una rutina lisp yo quiero saber los pasos para net origen escala luego seleccionar es decir la sintaxis
ResponderEliminar