Tengo el mismo problema con una rutina, y lo raro es que dicha rutina funciona en una cpu y en otra no, donde en las dos computadoras se tiene la misma versión de AutoCAD 2018.
Alguien puede ayudarme?
gherysalinas@gmail.com
este es el código:
; Calcula las areas en los puntos indicados o en objetos seleccionados
; Programa desarrollado por Mario Torres Pejerrey
; http://www.construcgeek.com/
;|Este es un lisp en formato original, se puede ver el código fuente, la intención, es de que el código fuente
; pueda ser modificado y adaptado a la necesidad de cada usuario, lo único que siempre se solicita en estos
; casos es de que siempre se haga referencia al autor del mismo (es decir que no se modifique la autoría del lisp),
; salvo que este se modifique ampliamente, si se construye un nuevo programa tomando como partes un lisp publicado,
; se debería de hacer el comentario de que parte del nuevo programa esta basado en el autor original.|;
; Programa descargado desde http://www.construcgeek.com
; ConstrucGeek 2008-2011
; Ultima actualización: 7.4 - 07 Julio 2011
;-----------------------------------------------------------------------------------------------------------------
; Cargar las funciones ActiveX (Visual Lisp)
(vl-load-com)
(setq AcadObj (vlax-get-acad-object))
(setq AcadDocument (vla-get-activedocument AcadObj))
(setq mspace (vla-get-modelspace AcadDocument))
; Función principal: Comando
(defun c:ax()
;Verificar existencia del archivo acetutil.fas;arx
(VerificarAcetutilTemp)
(setq ExisteEntidades (entnext)) ;Buscar entidades en el dibujo
(if (not (null ExisteEntidades)) ;Si existen
(progn ;Corra el programa
;Declaración de variables
(InicializarVariables)
;Cuerpo
(Main)
;Restablecer las variables a su estado original
(RestablecerVariables)
(acet-error-restore)
)
(acet-ui-message "Para hallar areas debe de existir entidades en el dibujo." "No se encontraron entidades" (+ (+ 0 48) 0))
)
(princ)
)
; Funciones complementarias============================================================
;======================================================================================
(defun VerificarAcetutilTemp()
(if (findfile "ai_utils.lsp")
(if (null ai_abort)
(if (= "not" (load "ai_utils" "not"))
(exit)
)
)
(exit)
)
)
(defun InicializarVariables()
(acet-error-init(list (list "cmdecho" 0 "osmode" 0 "DIMZIN" 1) T ))
;Guardamos los valores de las variables de AutoCAD para restablecerlas luego
(setq cmd (getvar "cmdecho"))
(setq osa (getvar "osmode"))
(setq supr (getvar "DIMZIN"))
(if (/= (getvar "Clayer") "__AX-ConstrucGeek__")
(setq CapaActual (getvar "Clayer"))
(setq CapaActual "0")
)
(setq hp1 (getvar "HPANG"))
(setq hp2 (getvar "HPBOUND"))
(setq hp3 (getvar "HPDOUBLE"))
(setq hp4 (getvar "HPNAME"))
(setq hp5 (getvar "HPSCALE"))
(setq hp6 (getvar "HPSPACE"))
(setq NombreUltEntIn (cdr (assoc 5 (entget (entlast))))) ;Tomar el nombre de la ultima entidad creada
(setq Pin 0)
(setq UBT 0)
(setq AREA 0)
(setq AreaHallada 0)
(setq InsertoTexto 0)
;Variable para resumir la ruta de ubicacion en el registro de AX
(setq ClaveAX "HKEY_CURRENT_USER\\Software\\Construcgeek.com\\AreasX.Lsp\\")
(SETVAR "modemacro" "http://www.construcgeek.com/")
;Descripción por defecto
(setq TextoDescripcion "")
(setq metroc "")
;Verificamos en el registro de windows y los valores del cuadro de diálogo Opciones de AX
;================================================================================================================================
;Verificamos el numero de decimales
(setq numDecimalesDef (vl-registry-read (strcat ClaveAX "Opciones") "Número de decimales"))
(if (null numDecimalesDef)(setq numDecimalesDef 2)) ;Si no esta almacenado en el registro: Nro de decimales por defecto
;Verificamos el color del achurado
(setq colAchuradoDef (vl-registry-read (strcat ClaveAX "Opciones") "Color de sombreado"))
(if (null colAchuradoDef)(setq colAchuradoDef "136")) ;Si no esta almacenado en el registro: Color 136
(setq colAchurado colAchuradoDef)
;Verificamos la escala de sombreado por defecto
(setq eSombreadoDef (vl-registry-read (strcat ClaveAX "Opciones") "Escala de sombreado"))
(if (null eSombreadoDef)
(setq eSombreadoDef 0.01)
(setq eSombreadoDef (atof eSombreadoDef))
)
;Verificamos la altura de texto a insertar por defecto
(setq hTextoDef (vl-registry-read (strcat ClaveAX "Opciones") "Altura de texto por defecto"))
(if (null hTextoDef)(setq hTextoDef 0.2)(setq hTextoDef (atof hTextoDef)))
;Verificamos si aplican conversiones al area hallada
(setq AplicarConverDEF (vl-registry-read (strcat ClaveAX "Opciones") "Aplicar conversiones al area"))
(if (null AplicarConverDEF)(setq AplicarConverDEF "0")) ;No se genera ninguna conversión
(setq AplicarConverValorDEF (vl-registry-read (strcat ClaveAX "Opciones") "Aplicar conversiones al area - Valor"))
(if (null AplicarConverValorDEF)(setq AplicarConverValorDEF 0.00)(setq AplicarConverValorDEF (atof AplicarConverValorDEF))) ;Por defecto 0.00
;Verificamos si se generan los sombreados
(setq GenSombreadoDEF (vl-registry-read (strcat ClaveAX "Opciones") "Generar el sombreado"))
(if (null GenSombreadoDEF)(setq GenSombreadoDEF "1")) ;Si se generan
;Verificamos el nombre del sombreado por defecto
(setq NomSombreadoDEF (vl-registry-read (strcat ClaveAX "Opciones") "Nombre del sombreado"))
(if (null NomSombreadoDEF)(setq NomSombreadoDEF "Solid"))
;Verificamos si se retiene el achurado
(setq RetAchuradoDEF (vl-registry-read (strcat ClaveAX "Opciones") "Retener el sombreado"))
(if (null RetAchuradoDEF)(setq RetAchuradoDEF "0"))
;Verificamos si se retienen los contornos
(setq RetConfornoDEF (vl-registry-read (strcat ClaveAX "Opciones") "Retener el contorno"))
(if (null RetConfornoDEF)(setq RetConfornoDEF "0"))
;Crea la capa por defecto de los objetos temporales
(CrearCapa "__AX-ConstrucGeek__")
(setq Msg "\nIndique un punto interno del área o [Seleccionar objeto/Opciones]<terminar>: ")
)
;Principal
;======================================================================================
(defun Main()
(while (not (null Pin))
(initget "Seleccionar Decimales Hatch Insertar HTexto Opciones Color")
(setq Pin (getpoint msg))
(Cond
;Se indicó un punto en pantalla
((EQ (type Pin) 'LIST)
(command "_-boundary" "_a" "_o" "_r" "_i" "_n" "" "" Pin "")
(setq NombreBOtEnt(cdr (assoc 5 (entget (entlast))))) ;Obtenemos el nombre de la ultima entidad creada
(setq TipoBOtEnt (cdr (assoc 0 (entget (entlast)))))
(setq ent (entlast))
;Si este nombre coincide con el almacenado al inicio del comando significa que no se ha creado ningun contorno
;por lo tanto no se llevan cabo las acciones
(if (and (/= NombreBOtEnt NombreUltEntIn) (/= "HATCH" (cdr (assoc 0 (entget (entlast))))))
(progn
(HallarArea ent)
(if (= GenSombreadoDEF "1")
(SombrearObjeto ent)
)
)
(acet-ui-message (strcat "El punto que a indicado no se encuentra en el interior de una área cerrada, ó debe de aproximarse mas a ella." "\nIndique un punto en el interior de un contorno válido.") "Indique un punto interno válido" (+ (+ 0 64) 0))
)
)
;Si se indico la opcion "Objeto"
((= Pin "Seleccionar")
(setq EntObjeto (ENTSEL "\nSeleccione las entidades polilínea a obtener el área: "))
(if (not (null EntObjeto))
(progn
(HallarArea (car EntObjeto))
(if (= GenSombreadoDEF "1")
(SombrearObjeto (car EntObjeto))
)
) ;Progn
) ;If
)
;Opcion "Insertar Texto"
((= PIN "Insertar")
(if (/= Area 0)
(progn
(setq UBT (GETPOINT "\nUbicación del texto de área:"))
(if (not (null UBT))
(progn
(setvar "Clayer" CapaActual)
(setq TextoAreaI (vla-AddText mspace (STRCAT "Area = " (RTOS AREA 2 NUMDECIMALESDEF) " m2") (vlax-3d-point (trans UBT 1 0)) HTEXTODEF))
(setq MSG "\nIndique un punto interno del área o [Seleccionar objeto/Opciones]<terminar>: ")
(command "_-layer" "_S" "__AX-ConstrucGeek__" "")
)
)
(setq InsertoTexto 1) ;Se inserto un texo
(setq AREA 0)
)
(acet-ui-message (strcat "Para poder insertar un texto con el área debe de" "\nhallar una nueva área de un contorno válido.") "Halle una área nueva" (+ (+ 0 64) 0))
)
)
;Si se indico la opcion "oPciones"
((OR (= PIN "Opciones") (= PIN "Decimales")(= PIN "Color")(= PIN "Hatch")(= PIN "HTexto"))
(Opciones)
)
;Se presionó enter y no se ha hallado ninguna aerea hasta el momento
((and (null pin) (= AREA 0))
(progn
(setq Pin nil)
(if (= InsertoTexto 1) ;Si se inserto un texto al finalizar tambien se deben de borrar los objetos de sombreado
(BorrarObjetos)
(BorrarCapa) ;Si no solo borrar la capa temporal
)
)
(princ)
)
;Se presionó enter y se ha hallado aerea
((and (null pin) (/= AREA 0))
(progn
(CambiarTexto)
(BorrarObjetos)
)
)
);Cond
);While
);Defun
(defun HALLARAREA (EntArea)
(SETQ ObjArea (vlax-ename->vla-object EntArea))
(if (vlax-property-available-p ObjArea 'Area)
(progn
(setq AREAHALLADA (vlax-get-property objArea "Area"))
(cond
((= AplicarConverDEF "0")
(Setq Textconver "\nConversión: Ninguna")
)
((= AplicarConverDEF "1")
(Setq Textconver (strcat "\nConversión: Suma [Valor: " (rtos AplicarConverValorDEF 2 3) "]"))
(setq AREAHALLADA (+ AREAHALLADA AplicarConverValorDEF))
)
((= AplicarConverDEF "2")
(Setq Textconver (strcat "\nConversión: Resta [Valor: " (rtos AplicarConverValorDEF 2 3)"]"))
(setq AREAHALLADA (- AREAHALLADA AplicarConverValorDEF))
)
((= AplicarConverDEF "3")
(Setq Textconver (strcat "\nConversión: Multiplicación [Valor: " (rtos AplicarConverValorDEF 2 3)"]"))
(setq AREAHALLADA (* AREAHALLADA AplicarConverValorDEF))
)
((= AplicarConverDEF "4")
(Setq Textconver (strcat "\nConversión: División [Valor: " (rtos AplicarConverValorDEF 2 3)"]"))
(setq AREAHALLADA (/ AREAHALLADA AplicarConverValorDEF))
)
)
(setq AREA (+ AREA AREAHALLADA))
(setq PRINA (STRCAT "\n\nArea hallada = " (RTOS AREAHALLADA 2 NUMDECIMALESDEF) " m2; Acumulada = " (RTOS AREA 2 NUMDECIMALESDEF) " m2"))
(setq PRINTOTAL (STRCAT "\n\nArea Acumulada = " (RTOS AREA 2 NUMDECIMALESDEF) " m2"))
(PRINC Textconver)
(PRINC PRINA)
(setq MSG "\nIndique un punto interno del área o [Seleccionar objeto/Insertar texto área/Opciones]<cambiar texto>: ")
)
(acet-ui-message (strcat "El objeto seleccionado no contiene un área." "\nSeleccione un objeto del cual se pueda obtener su área." ) "Seleccione un objeto válido" (+ (+ 0 64) 0))
)
)
(Defun SombrearObjeto (EntSomb)
(setq TIPOOBJETO (CDR (ASSOC 0 (ENTGET EntSomb))))
;Filtramos los objetos permitidos
(If (or (= TIPOOBJETO "LWPOLYLINE")(= TIPOOBJETO "ELLIPSE")(= TIPOOBJETO "CIRCLE")(= TIPOOBJETO "REGION"))
(progn
;(command "-hatch" "O" "S" (strcat (rtos (car Pin) 2 3)"," (rtos (cadr pin) 2 3)) "N" "P" "ansi31" eSombreadoDef "0" "S" EntSomb "")
(command "_hatch" NomSombreadoDEF eSombreadoDef "0" EntSomb "")
(command "_change" "_l" "" "_p" "_c" colAchuradoDef "")
)
)
)
(defun CAMBIARTEXTO()
(setq ENT (ENTSEL "\nSeleccione el texto o atributo a cambiar la medida <Mostrar>: "))
(if (not (null ent))
(progn
(setq TIPOOBJETO (CDR (ASSOC 0 (ENTGET (CAR ENT)))))
(COND
((or (= TIPOOBJETO "TEXT") (= TIPOOBJETO "MTEXT"))
(setq NENT (CAR ENT))
(setq ENTTEXTSEL (vlax-ename->vla-object NENT))
(setq TEXTO (vla-get-TextString ENTTEXTSEL))
(cond
((wcmatch TEXTO "*=*")
(setq UBI= (VL-STRING-POSITION (ASCII "=") TEXTO))
)
((wcmatch TEXTO "*:*")
(setq UBI= (VL-STRING-POSITION (ASCII ":") TEXTO))
)
((and (not (wcmatch TEXTO "*=*"))(not(wcmatch TEXTO "*:*")))
(setq UBI= nil)
)
)
(if (not (null UBI=))
(progn
(setq DespuesDeIgual (SUBSTR TEXTO (+ UBI= 2) (strlen texto)))
(if (wcmatch DespuesDeIgual " *")
(setq TEXTODESCRIPCION (strcat (SUBSTR TEXTO 1 (+ UBI= 1)) " "))
(setq TEXTODESCRIPCION (SUBSTR TEXTO 1 (+ UBI= 1)))
)
(if (wcmatch DespuesDeIgual "* m*")
(setq metroc " m2")
(progn
(if (wcmatch DespuesDeIgual "*m*")
(setq metroc "m2")
(setq metroc "")
)
)
)
)
(setq TEXTODESCRIPCION "" metroc "")
)
(vla-put-TextString ENTTEXTSEL (strcat TEXTODESCRIPCION (rtos AREA 2 NUMDECIMALESDEF) metroc))
)
((= TIPOOBJETO "INSERT")
(SETQ ObjBloque (vlax-ename->vla-object (car ENT)))
(if (equal (vlax-get-property objBloque "HasAttributes") :vlax-true)
(progn
(setq UBIATRIBUTO (CADR ENT))
(command "_-ATTEDIT" "" "" "" "" UBIATRIBUTO "" "_v" "_R" (RTOS AREA 2 NUMDECIMALESDEF) "_n")
)
(acet-ui-message "El bloque seleccionado no tiene atributos." "Error de selección" (+ (+ 0 64) 0))
)
)
((AND (/= TIPOOBJETO "TEXT") (/= TIPOOBJETO "MTEXT")(/= TIPOOBJETO "INSERT"))
(acet-ui-message "Debe de seleccionar un TEXTO O ATRIBUTO para reemplazarlo por el área hallada." "Error de selección" (+ (+ 0 64) 0))
(CAMBIARTEXTO)
)
)
)
(progn
(setq PRINTOTAL (STRCAT "\n\nArea = " (RTOS AREA 2 NUMDECIMALESDEF) " m2"))
(princ PRINTOTAL)
)
) ;If
);Defun
(defun CrearCapa(NombreCapa)
(setq NombreCapaObj (vl-catch-all-apply 'vla-add (list (vla-get-layers AcadDocument) NombreCapa)))
;(vla-put-color NombreCapaObj colAchuradoDef)
(vla-put-color NombreCapaObj "30")
(command "_-layer" "_S" NombreCapa "")
)
(defun CrearCapaPerman(NombreCapa ColorCapa)
(setq NombreCapaObjPerman (vl-catch-all-apply 'vla-add (list (vla-get-layers AcadDocument) NombreCapa)))
(vla-put-color NombreCapaObjPerman ColorCapa)
(command "_-layer" "_S" NombreCapa "")
)
(defun BORRAROBJETOS ()
(IF (= RetAchuradoDef "0") ;Si se ha elegido no retener el sombreado despues de arear
(progn
(setq conj (ssget "x" (list (cons 8 "__AX-ConstrucGeek__") (cons 0 "HATCH"))))
(if (not (null conj))(command "_Erase" conj ""))
)
) ;IF
(IF (= RetConfornoDEF "0") ;Si se ha elegido no retener el contorno despues de arear
(progn
(setq conj (ssget "x" (list (cons 8 "__AX-ConstrucGeek__") (cons 0 "REGION"))))
(if (not (null conj))(command "_Erase" conj ""))
)
)
(IF (and (= RetAchuradoDef "0")(= RetConfornoDEF "0"))
(BorrarCapa)
(BuscarYCambiarCapa "SombreadoAreas" colAchuradoDef)
)
) ;Defun
(Defun BuscarYCambiarCapa(NombreCapaBusCrear ColorCapa)
(setq CapaSombreadoAreas (tblsearch "LAYER" NombreCapaBusCrear T)) ;Buscamos la capa
(if (null CapaSombreadoAreas) ;Si no existe la capa "SombreadoAreas" la creamos
(crearCapaPerman NombreCapaBusCrear ColorCapa)
)
(setq conj (ssget "x" (list (cons 8 "__AX-ConstrucGeek__")))) ;Cambiamos los achurados a la nueva capa creada
(if (not (null conj))(command "_change" conj "" "_p" "_LA" NombreCapaBusCrear ""))
(BorrarCapa)
)
(defun BorrarCapa ()
(setvar "Clayer" CapaActual)
(if (vl-catch-all-error-p (vl-catch-all-apply 'vla-delete (list (vl-catch-all-apply 'vla-item (list (vla-get-layers AcadDocument) "__AX-ConstrucGeek__")))))
nil ; name cannot be purged or doesn't exist
T ; name purged
)
)
;Crear el archivo temporal de definición de cuadros de diálogo
(defun Crear_CuadroDialogoOpciones ( / fn Cuadro1A Cuadro1B Cuadro2 Cuadro3A Cuadro3B Cuadro4)
(setq fname (vl-filename-mktemp "Ax.dcl"))
(setq fn (open fname "w"))
(setq Cuadro1A "dlg_AreasX : dialog {
label = \"AreasX 7.4\";
: boxed_column {
label=\"Areas\";
: column {
: edit_box { key = \"txtNumeroDecimales\"; fixed_height = true; allow_accept = true; fixed_width = true; alignment = center; label = \"Número de decimales \"; mnemonic = \"N\";}
: edit_box { key = \"txtAlturaTexto\"; fixed_height = true; allow_accept = true; fixed_width = true; alignment = center; label = \"Altura del texto a insertar\"; mnemonic = \"A\";}
}
spacer;
}
: boxed_column {
label=\"Conversiones de areas\";
: radio_button {
key = \"rbcNinguno\" ;
label = \"&Ninguno\" ;
value = \"1\" ;
}
: radio_button {
key = \"rbcSumar\" ;
label = \"S&umar \" ;
value = \"0\" ;
}
: radio_button {
key = \"rbcRestar\" ;
label = \"&Restar\" ;
value = \"0\" ;
}
: radio_button {
key = \"rbcMultiplicar\" ;
label = \"Mu<iplicar\" ;
value = \"0\" ;
}
: radio_button {
key = \"rbcDividir\" ;
label = \"&Dividir\" ;
value = \"0\" ;
}
: edit_box { key = \"txtConversionArea\"; fixed_height = true; allow_accept = true; fixed_width = true; alignment = center; label = \"Valor\"; mnemonic = \"V\";}
spacer;
}
: boxed_column {
label= \"Sombreado \";
: toggle {
label = \"Aplicar sombreados\";
key = \"chkSombrearAreas\";
mnemonic = \"S\";
fixed_width = true;
}
: edit_box { key = \"txtNomSombreado\"; fixed_height = true; allow_accept = true; fixed_width = true; alignment = center; label = \"Nombre del sombreado \"; mnemonic = \"o\";}
spacer;
: row {
: edit_box { key = \"txtEscalaHatch\"; fixed_height = true; allow_accept = true; fixed_width = true; alignment = center; label = \"Escala \"; mnemonic = \"E\";}
: text {label = \"Color\"; key = \"lblColor\";}
: image_button {
key = \"imagenColor\";
color = 0;
fixed_height = true;
fixed_width = true;
width = 9.3;
height = 1.5;
}
}
spacer;
}" )
(setq Cuadro1B "
: boxed_column {
label= \"Terminado el areado \";
: toggle {
label = \"Retener los contornos\";
key = \"chkRetContorno\";
mnemonic = \"c\";
fixed_width = true;
}
spacer;
: toggle {
label = \"Retener el sombreado\";
key = \"chkRetSombreado\";
mnemonic = \"R\";
fixed_width = true;
}
spacer;
}
spacer_1;
: row {
fixed_width=true;
alignment = centered;
: button { fixed_width=true; is_default=true; key=\"accept\"; label= \"Aceptar\"; mnemonic = \"A\"; }
: button { fixed_width=true; is_cancel=true; key=\"cancel\"; label= \"Cancelar\"; mnemonic = \"C\"; }
: button { fixed_width=true; is_cancel=false; key=\"Acerca\"; label= \"Acerca...\"; mnemonic = \"r\"; }
}
spacer;
}" )
(setq Cuadro2 "dlg_Acerca: dialog {
label = \"Acerca de AreasX\";
:paragraph {
spacer_1;
: text {label=\" Programa AreasX, Versión 7.4, Comando: AX\";}
spacer_1;
: text {label=\" Lisp Desarrollado por Mario Torres Pejerrey. 1999-2011\";}
: text {label=\" Web: www.construcgeek.com\";}
: text {label=\" Ultima actualización: 07 Julio 2011\";}
}
spacer_1;
: row {
fixed_width=true;
alignment=right;
: button {
fixed_width=true;
width=13;
key=\"accept7\";
is_default=true;
label= \"&Aceptar\";
}
}
spacer;
}")
(write-line Cuadro1A fn)(write-line Cuadro1B fn)(write-line Cuadro2 fn)
(close fn)
);defun
;CUADRO DE DIALOGO OPCIONES (PRINCIPAL)
;////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
(defun Opciones()
(crear_CuadroDialogoOpciones)
(setq ind (LOAD_DIALOG fname));(Cargar_CuadroOpciones)
(if (not (new_dialog "dlg_AreasX" ind))(exit))
(valoresOpciones)
(accionesOpciones)
(START_DIALOG)
(UNLOAD_DIALOG ind)
(vl-file-delete fname)
(princ)
)
(defun valoresOpciones ()
; Se define los valores por defecto.
(SET_TILE "txtNumeroDecimales" (ITOA numDecimalesDef))
(MODE_TILE "txtNumeroDecimales" 2)
(SET_TILE "txtAlturaTexto" (Rtos hTextoDef))
(MODE_TILE "txtAlturaTexto" 3)
(Setq ValorrbcNinguno "0")
(Setq ValorrbcSumar "0")
(Setq ValorrbcRestar "0")
(Setq ValorrbcMultiplicar "0")
(Setq ValorrbcDividir "0")
(MODE_TILE "txtConversionArea" 0)
(SET_TILE "txtConversionArea" (Rtos AplicarConverValorDEF))
(cond
((= AplicarConverDEF "0")
(Setq ValorrbcNinguno "1")
(MODE_TILE "txtConversionArea" 1)
)
((= AplicarConverDEF "1")
(Setq ValorrbcSumar "1")
)
((= AplicarConverDEF "2")
(Setq ValorrbcRestar "1")
)
((= AplicarConverDEF "3")
(Setq ValorrbcMultiplicar "1")
)
((= AplicarConverDEF "4")
(Setq ValorrbcDividir "1")
)
)
(SET_TILE "rbcNinguno" ValorrbcNinguno)
(SET_TILE "rbcSumar" ValorrbcSumar)
(SET_TILE "rbcRestar" ValorrbcRestar)
(SET_TILE "rbcMultiplicar" ValorrbcMultiplicar)
(SET_TILE "rbcDividir" ValorrbcDividir)
(SET_TILE "chkSombrearAreas" GenSombreadoDEF)
(SETQ ACTDESOM (- 1 (atoi GenSombreadoDEF))) (MODE_TILE "txtNomSombreado" ACTDESOM) (MODE_TILE "txtEscalaHatch" ACTDESOM) (MODE_TILE "imagenColor" ACTDESOM) (MODE_TILE "lblColor" ACTDESOM) (MODE_TILE "chkRetSombreado" ACTDESOM)
(SET_TILE "txtNomSombreado" NomSombreadoDEF)
(SET_TILE "txtEscalaHatch" (Rtos eSombreadoDef))
(MODE_TILE "txtEscalaHatch" 3)
(SET_TILE "chkRetContorno" RetConfornoDEF)
(SET_TILE "chkRetSombreado" RetAchuradoDEF)
(setq ancho (DIMX_TILE "imagenColor") alto(DIMY_TILE "imagenColor"))
(START_IMAGE "imagenColor")
(FILL_IMAGE 0 0 ancho alto (atoi colAchuradoDef))
(END_IMAGE)
)
(defun accionesOpciones()
(ACTION_TILE "imagenColor" "(SeleccionarColor)")
(ACTION_TILE "rbcNinguno" "(setq AplicarConver \"0\") (MODE_TILE \"txtConversionArea\" 1)")
(ACTION_TILE "rbcSumar" "(setq AplicarConver \"1\") (MODE_TILE \"txtConversionArea\" 0)")
(ACTION_TILE "rbcRestar" "(setq AplicarConver \"2\") (MODE_TILE \"txtConversionArea\" 0)")
(ACTION_TILE "rbcMultiplicar" "(setq AplicarConver \"3\") (MODE_TILE \"txtConversionArea\" 0)")
(ACTION_TILE "rbcDividir" "(setq AplicarConver \"4\") (MODE_TILE \"txtConversionArea\" 0)")
(ACTION_TILE "chkSombrearAreas" "(SETQ ACTDESOM (- 1 (atoi $Value))) (MODE_TILE \"txtNomSombreado\" ACTDESOM) (MODE_TILE \"txtEscalaHatch\" ACTDESOM) (MODE_TILE \"imagenColor\" ACTDESOM) (MODE_TILE \"lblColor\" ACTDESOM) (MODE_TILE \"chkRetSombreado\" ACTDESOM) ")
(ACTION_TILE "accept" "(chequearErr) (IF erroresChek () (Aceptar))")
(ACTION_TILE "cancel" "(DONE_DIALOG)")
(ACTION_TILE "Acerca" "(acercade)")
)
(defun SeleccionarColor()
(setq colAchurado (acad_colordlg (ATOI colAchurado)))
(if (null colAchurado)
(setq colAchurado colAchuradoDef)
(progn
(setq colAchurado (ITOA colAchurado))
(START_IMAGE "imagenColor")
(FILL_IMAGE 0 0 ancho alto (ATOI colAchurado))
(END_IMAGE)
)
)
)
(Defun chequearErr()
(SETQ erroresChek nil)
;Numero de decimales
(if (< (ATOI (GET_TILE "txtNumeroDecimales")) 0)
(progn
(SETQ erroresChek T)
(acet-ui-message "El número de decimales para las areas no puede ser menor que 0." "Error en los decimales para areas" (+ (+ 0 64) 0))
(MODE_TILE "txtNumeroDecimales" 2)
)
)
(if (<= (ATOF (GET_TILE "txtAlturaTexto")) 0)
(progn
(SETQ erroresChek T)
(acet-ui-message "La altura del texto a insertar no puede ser 0 ó menor que 0." "Error en la altura de texto" (+ (+ 0 64) 0))
(MODE_TILE "txtAlturaTexto" 2)
)
)
(if (< (ATOF (GET_TILE "txtConversionArea")) 0)
(progn
(SETQ erroresChek T)
(acet-ui-message "El valor de conversión no puede ser menor que 0." "Error en el valor de conversión" (+ (+ 0 64) 0))
(MODE_TILE "txtConversionArea" 2)
)
)
(if (<= (ATOF (GET_TILE "txtEscalaHatch")) 0)
(progn
(SETQ erroresChek T)
(acet-ui-message "La escala del achurado no puede ser 0 ó menor que 0." "Error en la escala de achurado" (+ (+ 0 64) 0))
(MODE_TILE "txtEscalaHatch" 2)
)
)
)
(defun aceptar()
(SETQ NUMDECIMALESDEF (ATOI (GET_TILE "txtNumeroDecimales")))
(VL-REGISTRY-WRITE (strcat ClaveAX "Opciones") "Número de decimales" NUMDECIMALESDEF)
(SETQ HTEXTODEF (ATOF (GET_TILE "txtAlturaTexto")))
(VL-REGISTRY-WRITE (strcat ClaveAX "Opciones") "Altura de texto por defecto" (rtos HTEXTODEF 2 3))
(setq AplicarConverDEF AplicarConver)
(SETQ AplicarConverValorDEF (ATOF (GET_TILE "txtConversionArea")))
(VL-REGISTRY-WRITE (strcat ClaveAX "Opciones") "Aplicar conversiones al area" AplicarConver)
(VL-REGISTRY-WRITE (strcat ClaveAX "Opciones") "Aplicar conversiones al area - Valor" (rtos AplicarConverValorDEF 2 3))
(setq GenSombreadoDEF (GET_TILE "chkSombrearAreas"))
(VL-REGISTRY-WRITE (strcat ClaveAX "Opciones") "Generar el sombreado" GenSombreadoDEF)
(SETQ NomSombreadoDEF (GET_TILE "txtNomSombreado"))
(VL-REGISTRY-WRITE (strcat ClaveAX "Opciones") "Nombre del sombreado" NomSombreadoDEF)
(setq ESOMBREADODEF (ATOF (GET_TILE "txtEscalaHatch")))
(VL-REGISTRY-WRITE (strcat ClaveAX "Opciones") "Escala de sombreado" (rtos ESOMBREADODEF 2 3))
(setq RetConfornoDEF (GET_TILE "chkRetContorno"))
(VL-REGISTRY-WRITE (strcat ClaveAX "Opciones") "Retener el contorno" RetConfornoDEF)
(setq RetAchuradoDEF (GET_TILE "chkRetSombreado"))
(VL-REGISTRY-WRITE (strcat ClaveAX "Opciones") "Retener el sombreado" RetAchuradoDEF)
(setq colAchuradoDef colAchurado)
(VL-REGISTRY-WRITE (strcat ClaveAX "Opciones") "Color de sombreado" colAchuradoDef)
(DONE_DIALOG 1)
)
;Cuadro de mensaje tipo Visual Basic
(defun Msgbox (Mensaje Titulo Tipo Icono BotonDefecto / Respuesta)
(setq acet-id (acet-ui-message Mensaje Titulo (+ (+ Tipo Icono) BotonDefecto)))
(cond
((= acet-id 1) (setq Respuesta "OK"))
((= acet-id 2) (setq Respuesta "CANCEL"))
((= acet-id 3) (setq Respuesta "ABORT"))
((= acet-id 4) (setq Respuesta "RETRY"))
((= acet-id 5) (setq Respuesta "IGNORE"))
((= acet-id 6) (setq Respuesta "YES"))
((= acet-id 7) (setq Respuesta "NO"))
((= acet-id 8) (setq Respuesta "CLOSE"))
((= acet-id 9) (setq Respuesta "HELP"))
;(t nil)
)
)
(defun RESTABLECERVARIABLES ()
(SETVAR "HPANG" HP1)
(SETVAR "HPBOUND" HP2)
(SETVAR "HPDOUBLE" HP3)
(SETVAR "HPNAME" HP4)
(SETVAR "HPSCALE" HP5)
(SETVAR "HPSPACE" HP6)
(SETVAR "osmode" OSA)
(SETVAR "DIMZIN" SUPR)
)
(defun acercade()
(if (not (new_dialog "dlg_Acerca" ind))(exit))
(ACTION_TILE "accept7" "(DONE_DIALOG)")
(START_DIALOG)
(princ)
)
(setq MODEACT (getvar "MODEMACRO"))
(PRINC "\nPrograma AreasX")
(PRINC "\nVersión 7.4")
(PRINC "\nLisp Desarrollado por Mario Torres Pejerrey. - 1999 - 2011")
(PRINC "\nUltima actualización 08/07/2011")
(PRINC "\nHalla areas a partir de objetos.")
(PRINC "\nNombre de comando: AX")
(setvar "modemacro" "http://www.construcgeek.com/")
(PRINC)
