Pendiente - Cálculo y Dibujo

jueves, 7 de septiembre de 2017

Pitágoras. (Samos 585 a.C. - Metaponte 495 a.C.). LP2 = L2 + H2

La verdad es que yo siempre hago los cálculos de pendiente a mano o con la calculadora para los proyectos y dibujos que realizo, pero me encargaron un pequeño programa con cuadro de dialogo donde se pudiesen visualizar los cálculos.



El encargo era simplemente con los argumentos de “Longitud” y “Altura”, así que podéis imaginar lo simple del cálculo.

En un foro de Autodesk preguntaban por la iteración con los cuadros de dialogo y el cálculo con varios argumentos, el tema no era sobre la pendiente, pero hice el ejemplo de la está para visualizarlo en el foro.

Con estos trocitos de código y cuadro de dialogo desperdigados por ahí, decidí terminarlo y añadirlo al proyecto de “La Marmita” como una utilidad más.

Compativilidad
Probado en AutoCAD v.2015-2018 (x32-x64) y BricsCAD v.15 (x32-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
Para ejecutar la aplicación:
  • Utilice la orden PENDIENTE en la línea de comandos.
  • Icono de "Pendiente" del grupo "Geometría" en cinta de opciones.
  • Icono de "Pendiente" de la barra de herramientas "Geometría".
  • Opción "Pendiente" del apartado "Geometría" en la barra de menús clásica.

Usar la sección de "Cálculo"(2) del cuadro de dialogo para hacer los calculos de la pendiente.
Unicamente se pueden usar dos argumentos para el cálculo de pendiente.
Cuando hay dos argumentos marcados el boton "Calcular" se activará.
Para marcar otro argumento, en el caso de tener dos ya marcados, desmarque uno de ellos para marcar otro distinto.

Utilizar el desplegable de "Precisión" para visualizar los cálculos con más o menos decimales.
Utilizar el botón de "Calcular" o pulsar "INTRO" keyboard_return para mostrar los datos de cálculo actualizados en el cuadro de dialogo.
Utilizar el botón de "Imprimir" para mostrar los datos calculados en la pantalla de texto de AutoCAD.

NOTA: Prestar atención a la sección de avisos y errores (4) en la parte inferior del cuadro de dialogo.

Usar la sección de "Dibujo"(3) y el botón "<< Dibujar pendiente" del cuadro de dialogo para crear un gráfico (planta o alzado) con los resultados en el documento.

Opciones
  • Gráfico orientativo de pendiente: Se indicaran en este los argumentos marcados en las opciones de cálculo con un punto de color cian.
  • Zona de cálculo: Zona de argumentos y opciones para el cálculo de la pendiente.
    • Argumentos: Marcar y modificar los valores de estos las veces que sea necesario.
    • Calcular o INTRO: Calcula y muestra resultados en el cuadro de dialogo.
    • Imprimir: Calcula y muestra resultados en la pantalla de texto de AutoCad.
    • Precisión: Actualiza el número de decimales de los valores de argumentos.
  • Zona de Dibujo: Zona de opciones para dibujo del gráfico en el documento.
    • Tipo de gráfico: Planta o Alzado.
    • Capa del dibujo: Capa para el gráfico. Escriba o seleccione del desplegable una capa.
    • Estilo de texto: Estilo de texto para el gráfico. Escriba o seleccione del desplegable un estilo.
    • Altura de texto.
    • << Dibujar pendiente. Cierra el cuadro de dialogo y crea el gráfico en el documento.
Ejemplos:
Codigo y descarga.
Código
Select all
            
;;------------------------------------ Pendientes_DLG ----------------------------------;;
;; funcion de opciones del programa en cuadro de dialogo                                ;;
;;                                                                                      ;;
;;--------------------------------------------------------------------------------------;;
(defun Pendientes_DLG (/ ;|Registro|;  PDTE_DRAW_TYPE PDTE_VAL L_VAL H_VAL LP_VAL ANG1_VAL ANG2_VAL
                         PDTE_CALC *TEXTSTYLE* *LAYERDRAW* ESCHTXT U_DEC
           ;|Locales|;   FichDlg idxDlg action Pdte_Calc_Type &TmpStyles& &TmpLayers& DistTmp
                         LstCTRLsCalc *RetVal_Save* *RetVal_Calc* *KeyValTmp* *MsgTmp*
           ;|Funciones|; WriteDialogPendiente GetVal_Reg_Pendiente
                         Do_SelStyle Do_SelLay do_Chk_NameValid do_testAng do_testnum do_TestCalculo
                                       Do_Img_Pitagoras vectors_Pdte_Calc_Img SelectArgInImg Do_GetDistOnScreen
                                       Do_Check-Uncheck_Arg ChgEnabledDlg set_tile_ValsDecim Run_Calcular PrintCalculos
           ;|Funciones Calculo|; CALC_PDTE+L CALC_PDTE+H CALC_PDTE+LP CALC_L+H CALC_L+LP CALC_L+ANG1
                                 CALC_H+LP CALC_H+ANG1 CALC_LP+ANG1 
        )
 ;;--------------------------------- GetVal_Reg_Pendiente -------------------------------------
 ;;Datos de usuario para el programa Nivel_P obtenidos y guardados en el registro de Windows   
 ;; (mapcar (function (lambda (x) (set (read (car x)) (cadr x)))) (GetVal_Reg_Pendiente))      
 ;;--------------------------------------------------------------------------------------------
 (defun GetVal_Reg_Pendiente ( / LisVal RetVal lis_fle)
  (setq LisVal (list  ;;'("MinHoja" "0.35" t) ;;Force Write
         '("Pdte_Draw_Type" "Pdte_Draw_Elevated")
         '("PDTE_val" "75.0"   )
         '("L_val"    "4.0"    )
         '("H_val"    "3.0"    )
         '("LP_val"   "5.0"    )
         '("ANG1_val" "36.8699")
         '("ANG2_val" "53.1301")
         '("Pdte_Calc"  "(\"L\" \"H\")")
         '("*TextStyle*" "Arial")
         '("*LayerDraw*" "ARQ_Proyección")
         '("EscHTxt" "1.0000")
         '("u_dec"   4)
         ))
  (setq RetVal  (jlgg-GetVal_Reg_Command LisVal "Pendiente"))
 );c.defun
 
 ;;---------------------------------- WriteDialogPendiente ---------------------------------
 ;;                    Definir archivo de cuadro de dialogo                                 
 ;;-----------------------------------------------------------------------------------------
 (DEFUN WriteDialogPendiente ( / dir FichDlg openFile)
  (setq dir (getvar "TEMPPREFIX"))
  (setq FichDlg (strcat dir "$Pendiente$.dcl"))
  (cond
   ;;(T ;;Forzar reescribir el cuadro (programando)
   ((not (findfile FichDlg))
    (setq openFile (open FichDlg "w"))
      (write-line "aceptar_button : retirement_button {" openFile)
  (write-line "  label = \"<< &Dibujar pendiente\";" openFile)
  (write-line "  key = \"accept\";" openFile)
  (write-line "  is_default = false;" openFile)
  (write-line "}" openFile)
  (write-line "salir_button : retirement_button {" openFile)
  (write-line "  label = \"&Salir\";" openFile)
  (write-line "  key = \"cancel\";" openFile)
  (write-line "  is_cancel = true;" openFile)
  (write-line "}" openFile)
  (write-line "accept_cancel : column {" openFile)
  (write-line "  : row {" openFile)
  (write-line "    fixed_width = true;" openFile)
  (write-line "    alignment = centered;" openFile)
  (write-line "    aceptar_button;" openFile)
  (write-line "    : spacer { width = 2; }" openFile)
  (write-line "    salir_button;" openFile)
  (write-line "  }" openFile)
  (write-line "}" openFile)
  (write-line "calcular_button : button {" openFile)
  (write-line "  label = \"&Calcular\";" openFile)
  (write-line "  key = \"calcular\";" openFile)
  (write-line "  is_default = true;" openFile)
  (write-line "  fixed_width = false;" openFile)
  (write-line "}" openFile)
  (write-line "Std_radio_button : radio_button {" openFile)
  (write-line "                   vertical_margin = none;" openFile)
  (write-line "                   width = 1;" openFile)
  (write-line "                 }" openFile)
  (write-line "Std_toogle : toggle {" openFile)
  (write-line "             vertical_margin = none;" openFile)
  (write-line "             fixed_width = true;" openFile)
  (write-line "             width = 18.0;" openFile)
  (write-line "           }" openFile)
  (write-line "Std_edit_box : edit_box {" openFile)
  (write-line "               vertical_margin = none;" openFile)
  (write-line "               horizontal_margin = none;" openFile)
  (write-line "               fixed_width = true;" openFile)
  (write-line "               edit_width = 8;" openFile)
  (write-line "               height = 1.15;" openFile)
  (write-line "               alignment = bottom;" openFile)
  (write-line "               allow_accept = true;" openFile)
  (write-line "             }" openFile)
  (write-line "Std_btnGet : button {" openFile)
  (write-line "             horizontal_margin = none;" openFile)
  (write-line "             vertical_margin = none;" openFile)
  (write-line "             label = \"···\";" openFile)
  (write-line "             alignment = bottom;" openFile)
  (write-line "           }  " openFile)
  (write-line "" openFile)
  (write-line "" openFile)
  (write-line "// ---------------------------------------------------------------" openFile)
  (write-line "// CUADRO DE DIALOGO DE PENDIENTES                                " openFile)
  (write-line "// ---------------------------------------------------------------" openFile)
  (write-line "Pendiente : dialog {" openFile)
  (write-line "  fixed_width = true;" openFile)
  (write-line "  fixed_height = true;" openFile)
  (write-line "  label = \"Dibujo/Cálculo de Pendiente 2D\";" openFile)
  (write-line "  : row {" openFile)
  (write-line "    : boxed_column {" openFile)
  (write-line "      fixed_width = true;" openFile)
  (write-line "      fixed_height = false;" openFile)
  (write-line "      label = \"Cálculo: \";" openFile)
  (write-line "      : image {" openFile)
  (write-line "        key = \"Pdte_Calc_Img\";" openFile)
  (write-line "        width = 35.5;" openFile)
  (write-line "        fixed_width = true;" openFile)
  (write-line "        height = 10;" openFile)
  (write-line "        fixed_height = true;" openFile)
  (write-line "        color = graphics_background; //dialog_background" openFile)
  (write-line "      }" openFile)
  (write-line "      : spacer { height = 0.1; }" openFile)
  (write-line "      : row { " openFile)
  (write-line "        fixed_width = true;" openFile)
  (write-line "        : Std_toogle   {label = \"Pendiente ( % )\"; key = \"PDTE\";}" openFile)
  (write-line "        : text_part {label = \":\";}" openFile)
  (write-line "        : spacer { width = 0.8; }" openFile)
  (write-line "        : Std_edit_box {key = \"PDTE_val\";}" openFile)
  (write-line "        : text {label = \"%\";}" openFile)
  (write-line "      }" openFile)
  (write-line "      : row {" openFile)
  (write-line "        fixed_width = true;" openFile)
  (write-line "        : Std_toogle   {label = \"Longitud ( L )\"; key = \"L\";}" openFile)
  (write-line "        : text_part {label = \":\";}" openFile)
  (write-line "        : spacer { width = 0.8; }" openFile)
  (write-line "        : Std_edit_box {key = \"L_val\";}" openFile)
  (write-line "        : Std_btnGet   {key = \"L_get\";}" openFile)
  (write-line "      }" openFile)
  (write-line "      : row {" openFile)
  (write-line "        fixed_width = true;" openFile)
  (write-line "        : Std_toogle   {label = \"Altura ( H )\"; key = \"H\";}" openFile)
  (write-line "        : text_part {label = \":\";}" openFile)
  (write-line "        : spacer { width = 0.8; }" openFile)
  (write-line "        : Std_edit_box {key = \"H_val\";}" openFile)
  (write-line "        : Std_btnGet   {key = \"H_get\";}" openFile)
  (write-line "      }" openFile)
  (write-line "      : row { " openFile)
  (write-line "        fixed_width = true;" openFile)
  (write-line "        : Std_toogle   {label = \"Long. pendiente ( LP )\"; key = \"LP\";}" openFile)
  (write-line "        : text_part {label = \":\";}" openFile)
  (write-line "        : spacer { width = 0.8; }" openFile)
  (write-line "        : Std_edit_box {key = \"LP_val\";}" openFile)
  (write-line "        : Std_btnGet   {key = \"LP_get\";}" openFile)
  (write-line "      }" openFile)
  (write-line "      : row {" openFile)
  (write-line "        fixed_width = true;" openFile)
  (write-line "        : Std_toogle   {label = \"Ángulo ( A1 )\"; key = \"ANG1\";}" openFile)
  (write-line "        : text_part {label = \":\";}" openFile)
  (write-line "        : spacer { width = 0.8; }" openFile)
  (write-line "        : Std_edit_box {key = \"ANG1_val\";}" openFile)
  (write-line "        : text {label = \"°\";}" openFile)
  (write-line "      }" openFile)
  (write-line "      : row {" openFile)
  (write-line "        fixed_width = true;" openFile)
  (write-line "        : Std_toogle   {label = \"Ángulo ( A2 )\"; key = \"ANG2\";is_enabled = false;}" openFile)
  (write-line "        : text_part {label = \":\";}" openFile)
  (write-line "        : spacer { width = 0.8; }" openFile)
  (write-line "        : Std_edit_box {key = \"ANG2_val\";is_enabled = false;}" openFile)
  (write-line "        : text {label = \"°\";}" openFile)
  (write-line "      }" openFile)
  (write-line "      //: spacer { width = 0; }" openFile)
  (write-line "      calcular_button;" openFile)
  (write-line "      : row {" openFile)
  (write-line "        fixed_width = true;" openFile)
  (write-line "        : text {width = 6.5; key = \"lblPrec\";}// label = \"Precisión:\";" openFile)
  (write-line "        : popup_list {" openFile)
  (write-line "          horizontal_margin = none;" openFile)
  (write-line "          key = \"u_dec\";" openFile)
  (write-line "          list = \"0 \\n0.0 \\n0.00 \\n0.000 \\n0.0000 \\n0.00000 \\n0.000000 \\n0.0000000 \\n0.00000000 \\n0.000000000 \\n0.0000000000\";" openFile)
  (write-line "          fixed_width = true;" openFile)
  (write-line "          edit_width = 12;" openFile)
  (write-line "        }" openFile)
  (write-line "        : spacer { width = 0.0; }" openFile)
  (write-line "        : button {" openFile)
  (write-line "          horizontal_margin = none;" openFile)
  (write-line "          vertical_margin = none;" openFile)
  (write-line "          alignment = bottom;" openFile)
  (write-line "          label = \"&Imprimir\";" openFile)
  (write-line "          key = \"Imprimir\";" openFile)
  (write-line "          height = 1.75;" openFile)
  (write-line "          width = 12.5;" openFile)
  (write-line "          //is_enabled = false;" openFile)
  (write-line "        }" openFile)
  (write-line "      }" openFile)
  (write-line "      : paragraph {" openFile)
  (write-line "        : text_part {key = \"Nota1\";}" openFile)
  (write-line "      }" openFile)
  (write-line "      //: spacer { height = 0.0; }\t" openFile)
  (write-line "    }//c.boxed_column" openFile)
  (write-line "  }" openFile)
  (write-line "  : boxed_column {" openFile)
  (write-line "    label = \"Dibujo: \";" openFile)
  (write-line "    fixed_height = true;" openFile)
  (write-line "    : radio_row {" openFile)
  (write-line "      fixed_height = true;" openFile)
  (write-line "      fixed_width=true;" openFile)
  (write-line "      key = \"Pdte_Draw_Type\";" openFile)
  (write-line "      : Std_radio_button {label = \"Planta\"; key = \"Pdte_Draw_Floor\";}" openFile)
  (write-line "      : Std_radio_button {label = \"Alzado\"; key = \"Pdte_Draw_Elevated\";}" openFile)
  (write-line "    }//c.radio_row" openFile)
  (write-line "    : row {" openFile)
  (write-line "      vertical_margin = none;" openFile)
  (write-line "      fixed_height = true;" openFile)
  (write-line "      fixed_width = true;" openFile)
  (write-line "      : column {" openFile)
  (write-line "        fixed_height = true;" openFile)
  (write-line "        vertical_margin = none;" openFile)
  (write-line "        : text {" openFile)
  (write-line "          horizontal_margin = none;" openFile)
  (write-line "          label = \"Capa del dibujo:\";" openFile)
  (write-line "        }" openFile)
  (write-line "        : edit_box {" openFile)
  (write-line "          vertical_margin = none;" openFile)
  (write-line "          horizontal_margin = none;" openFile)
  (write-line "          key = \"*LayerDraw*\";" openFile)
  (write-line "          fixed_width = true;" openFile)
  (write-line "          width = 17.5;" openFile)
  (write-line "        }" openFile)
  (write-line "        : popup_list {" openFile)
  (write-line "          horizontal_margin = none;" openFile)
  (write-line "          vertical_margin = none;" openFile)
  (write-line "          key = \"lis_lay\";" openFile)
  (write-line "          fixed_width = true;" openFile)
  (write-line "          width = 17.5;" openFile)
  (write-line "        }" openFile)
  (write-line "      }" openFile)
  (write-line "      : spacer { width = 0.1; }" openFile)
  (write-line "      : column {" openFile)
  (write-line "        fixed_height = true;" openFile)
  (write-line "        vertical_margin = none;" openFile)
  (write-line "        : text {" openFile)
  (write-line "          horizontal_margin = none;" openFile)
  (write-line "          label = \"Estilo de texto:\";" openFile)
  (write-line "        }" openFile)
  (write-line "        : edit_box {" openFile)
  (write-line "          horizontal_margin = none;" openFile)
  (write-line "          vertical_margin = none;" openFile)
  (write-line "          key = \"*TextStyle*\";" openFile)
  (write-line "          fixed_width = true;" openFile)
  (write-line "          width = 17.5;" openFile)
  (write-line "        }" openFile)
  (write-line "        : popup_list {" openFile)
  (write-line "          horizontal_margin = none;" openFile)
  (write-line "          vertical_margin = none;" openFile)
  (write-line "          key = \"lis_stxt\";" openFile)
  (write-line "          fixed_width = true;" openFile)
  (write-line "          width = 17.5;" openFile)
  (write-line "        }" openFile)
  (write-line "      }" openFile)
  (write-line "    }//c.row" openFile)
  (write-line "    : spacer { height = 0.1; }" openFile)
  (write-line "    : edit_box {" openFile)
  (write-line "      fixed_width = true;" openFile)
  (write-line "      label = \"&Altura Texto:\";" openFile)
  (write-line "      key = \"EscHtxt\";" openFile)
  (write-line "      edit_width = 8;" openFile)
  (write-line "      value = \"1.0\";" openFile)
  (write-line "    }" openFile)
  (write-line "  }" openFile)
  (write-line "  //spacer_1;" openFile)
  (write-line "  accept_cancel;" openFile)
  (write-line "  errtile;" openFile)
  (write-line "  //ok_cancel_err;" openFile)
  (write-line "}" openFile)
    (close openFile)
   )
  );c.cond
  FichDlg
 );c.defun
 
 ;;_____________________________________________________________________;;
 ;;Calcular con Pendiente y Long                                        ;;
 (defun Calc_PDTE+L (pendiente l / h lp tg ang1 ang2)
  (setq pendiente (float pendiente) l (float l))
  (setq tg (/ pendiente 100.0))
  (setq h (* l tg))
  (setq lp (sqrt (+ (expt l 2) (expt h 2))))
  (setq Ang1 (atan tg))
  (setq Ang2 (- (/ pi 2) Ang1))
  (list pendiente l h lp Ang1 Ang2)
 )

 ;;_____________________________________________________________________;;
 ;;Calcular con Pendiente y Altura                                      ;;
 (defun Calc_PDTE+H (pendiente h / l lp tg ang1 ang2)
  (setq pendiente (float pendiente) h (float h))
  (setq tg (/ pendiente 100.0))
  (setq l (/ h tg))
  (setq lp (sqrt (+ (expt l 2) (expt h 2))))
  (setq Ang1 (atan tg))
  (setq Ang2 (- (/ pi 2) Ang1))
  (list pendiente l h lp Ang1 Ang2)
 )
 ;;_____________________________________________________________________;;
 ;;Calcular con Pendiente y Longitud de pendiente                       ;;
 (defun Calc_PDTE+LP (pendiente lp / l h tg ang1 ang2)
  (setq pendiente (float pendiente) lp (float lp))
  (setq tg (/ pendiente 100.0))
  (setq Ang1 (atan tg))
  ;;h = lp * sin(Ang1)
  (setq h (* lp (sin Ang1)))
  (setq l (/ h tg))
  (setq Ang2 (- (/ pi 2) Ang1))
  (list pendiente l h lp Ang1 Ang2)
 )
 ;;_____________________________________________________________________;;
 ;;Calcular con Longitud y Altura                                       ;;
 (defun Calc_L+H (l h /  lp tg pendiente ang1 ang2)
  (setq l (float l) h (float h))
  (setq lp (sqrt (+ (expt l 2) (expt h 2))))
  (setq tg (/ h l))
  (setq pendiente (* tg 100))
  (setq Ang1 (atan tg))
  (setq Ang2 (- (/ pi 2) Ang1))
  (list pendiente l h lp Ang1 Ang2)
 )

 ;;_____________________________________________________________________;;
 ;;Calcular con Longitud y longitud de pendiente                        ;;
 (defun Calc_L+LP (l lp /  h tg pendiente ang1 ang2)
  (setq l (float l) lp (float lp))
  (setq h (sqrt (- (expt lp 2) (expt l 2))))
  (setq tg (/ h l))
  (setq pendiente (* tg 100))
  (setq Ang1 (atan tg))
  (setq Ang2 (- (/ pi 2) Ang1))
  (list pendiente l h lp Ang1 Ang2)
 )
 ;;_____________________________________________________________________;;
 ;;Calcular con Longitud y Angulo agudo Ang1 (en radianes)              ;;
 (defun Calc_L+ANG1 (l Ang1 / h lp tg pendiente ang2)
  (setq l (float l) Ang1 (float Ang1))
  (setq tg (/ (sin Ang1) (cos Ang1)))
  (setq h (* tg l))
  (setq lp (sqrt (+ (expt l 2) (expt h 2))))
  (setq pendiente (* tg 100))
  (setq Ang2 (- (/ pi 2) Ang1))
  (list pendiente l h lp Ang1 Ang2)
 )
 ;;_____________________________________________________________________;;
 ;;Calcular con Altura y longitud de pendiente                          ;;
 (defun Calc_H+LP (h lp /  l tg pendiente ang1 ang2)
  (setq h (float h) lp (float lp))
  (setq l (sqrt (- (expt lp 2) (expt h 2))))
  (setq tg (/ h l))
  (setq pendiente (* tg 100))
  (setq Ang1 (atan tg))
  (setq Ang2 (- (/ pi 2) Ang1))
  (list pendiente l h lp Ang1 Ang2)
 )
 ;;_____________________________________________________________________;;
 ;;Calcular con altura y Angulo agudo Ang1 (en radianes)                ;;
 (defun Calc_H+ANG1 (h Ang1 / l lp tg pendiente ang2)
  (setq h (float h) Ang1 (float Ang1))
  (setq tg (/ (sin Ang1) (cos Ang1)))
  (setq l (/ h tg))
  (setq lp (sqrt (+ (expt l 2) (expt h 2))))
  (setq pendiente (* tg 100))
  (setq Ang2 (- (/ pi 2) Ang1))
  (list pendiente l h lp Ang1 Ang2)
 )
 ;;_____________________________________________________________________;;
 ;;Calcular con longitud de pendiente y Angulo agudo Ang1 (en radianes) ;;
 (defun Calc_LP+ANG1 (lp Ang1 / l h tg pendiente ang2)
  (setq lp (float lp) Ang1 (float Ang1))
  ;;h = lp * sin(Ang1)
  (setq h (* lp (sin Ang1)))
  ;;l= lp * cos(Ang1)
  (setq l (* lp (cos Ang1)))
  (setq tg (/ h l))
  (setq pendiente (* tg 100))
  (setq Ang2 (- (/ pi 2) Ang1))
  (list pendiente l h lp Ang1 Ang2)
 )    
 ;;__________________________________________________________________;;
        ;; Seleccion de un de los estilos de texto del dibujo               ;;
        ;; "*TextStyle*" "lis_stxt" &TmpStyles&        
        (defun Do_SelStyle (val / ssty)
         (cond
          ((> (setq val (read val)) 0)
           (setq ssty (nth val &TmpStyles&))
           (set_tile "*TextStyle*" ssty)
           (set_tile "lis_stxt" "0")
           (mode_tile "*TextStyle*" 2)
          )
         )
 )
 
 ;;_________________________________________________________________;;
        ;;Seleccion de una de las capas del dibujo                         ;;
        ;; "*LayerDraw*"  "lis_lay" &TmpLayers&
        (defun Do_SelLay (val / slay)
         (cond
          ((> (setq val (read val)) 0)
           (setq slay (nth val &TmpLayers&)) 
           (set_tile "*LayerDraw*" slay)
           (set_tile "lis_lay" "0")
           (mode_tile "*LayerDraw*" 2)
          )
         )
 );c.defun
  
 ;;_______________________________________________________________;;
 ;;Accion de chequeo de nombres para capas y estilos              ;;
 (defun do_Chk_NameValid ( ll mens / r)
  (setq r (vl-string-trim " " (get_tile ll)))
  (if (snvalid r)   ; si es valida
   (progn
    (set_tile "error" "")
    (set (read ll) r)
    (set_tile ll r)
   )
   (progn
    (set_tile "error" (strcat mens "NO VALIDO."))
    (mode_tile ll 2)(mode_tile ll 3)
   )
  );c.if
 )
      
        ;;_______________________________________________________________;;
 ;;Accion de chequeo de Angulos < 90°                             ;;
 (defun do_testAng ( ll mens cod / r Ar)
  (cond
   ((not (setq r (jlgg-test_numr (set (read ll) (get_tile ll)) mens cod)))
    (mode_tile ll 2)(mode_tile ll 3)
    nil
   )
   ((not (and (setq Ar (* pi (/ r 180.0)))
       (< 0 Ar (/ pi 2))))
    (mode_tile ll 2)(mode_tile ll 3)
    (set_tile "error" (strcat mens "no valido, Mayor de 90°"))
    nil
   )
   (T
    (set_tile "error" "")
    (set_tile ll (jlgg-rtos r nil u_dec))
    (set (read ll) r)
   )
  );c.cond
 );c.defun
 
 ;;_______________________________________________________________;;
 ;;Accion de chequeo de numeros                                   ;;
 (defun do_testnum ( ll mens cod / r)
  (if (setq r (jlgg-test_numr (set (read ll) (get_tile ll)) mens cod))   ; si es valida
   (progn
    (set_tile "error" "")
    (set_tile ll (jlgg-rtos r nil u_dec))
    (set (read ll) r)
   );c.prg
   (progn
    (mode_tile ll 2)(mode_tile ll 3)
    nil
   );c.prg
  );c.if
 );c.defun
 
 ;;___________________________________________________________________________;;
 ;;Test numerico y de cálculo cuando se modifica un valor de cálculo          ;;
 (defun do_TestCalculo ( key / KeyChk tst msg Tmp)
  (setq *ERROR_VAL* t)
  (setq KeyChk (vl-string-right-trim "_val" key))
  (if (not (setq msg (vl-some
        (function
         (lambda (x)
          (if (= (cdr (assoc 0 x)) KeyChk) (cdr (assoc 2 x)))
         )
        )
        LstCTRLsCalc
       )
     )
      );not
   (setq msg " ")
  )
  (if (member KeyChk '("ANG1"))
   (setq tst (do_testAng key msg 6))
   (setq tst (do_testnum key msg 6))
  )
  (setq *ERROR_VAL* (not tst))
 )

 ;;___________________________________________________________________________;;
 ;;imagen del cuadro de dialogo                                               ;;
 (defun Do_Img_Pitagoras (/ long alto modeT DrawType)
  ;;Floor or Elevated: 
  (start_image "Pdte_Calc_Img")
  (setq long (dimx_tile "Pdte_Calc_Img")
        alto (dimy_tile "Pdte_Calc_Img")
  )
  (fill_image 0 0 long alto -2)
  (if (boundp (read (strcat "vectors_" "Pdte_Calc_Img" )))
   (eval (read (strcat "(vectors_" "Pdte_Calc_Img" ")")))
  );c.if
  (end_image)
 );c.defun
 
 ;;Imagen del triangulo rectangulo
 (defun vectors_Pdte_Calc_Img ()
   (mapcar 'vector_image; Color 252
     (list 203 203  13 203 203  34  34)
     (list 102  23 102 102   6  96   6)
     (list 203 234  34 235 203  34  34)
     (list 125   8 102 102  23 125  69)
     (list 252 252 252 252 252 252 252)
   );mapcar
   (mapcar 'vector_image; Color 1
     (list  34  34 203)
     (list 102 102  23)
     (list 203 203 203)
     (list  23 102 102)
     (list   1   1   1)
   );mapcar
   (mapcar 'vector_image; Color 33
     (list 188 188 193 193 194 193 193 192 190 190 189 189 189 191 191 196 196 197 196 196 195 193 193 192 192 192 184 186 183 210 210 211 212 213 215 216 216 216 215 214 213 213 211  23  22  21)
     (list 116 116 111 111 109 108 108 107 107 107 108 108 109  46  46  40  40  39  38  37  37  37  37  38  38  39  43  37  46  32  32  33  33  33  33  31  30  29  28  28  28  28  24 109 110 111)
     (list 194 193 193 194 194 194 193 193 192 190 190 189 189 197 196 196 197 197 197 196 196 195 193 193 192 192 188 190 186 210 211 212 213 215 216 216 216 216 216 215 214 216 216  23  23  22)
     (list 116 112 112 110 110 109 108 108 107 108 108 109 109  46  42  42  39  39  39  38  37  37  37  37  39  39  43  46  37  32  33  33  33  33  32  32  31  30  29  28  28  24  24 118 109 110)
     (list  33  33  33  33  33  33  33  33  33  33  33  33  33  33  33  33  33  33  33  33  33  33  33  33  33  33  33  33  33  33  33  33  33  33  33  33  33  33  33  33  33  33  33  33  33  33)
   );mapcar
   (mapcar 'vector_image; Color 250
     (list 230 230  21  22  23  24  25  22)
     (list 116 108  19  19  18  17  15   7)
     (list 236 236  22  23  24  25  28  25)
     (list 108 116  19  18  17  15   7  15)
     (list 250 250 250 250 250 250 250 250)
   );mapcar
   (mapcar 'vector_image; Color 7
     (list 111 109 108  97 100  95 85 86 86 86 85 83 81 79 78 77 77 78 80 80 79 78 77 76 76 76 75 74 72 71 69 68 68 68 68 68 70 70 71 71 69 72 69 67 65 64 63 62 62 62 62 56 53 51 51 41 45 35 40 41 41 40 39 39 37 33 33 211 218 211 129 134 136 136 137 136 136 134 129 129 120 120 123 123 85 87 89  90 172 177 184 193 190 191 194 198 204 202 201 201 202 204 204 202 201 201 202 204  35  33  32  32  33  35 198 197 197 197 197 198)
     (list  83  84  85  90  83  94 73 69 67 64 62 60 58 57 57 68 68 68 68 69 71 72 71 70 69 69 61 62 63 63 63 64 64 65 66 67 67 67 65 64 63 75 79 78 77 75 73 70 67 65 65 82 77 72 72 76 75 86 84 82 81 79 79 78 78 81 81  65  60  60  45  45  44  44  41  40  39  39  39  39  50  39 118 107 78 84 90  96  38  46  52  56 102  97  93  90 104 104 102 102 100 100  25  25  23  23  21  21 104 104 102 102 100 100  98  98  97  96  96  96)
     (list 111 111 109 102 104 100 86 86 86 86 86 85 83 81 79 77 78 80 80 80 80 79 78 77 76 77 76 75 74 72 71 69 68 68 68 70 70 71 71 71 71 76 70 69 67 65 64 63 62 62 63 62 57 57 56 48 50 40 41 41 41 41 40 39 39 37 37 218 218 211 134 136 136 137 137 137 136 136 134 129 126 120 130 123 87 89 90  90 177 184 193 203 191 194 198 203 205 204 202 202 204 205 205 204 202 202 204 205  36  35  33  33  35  36 199 198 197 197 198 199)
     (list  94  83  84  90  94  83 71 71 69 67 64 62 60 58 57 68 68 68 69 70 70 71 72 71 70 68 60 61 62 63 63 63 65 66 67 68 68 66 66 65 64 60 80 79 78 77 75 73 70 67 64 79 75 69 82 73 85 84 83 83 82 81 79 79 78 78 91  65  71  71  45  44  44  43  43  41  40  39  39  50  50  50 118 118 84 90 96 102  46  52  56  57  97  93  90  89 102 104 104 100 100 102  23  25  25  21  21  23 102 104 104 100 100 102  97  98  98  97  96  97)
     (list   7   7   7   7   7   7  7  7  7  7  7  7  7  7  7  7  7  7  7  7  7  7  7  7  7  7  7  7  7  7  7  7  7  7  7  7  7  7  7  7  7  7  7  7  7  7  7  7  7  7  7  7  7  7  7  7  7  7  7  7  7  7  7  7  7  7  7   7   7   7   7   7   7   7   7   7   7   7   7   7   7   7   7   7  7  7  7   7   7   7   7   7   7   7   7   7   7   7   7   7   7   7   7   7   7   7   7   7   7   7   7   7   7   7   7   7   7   7   7   7)
   );mapcar
 )

 ;;_______________________________________________________________;;
 ;;Accion de seleccionar-deseleccionar argumentos en la imagen    ;;
 (defun SelectArgInImg ( / LstCtrlFill)
   (setq LstCtrlFill '(("PDTE" 22 87) ("L" 111 110) ("H" 224 62)
         ("LP" 107 41) ("ANG1" 118 85) ("ANG2" 154 57)))
   (start_image "Pdte_Calc_Img")
   (mapcar (function (lambda (x) (fill_image (cadr x) (caddr x) 8 8 -2))) LstCtrlFill)
   (setq LstCtrlFill (vl-remove-if-not (function (lambda (x) (member (car x) Pdte_Calc))) LstCtrlFill))
   (mapcar (function (lambda (x) (fill_image (cadr x) (caddr x) 8 8 4))) LstCtrlFill)
   (end_image)
 )

  ;;_______________________________________________________________;;
 ;;Accion de seleccionar-deseleccionar argumentos para el cálculo ;;
 (defun Do_Check-Uncheck_Arg (key Value / )
  ;(set_tile "error" "")
  (setq Pdte_Calc (vl-remove key Pdte_Calc))
  (if (= Value "1")
   (cond
    ((< (length Pdte_Calc) 2)
     (setq Pdte_Calc (cons key Pdte_Calc))
    )
    (T (set_tile key "0"))
   )
  )
  (SelectArgInImg)
  (ChgEnabledDlg)
 )

  ;;_______________________________________________________________;;
 ;;Activa-Desactiva argumentos para el cálculo                    ;;
        (defun ChgEnabledDlg ()
  (mapcar
   (function
    (lambda (lstKeys / k ks mode)
     ;;lstKeys : ((0 . "PDTE") (1 "PDTE_val") (2 . "Pendiente (%)"))
     (setq k (cdr (assoc 0 lstKeys))
    ks (cdr (assoc 1 lstKeys)))
     (setq mode (if (member k Pdte_Calc) 0 1))
     (mapcar (function (lambda (k1) (mode_tile k1 mode))) ks)
    )
   )
   (vl-remove-if (function (lambda (x) (member (cdr (assoc 0 x)) '("ANG2")))) LstCTRLsCalc)
  );mapcar
  (cond
   ((< (length Pdte_Calc) 2) 
    (mapcar (function (lambda (key)(mode_tile key 1)))'("calcular" "Imprimir" "accept"))
    (set_tile "error" "")
   )
   ((and (member "PDTE" Pdte_Calc)
  (member "ANG1" Pdte_Calc))
    (set_tile "error" "* Imposible calcular con: Pendiente (%) + Ángulo (A1) *")
    (mapcar (function (lambda (key)(mode_tile key 1)))'("calcular" "Imprimir" "accept"))
   )
   (T
    (mapcar (function (lambda (key)(mode_tile key 0)))'("calcular" "Imprimir" "accept"))
    (set_tile "error" "")
   )
  )
 )
        (eval (read (strcat "(vectors_" "Pdte_Calc_Img" ")")))
  ;;___________________________________________________________;;
 ;;Accion de Calcular con 2 datos  argumentos en la imagen    ;;
 (defun Run_Calcular ( / Arg1 Arg2 Val1 Val2 sFun1 sFun2 lstKeysCalc Result RetVal_Calc_Save)
  (cond
   (*ERROR_VAL*)
   ((= (length Pdte_Calc) 2)
    (setq Arg1 (car  Pdte_Calc)
   Arg2 (cadr Pdte_Calc))
    (setq Val1 (eval (read (strcat Arg1 "_val")))
   Val2 (eval (read(strcat Arg2 "_val"))))
    (if (wcmatch Arg1 "ANG*") (setq Val1 (* pi (/ Val1 180.0))))
    (if (wcmatch Arg2 "ANG*") (setq Val2 (* pi (/ Val2 180.0))))
    (setq sFun1 (strcat "CALC_" Arg1 "+" Arg2))
    (setq sFun2 (strcat "CALC_" Arg2 "+" Arg1))      
    (cond
     ((boundp (read sFun1))
      (setq sFun1 (eval (read sFun1))) ;CALC_L+H : #
      (setq Result (vl-catch-all-apply 'sFun1 (list Val1 Val2)))
     )
     ((boundp (read sFun2))
      (setq sFun2 (eval (read sFun2))) ;CALC_H+L : nil
      (setq Result (vl-catch-all-apply 'sFun2 (list Val2 Val1)))
      ;;(setq Result (eval (read sFun2)))
     )
    );c.cond
    (cond
     ((not Result)
      (set_tile "error" "ERROR: No se pudo calcular la pendiente.")
     )
     ((vl-catch-all-error-p Result)
      (set_tile "error" "ERROR: Error al calcular la pendiente.")
     )
     (T
      (set_tile "error" "")
      (setq lstKeysCalc '("PDTE_val" "L_val" "H_val" "LP_val" "ANG1_val" "ANG2_val"))
      (mapcar
       (function
        (lambda (key val)
  (if (wcmatch key "ANG*") (setq val (/ (* val 180) pi)))
  (set (read key) val)
        )
       )
       lstKeysCalc Result
      );c.mapcar
      (set_tile_ValsDecim) 
      (setq RetVal_Calc_Save (SaveDatToRegistry T nil))
     )
    );c.cond
   )
  );c.cond
  RetVal_Calc_Save
 )
 
  ;;___________________________________________________________;;
 ;;Imprimir calculos en pantalla de texto de autocad          ;;
 (defun PrintCalculos ()
  (cond
   ((Run_Calcular)
    ;;(princ "\n----------------------------------------------------")
    (princ "\n\nCalculos de Pendiente:")
    (princ "\nPendiente       ->\t")(princ (jlgg-rtos PDTE_val nil u_dec))(princ " %")
    (princ "\nLongitud        ->\t")(princ (jlgg-rtos L_val    nil u_dec))
    (princ "\nAltura          ->\t")(princ (jlgg-rtos H_val    nil u_dec))
    (princ "\nLong. Pendiente ->\t")(princ (jlgg-rtos LP_val   nil u_dec))
    (princ "\nAng1            ->\t")(princ (jlgg-rtos ANG1_val nil u_dec))(princ "°")
    (princ "\nAng2            ->\t")(princ (jlgg-rtos ANG2_val nil u_dec))(princ "°")
    (princ "\n----------------------------------------------------")
    (princ)
   )
  )
 )
  ;;___________________________________________________________;;
 ;;Salvar datos al registro de windows                        ;;
 (defun SaveDatToRegistry (Calc Draw / ListsKeys)
  (if Calc
   (setq Calc '("PDTE_val" "L_val" "H_val" "LP_val" "ANG1_val" "ANG2_val" "Pdte_Calc" "u_dec"))
  )
  (if Draw
   (setq Draw '("Pdte_Draw_Type" "*TextStyle*" "*LayerDraw*" "EscHTxt"))
  )
  (setq ListsKeys (append Calc Draw))
  (mapcar
   (function
    (lambda (s / tmp)
     (cond
      ((= (type (setq tmp (eval (read s)))) 'REAL)
       (jlgg-Write-Registry-Command "Pendiente" s (jlgg-rtos tmp nil 32))
      )
      ((= (type (setq tmp (eval (read s)))) 'LIST)
       (jlgg-Write-Registry-Command "Pendiente" s (vl-prin1-to-string tmp))
      )
      (T (jlgg-Write-Registry-Command "Pendiente" s tmp))
     );c.cond
     (cons s tmp)
    )
   )
   ListsKeys
  );c.mapcar
 ) 
 ;;___________________________________________________________;;
 ;;Asignación de decimales al cuadro de dialogo               ;;
 (defun Do_GetDistOnScreen (key / KeyChk sVal)
  ;;("L_get" "H_get" "LP_get")
  (setq *KeyValTmp* nil *MsgTmp* nil)
  (setq KeyChk (vl-string-right-trim "_get" key))
  (setq *MsgTmp*
   (vl-some
    (function (lambda (x)
     (if (= (cdr (assoc 0 x)) KeyChk) (cdr (assoc 2 x)))
    ))
    LstCTRLsCalc
   )
  );c.setq
  (if (not *MsgTmp*)
   (setq *MsgTmp* "\nDistancia ")
   (setq *MsgTmp* (strcat "\nDistancia para " *MsgTmp*))
  )
  (setq *KeyValTmp* (strcat KeyChk "_val"))
  (setq sVal (get_tile *KeyValTmp*))
  (setq *MsgTmp* (strcat *MsgTmp* "<" sVal ">: "))
  (setq p_dia_Pendiente (done_dialog 2))
 )

        ;;___________________________________________________________;;
 ;;Asignación de decimales al cuadro de dialogo               ;;
 (defun set_tile_ValsDecim ()
  (set_tile "PDTE_val" (jlgg-rtos PDTE_val nil u_dec))
  (set_tile "L_val"    (jlgg-rtos L_val    nil u_dec))
  (set_tile "H_val"    (jlgg-rtos H_val    nil u_dec))
  (set_tile "LP_val"   (jlgg-rtos LP_val   nil u_dec))
  (set_tile "ANG1_val" (jlgg-rtos ANG1_val nil u_dec))
  (set_tile "ANG2_val" (jlgg-rtos ANG2_val nil u_dec))
  (set_tile "EscHtxt"  (jlgg-rtos EscHTxt  nil u_dec))
 )
 
 ;;----------------------------- MAIN -----------------------------------------------
 (setq LstCTRLsCalc
  '(((0 . "PDTE") (1 "PDTE_val") (2 . "Pendiente (%) "))
    ((0 . "L") (1 "L_val" "L_get")(2 . "Longitud (L) "))
    ((0 . "H") (1 "H_val" "H_get")(2 . "Altura (H) ")) 
    ((0 . "LP") (1 "LP_val" "LP_get")(2 . "Long. Pendiente (LP) "))
    ((0 . "ANG1") (1 "ANG1_val")(2 . "Ángulo (A1) "))
    ((0 . "ANG2") (1 "ANG2_val")(2 . "Ángulo (A2) "))
   )
 )
 ;;Valores guardados en registro:
 ;;(("Pdte_Draw_Type" "Pdte_Draw_Floor") ("PDTE_val" "75.0") ("L_val" "4.0") ("H_val" "3.0")
 ;; ("LP_val" "5.0") ("ANG1_val" "36.8699") ("ANG2_val" "53.1301") ("Pdte_Calc" "(\"L\" \"H\")")
 ;; ("*TextStyle*" "Arial") ("*LayerDraw*" "ARQ_Proyección") ("EscHTxt" "1.000000000000000"))
 (mapcar
  (function
   (lambda (x)
    (set (read (car x))
  (if (member (car x) '("PDTE_val" "L_val" "H_val" "LP_val" "ANG1_val" "ANG2_val" "Pdte_Calc" "EscHTxt"))
   (read (cadr x))
   (cadr x)
  )
    )
   )
  )
  (GetVal_Reg_Pendiente)
 )
 ;;lista de capas del dibujo:
 (setq &TmpLayers& (jlgg-aux_tabla "layer" 5)
       &TmpLayers& (vl-sort &TmpLayers& '<)
       &TmpLayers& (cons "Seleccionar capa" &TmpLayers&))
 ;;lista de estilos de texto del dibujo:
 (setq &TmpStyles& (jlgg-aux_tabla "style" 5)
       &TmpStyles& (vl-sort &TmpStyles& '<)
       &TmpStyles& (cons "Seleccionar estilo" &TmpStyles&))
 
 ;;Carga el fichero de dialogo
 (if (null p_dia_Pendiente)(setq p_dia_Pendiente '(-1 -1)))
 (setq FichDlg (WriteDialogPendiente))
 (setq idxDlg (load_dialog FichDlg))
 (setq action T)
 
 ;;cargar el cuadro de dialogo en pantalla
 (while action
  (if (not (new_dialog "Pendiente" idxDlg "" p_dia_Pendiente)) (exit))
  ;;__________________________________;;
  ;;asignaciones de cuadro de dialogo ;;
  (Do_Img_Pitagoras) ;visualiza imagen
  (mapcar (function set_tile) Pdte_Calc '("1" "1"))
  (SelectArgInImg)
  (ChgEnabledDlg)
  (set_tile_ValsDecim)
  
  (set_tile "lblPrec" "Precisión:")
  (set_tile "u_dec" (itoa u_dec))
  (set_tile "Nota1" "NOTA: Se necesitan 2 argumentos marcados [X]")
    
  (set_tile "Pdte_Draw_Type" Pdte_Draw_Type)
  (set_tile "*LayerDraw*"     *LayerDraw*)
  (jlgg-initlstDlg "lis_lay"  &TmpLayers&)
  (set_tile "*TextStyle*"     *TextStyle*)
  (jlgg-initlstDlg "lis_stxt" &TmpStyles&)
  
  ;;Se ha obtenido una distancia en pantalla:
  (if *KeyValTmp* (Run_Calcular))
  (setq *KeyValTmp* nil)
  
  ;;__________________________________;;
  ;;acciones de cuadro de dialogo     ;;
  (mapcar
   (function
    (lambda (key)
     (action_tile key "(Do_Check-Uncheck_Arg $key $Value)")
    )
   )
   '("PDTE" "L" "H" "LP" "ANG1" "ANG2")
  )
  (action_tile "PDTE_val" "(do_TestCalculo $key)")
  (action_tile "L_val"    "(do_TestCalculo $key)")
  (action_tile "H_val"    "(do_TestCalculo $key)")
  (action_tile "LP_val"   "(do_TestCalculo $key)")
  (action_tile "ANG1_val" "(do_TestCalculo $key)")
  (action_tile "ANG2_val" "(do_TestCalculo $key)")
  (mapcar (function (lambda (key)
   (action_tile key "(Do_GetDistOnScreen $key)")
   ))
   '("L_get" "H_get" "LP_get")
  )
  (action_tile "calcular"  "(Run_Calcular)")
  (action_tile "Imprimir"  "(PrintCalculos)")
  (action_tile "u_dec" "(setq u_dec (atoi $value))(set_tile_ValsDecim)")
  ;;Keys de Dibujo:
  (action_tile "Pdte_Draw_Floor"    "(setq Pdte_Draw_Type $key)")
  (action_tile "Pdte_Draw_Elevated" "(setq Pdte_Draw_Type $key)")
  (action_tile "lis_lay"      "(Do_SelLay $value)")
  (action_tile "*LayerDraw*"  "(do_Chk_NameValid $key \"Nombre de Capa \")")
  (action_tile "lis_stxt"     "(Do_SelStyle $value)")
  (action_tile "*TextStyle*"  "(do_Chk_NameValid $key \"Estilo de texto \")")
  (action_tile "EscHtxt"      "(do_testnum $key \"Altura de Texto \" 6)")
  (action_tile "cancel"  "(setq p_dia_Pendiente (done_dialog 0))")
  (action_tile "accept"  "(if (setq *RetVal_Calc* (Run_Calcular))
                           (setq p_dia_Pendiente (done_dialog 1))
                          )")
  ;;__________________________________________________________;;
  (setq action (start_dialog))    ; activa el c. de dialogo

  ;;Decidir sobre las acciones done_dialog
  (cond                           
   ((= action 0);si cancel es señalado
    (setq action nil)
    (unload_dialog idxDlg)
    (setq *RetVal_Save* nil)
   );c.cond de action 0
   ((= action 1)
    (setq *RetVal_Save* (SaveDatToRegistry nil T))
    (setq *RetVal_Save* (append *RetVal_Calc* *RetVal_Save*))
    (setq action nil)
    (unload_dialog idxDlg)
   )
   ((= action 2)
    ;;*KeyValTmp* = "???_val"
    (if (setq DistTmp (jlgg-GetDistEx nil *MsgTmp* '(6)))
     (set (read *KeyValTmp*) DistTmp)
     (setq *KeyValTmp* nil)
    )
    (princ)
   )
  );c.cond
 );c.while
  *RetVal_Save*
)


;;********************************* C:Pendiente ****************************************;;
;;Revisiones:                                                                           ;;
;; Versión 2.0.0 - LaMarmita                                                            ;;
;; José Luis García Galán 28/08/17                                                      ;;
;; Versión 1.0.0                                                                        ;;
;; José Luis García Galán 07/05/11                                                      ;;
;;                                                                                      ;;
;; PROGRAMA DE CALCULO Y DIBUJO DE PENDIENTES EN PLANTA Y ALZADO                        ;;
;;**************************************************************************************;;
(defun C:Pendiente (/ ;|Registro/DLG|; PDTE_DRAW_TYPE PDTE_VAL L_VAL H_VAL LP_VAL ANG1_VAL ANG2_VAL
                          PDTE_CALC *TEXTSTYLE* *LAYERDRAW* ESCHTXT U_DEC ANG1_valR ANG2_valR
                       ;|Locales |; *error* DatosDLG p1 p2 p3 p4 PtTmp AngTxt PtInsText LUNT AngDir
         ;|funciones|; NormaliceAngle StyTxtAPPS Pdte_Draw_Floor_Draw Pdte_Draw_Elevated_Draw
      )
 ;;------------------------ StyTxtAPPS --------------------------;;
 ;;Crea o modifica el estilo de texto *TextStyleAtt*             ;;
 ;;--------------------------------------------------------------;;
 (defun StyTxtAPPS (StyleTxt / txt_s)
  ;;estilo de texto
  (cond
   ((tblsearch "STYLE" StyleTxt)
    (setq txt_s (tblobjname "STYLE" StyleTxt))
   )
   (t 
    (setq txt_s (jlgg-SetStyTxt StyleTxt (strcat StyleTxt ".ttf") 0.0 1.0 nil))
   )
  );c.cond
  txt_s
 );c.defun
 
 ;;---------------------- NormaliceAngle ----------------------------;;
 ;;Modifiva un angulo (p1-p2) para la colocación del texto en planta ;;
 ;;------------------------------------------------------------------;;
 (defun NormaliceAngle (ang)
  (if (or (< (/ pi 2) ang (* pi 1.5))
   (equal Ang (* pi 1.5) 1.0e-06))
   (setq ang (+ ang pi))
  )
  ang
 )
 ;;---------------------- Pdte_Draw_Floor_Draw ----------------------------;;
 ;;Dibujo de pendiente en planta                                           ;;
 ;;------------------------------------------------------------------------;;
 (defun Pdte_Draw_Floor_Draw ()
  (setq AngDir (angle p1 p2))
  (setq AngTxt (NormaliceAngle (angle p1 p2)))
  (setq p2 (polar p1 (angle p1 p2) L_val))
  (setq p3 (polar p2 ( + (angle p2 p1) (* pi 0.25)) (* 1.5 EscHTxt)))
  (setq p4 (polar p2 ( - (angle p2 p1) (* pi 0.25)) (* 1.5 EscHTxt)))
  (jlgg-MakeLwPol (mapcar (function (lambda (pt)(trans pt 1 0))) (list p1 p2 p3 p4 p2))
                  *LayerDraw* '((62 . 1)) 0.0 nil nil nil nil)
  (setq PtTmp (polar p1 AngDir (/ L_val 2))
        PtInsText (polar PtTmp (+ AngTxt (* pi 0.5)) (/ EscHTxt 2.0)))
  (jlgg-MakeMtext (trans PtInsText 1 0) EscHTxt
                  (strcat "PDTE = " (rtos PDTE_val 2 u_dec) " %")
                  AngTxt T "_BC" *LayerDraw* *TextStyle* MyCol LWeight T_Mask T)
  (setq PtInsText (polar PtTmp (- AngTxt (* pi 0.5)) (/ EscHTxt 2.0)))
  (jlgg-MakeMtext (trans PtInsText 1 0) EscHTxt
                  (strcat
     "L = "  (rtos L_val  LUNT u_dec) "\\P"
     "H = "  (rtos H_val  LUNT u_dec) "\\P"
     "LP = " (rtos LP_val LUNT u_dec)
    )
                  AngTxt T "_TC" *LayerDraw* *TextStyle* MyCol LWeight T_Mask T)
 )
 ;;-------------------- Pdte_Draw_Elevated_Draw ---------------------------;;
 ;;Dibujo de pendiente en Alzado                                           ;;
 ;;------------------------------------------------------------------------;;
 (defun Pdte_Draw_Elevated_Draw ()
  (setq AngDir 0.0)
  (setq ANG1_valR (* pi (/ ANG1_val 180.0))
        ANG2_valR (* pi (/ ANG2_val 180.0)))
  (setq p2 (polar p1 AngDir L_val)
        p3 (polar p2 (+ AngDir (/ pi 2)) H_val))
  (setq p1 (trans p1 1 0)
        p2 (trans p2 1 0)
        p3 (trans p3 1 0))
  ;;Gráficos
  (jlgg-MakeLwPol (list p1 p3 p2) *LayerDraw* '((62 . 1)) 0.0 nil nil nil t)
  (entmake
   (list
    '(0 . "ARC") '(100 . "AcDbEntity") (cons 8 *LayerDraw*) '(62 . 7)
    (cons 10 p1) (cons 40 (/ L_val 4.0)) '(210 0.0 0.0 1.0) 
    (cons 50 (angle p1 p2)) (cons 51 (+ (angle p1 p2) ANG1_valR))
   )
  )
  (entmake
   (list
    '(0 . "ARC") '(100 . "AcDbEntity") (cons 8 *LayerDraw*) '(62 . 7)
    (cons 10 p3) (cons 40 (/ H_val 4.0)) '(210 0.0 0.0 1.0) 
    (cons 50 (angle p3 p1)) (cons 51 (+ (angle p3 p1) ANG2_valR))
   )
  )
  ;;Textos
  (setq Ang2Pt (angle p1 p2))
  (setq PtTmp     (polar p1 Ang2Pt (/ L_val 2))
        PtInsText (polar PtTmp (- Ang2Pt (* pi 0.5)) EscHTxt))
  (jlgg-MakeMtext PtInsText EscHTxt
                  (strcat "L = "  (rtos L_val LUNT u_dec))
                  AngDir T "_MC" *LayerDraw* *TextStyle* MyCol LWeight T_Mask T)
  (setq Ang2Pt (angle p1 p3))
  (setq PtTmp     (polar p1 Ang2Pt (/ LP_val 2))
        PtInsText (polar PtTmp (+ Ang2Pt (* pi 0.5)) EscHTxt))
  (jlgg-MakeMtext PtInsText EscHTxt
                  (strcat "LP = "  (rtos LP_val LUNT u_dec))
                  (+ AngDir ANG1_valR) T "_MC" *LayerDraw* *TextStyle* MyCol LWeight T_Mask T)
  (setq PtInsText (polar PtInsText (+ Ang2Pt (* pi 0.5)) (* EscHTxt 1.5)))
  (jlgg-MakeMtext PtInsText EscHTxt
                  (strcat "PDTE = "  (rtos PDTE_val LUNT u_dec) " %")
                  (+ AngDir ANG1_valR) T "_MC" *LayerDraw* *TextStyle* MyCol LWeight T_Mask T)
  (setq Ang2Pt (angle p2 p3))
  (setq PtTmp     (polar p2 Ang2Pt  (/ (distance p2 p3) 2.0))
        PtInsText (polar PtTmp (- Ang2Pt (* pi 0.5)) EscHTxt))
  (jlgg-MakeMtext PtInsText EscHTxt
                  (strcat "H = " (rtos H_val LUNT u_dec))
                  (+ AngDir (* pi 0.5)) T "_MC" *LayerDraw* *TextStyle* MyCol LWeight T_Mask T)
  (setq PtInsText (polar p1 (- AngDir (* pi 0.5)) (/ EscHTxt 2.0)))
  (jlgg-MakeMtext PtInsText EscHTxt
                  (strcat "A{\\H0.75x;1} = " (rtos ANG1_val LUNT u_dec) "°")
                  AngDir T "_TR" *LayerDraw* *TextStyle* MyCol LWeight T_Mask T)
  (setq PtInsText (polar p3 AngDir (/ EscHTxt 2.0)))
  (jlgg-MakeMtext PtInsText EscHTxt
                  (strcat "A{\\H0.75x;2} = " (rtos ANG2_val LUNT u_dec) "°")
                  AngDir T "_TL" *LayerDraw* *TextStyle* MyCol LWeight T_Mask T)
 )

 ;;--------------------------- MAIN --------------------------------;;
 (vl-doc-set '*NameAppRun* "Pendiente")
 (setq *error* LMT:error)
 (jlgg-Init_Vars (list '("DIMZIN" 8)
         ;(list "osmode" (osmodeOFF))
         '("cmdecho" 0)
         '("snapmode" 0))) 
 (cond
  ;;(("PDTE_val" . 87.5963) ("L_val" . 3.88144) ("H_val" . 3.4) ("LP_val" . 5.16)
  ;; ("ANG1_val" . 41.2172) ("ANG2_val" . 48.7828) ("Pdte_Calc" "LP" "PDTE")
  ;; ("u_dec" . 5) ("Pdte_Draw_Type" . "Pdte_Draw_Elevated") ("*TextStyle*" . "Arial")
  ;; ("*LayerDraw*" . "ARQ_Proyección") ("EscHTxt" . 2.5)
  ;;)
  ((setq DatosDLG (PENDIENTES_DLG))
   (mapcar
    (function
     (lambda (pair)
      (set (read (car pair)) (cdr pair))
     )
    )
    DatosDLG
   )
   (StyTxtAPPS *TextStyle*)
   (setq LUNT (getvar 'LUNITS))
   (cond
    ((and (= Pdte_Draw_Type "Pdte_Draw_Floor")
   (setq p1 (jlgg-GetpointEx nil "\nPunto inicial de la pendiente en Planta: " nil))
   (setq p2 (jlgg-GetpointEx p1 " >>Dirección: " nil)))
     (jlgg-UndoStart (jlgg-ActDoc))
      (Pdte_Draw_Floor_Draw)
     (jlgg-UndoEnd (jlgg-ActDoc))
    )
    ((and (= Pdte_Draw_Type "Pdte_Draw_Elevated")
   (setq p1 (jlgg-GetpointEx nil "\nPunto inicial de la pendiente en alzado: " nil)))
     (jlgg-UndoStart (jlgg-ActDoc))
      (Pdte_Draw_Elevated_Draw)
     (jlgg-UndoEnd (jlgg-ActDoc))
    )
   );c.cond
   
  )
 )
 (*error* nil)
 (princ)
);cierro defun principal

(princ)
            
          
Descarga.

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..

No hay comentarios:

Publicar un comentario