No vamos a ver aquí como programar los cuadros de diálogo (DCL) para AutoCAD-VisualLisp, solo os voy a compartir unas utilidades auxiliares que podemos utilizar en nuestras funciones de VisualLisp. Estas utilidades, también las usaremos en nuestro proyecto de la marmita.
Algunas de las funciones que se incluyen en este archivo (jlgg_AuxDialog.lsp) estaban incluidas dentro del archivo de utilidades (jlgg_Auxiliares.lsp) básico para la ejecución de todo el proyecto de "La Marmita". Recordad que estos archivos se irán actualizando con el proyecto. Podéis ver las descargas al final de esta entrada para actualizaros. Vamos a ver el funcionamiento de algunas de estas utilidades interesantes:
jlgg-LispMsg (MessageBox)
Lo habréis visto en multitud de paginas y foros (es indispensable), es como MessageBox en VB.NET.
Personalmente prefiero usar alguna función creada en vb.NET o C#, ya que en esta que vemos aquí, utilizamos el objeto
"WScript.Shell" de windows para llamar a popup. Nunca soy partidario de usar objetos de terceros,
aunque sea windows, por mi experiencia se que pueden desaparecer o quedar obsoletos.
(ya nos ha pasado con objetos de vb como commctrl.dll, etc).
Pero es un código corto y funciona bien. Por ponerle pegas, tiene el inconveniente de que puede desaparecer de la pantalla si pinchamos en otra ventana, podemos usar en el parámetro "buttons" el código SystemModal (4096) para que esto no suceda. Es interesante, porque suple muchas carencias del "alert" de visualLisp y del lenguage DCL por los iconos. |
Ejemplos
Select all
Resultado
(jlgg-LispMsg
(strcat "Esto es un ejemplo de la función \"jlgg-LispMsg\""
"\n\n" "OKOnly + Information") (+ 0 64) "La Marmita. Mensaje.")
Select all
Resultado
(jlgg-LispMsg
(strcat "Esto es un ejemplo de la función \"jlgg-LispMsg\""
"\n\n" "YesNoCancel + Critical + DefaultButton2 + SystemModal") (+ 3 16 256 4096) "La Marmita. Mensaje.")
Select all
Resultado
(jlgg-LispMsg
(strcat "Esto es un ejemplo de la función \"jlgg-LispMsg\""
"\n\n" "YesNo + Question + RightJustified") (+ 4 32 524288) "La Marmita. Mensaje.")Código
Select all
;;---------------------------------------------------- LispMsg ---------------------------------------------------------------------
;;;Mensaje en Lisp parecido a MessageBox en VB.NET
;;;MessageBox(prompt [buttons] [title])
;;;Constant ButtonType Description
;;;
;;;OKOnly 0 Display OK button only.
;;;OKCancel 1 Display OK and Cancel buttons.
;;;AbortRetryIgnore 2 Display Abort, Retry, and Ignore buttons.
;;;YesNoCancel 3 Display Yes, No, and Cancel buttons.
;;;YesNo 4 Display Yes and No buttons.
;;;RetryCancel 5 Display Retry and Cancel buttons.
;;;CancelTAgainContinue 6 Show Cancel, Try Again, and Continue buttons.
;;;Critical 16 Display Critical Message icon.
;;;Question 32 Display Warning Query icon.
;;;Exclamation 48 Display Warning Message icon.
;;;Information 64 Display Information Message icon.
;;;DefaultButton1 0 First button is default.
;;;DefaultButton2 256 Second button is default.
;;;DefaultButton3 512 Third button is default.
;;;SystemModal 4096 System modal; all applications are suspended until the user responds to the message box.
;;;RightJustified 524288 The text is right-justified.
;;;RightToLeft 1048576 The message and caption text display in right-to-left reading order, for some languages.
;;
;;;Return Values
;;;Constant Value
;;;OK 1
;;;Cancel 2
;;;Abort 3
;;;Retry 4
;;;Ignore 5
;;;Yes 6
;;;No 7
;;;Try Again 10
;;;Continue 11
;;;---------------------------------------------------------------------------------------------------------------------------------
(defun jlgg-LispMsg (Mensaje Buttons Titulo / Reponse WshShell)
(if (not Titulo) (setq Titulo "Mensage de Applicación"))
(if (not Buttons) (setq Buttons 0))
(cond
((not (vl-catch-all-error-p
(setq WshShell
(vl-catch-all-apply
(function vla-getInterfaceObject)
(list (vlax-get-acad-object) "WScript.Shell")))))
;;Syntax:
;;intButton = object.Popup(strText,[nSecondsToWait],[strTitle],[nType])
(acad-push-dbmod)
(if (vl-catch-all-error-p
(setq Reponse (vl-catch-all-apply
(function vlax-invoke-method)
(list WshShell 'Popup
Mensaje
0
Titulo
(itoa Buttons)))))
(setq Reponse nil)
)
(vlax-release-object WshShell)
(acad-pop-dbmod)
)
)
Reponse
)
DD_Radio_Pick
Muestra un cuadro de diálogo con controles del tipo radio-button, los textos de estos controles
se indican como un argumento de lista de cadenas. Como el resto de funciones que vamos a
ver esta programado para escribir un archivo temporal DCL.
Se déven indicar los siguiente argumentos:
|
Ejemplos
Select all
Resultado
(setq TxtMens
(strcat
"Lorem ipsum dolor sit amet, consectetur adipiscing elit. Sed quis nisl vel mauris placerat accumsan "
"sed nec augue. Vestibulum eu luctus ex. Duis pellentesque sem sem, et fermentum massa hendrerit at. "
"\n "
"\nDonec volutpat, justo in aliquam congue, leo leo dictum quam, vel pulvinar quam "
"nisi et augue. Nunc varius risus nisi, vel consequat augue malesuada et. Duis vulputate nisi "
"non enim vestibulum, nec suscipit elit scelerisque."))
(DD_RADIO_PICK
"La Marmita. Opciones." "Texto de opciones:" TxtMens
(list "Opción 1" "Opción 2" "Opción 3" "Opción 4") "Opción 2")Código
Select all
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; DD_RADIO_PICK ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Function: seleccion desde lista de opciones
;; Argumentos:
;;;Title ;; (string o nil) Dialog box Titulo
;;;LabelLBox ;; (string o nil) Texto superior de la ventana contenedora de opciones.
;;;TxtMens ;; (string o nil) Texto descriptivo (puede incluir "\n")
;;;ListItems ;; (list) Listado para seleccionar opciones
;;;Default ;; (string o nil) Elemento seleccionado por defecto en la lista al inicio
;;
;;Ejemplo:
;;; (setq TxtMens (strcat "Lorem ipsum dolor sit amet, consectetur adipiscing elit. "
;;; "Morbi sed dictum quam. \nMorbi nisi augue, aliquam a ultricies sit amet, "
;;; "eleifend in metus."))
;;; (DD_RADIO_PICK "Titulito" "Texto ventana de opciones:" TxtMens
;;; (list "pepe" "juan" "antonio" "manolo") nil)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun DD_RADIO_PICK (Title LabelLBox TxtMens ListItems Default
/
maxLenStr LTxtMens i j NameDlg Tmp FichDlg RetVal accion ItemLst dcl_ID
;|functions|; Wrt_dialog
)
;;_______________________________________________________
;;Función de creación del cuadro de dialogo
(defun Wrt_dialog ( / NameDlg dir sfile file j)
(setq NameDlg "$DD_RADIO_PICK$.dcl")
(setq dir (getvar "TEMPPREFIX"))
(setq sfile (strcat dir NameDlg))
(setq file (open sfile "w"))
(write-line "Dclradiopick : dialog {" file)
(write-line (STRCAT " label=\"" Title "\";") file)
(cond
(TxtMens
(setq i 0)
(write-line ": paragraph {" file)
(foreach j LTxtMens
(write-line ": text_part {" file)
(write-line (strcat "key = \"txtm" (itoa (setq i (1+ i))) "\";") file)
(write-line (strcat "width = " (rtos maxLenStr 2 3) ";") file)
;;(write-line (strcat " label = \"" j "\";") file)
(write-line "}" file)
);c.foreach
(write-line "}" file)
(write-line ":spacer { height = 0.1; }" file)
)
)
;;Texto de la ventana contenedora de opciones:
(cond
(LabelLBox
(write-line " : text {" file)
(write-line " vertical_margin = none;" file)
(write-line " key=\"labelbox\";" file)
(write-line (strcat "width = " (rtos maxLenStr 2 3) ";") file)
(write-line "}" file)
)
)
(write-line " : boxed_radio_column {" file)
(write-line " vertical_margin = none;" file)
(write-line " children_fixed_height=true;" file)
(write-line " key=\"temp0\";" file)
;;listado de opciones:
(foreach ItemLst ListItems
(write-line " : radio_button {" file)
(write-line " vertical_margin = none;" file)
(write-line (strcat " key = \"" ItemLst "\";") file)
(write-line (strcat " label=\"" ItemLst "\";") file)
(write-line " }" file)
);c.foreach
(write-line ":spacer { height = 0.1; }" file)
(write-line " }" file)
(write-line ":spacer { height = 0.1; }" file)
(write-line ": row {" file)
(write-line ":spacer { width = 1; }" file)
(write-line "ok_cancel;" file)
(write-line ":spacer { width = 1; }" file)
(write-line "}" file)
(write-line ":spacer { height = 0.1; }" file)
(write-line "}" file)
(setq file (close file))
sfile
)
;;---------------------------- MAIN -------------------------------------
;;Comprobaciones
;; Title del cuadro de dialogo
(cond
((and (= (type Title) 'STR)
(/= (setq Title (vl-string-trim " " Title)) ""))
)
(T (setq Title "Lista de opciones."))
);c.cond
;;Texto de cabecera encima de la lista de opciones:
(cond
((not LabelLBox))
((and (= (type LabelLBox) 'STR)
(/= (setq LabelLBox (vl-string-trim " " LabelLBox)) ""))
(setq Tmp (Str2Lst_WithBlank LabelLBox *MaxLenLineDlg*))
(if (> (length Tmp) 1)
(setq LabelLBox (strcat (car Tmp) "..."))
)
(setq maxLenStr (GetDclWidth LabelLBox))
(setq maxLenStr (+ maxLenStr 0.5))
)
(T (setq LabelLBox nil))
);c.cond
;; TxtMens
(cond
((not TxtMens))
((and (= (type TxtMens) 'STR)
(/= (setq TxtMens (vl-string-trim " " TxtMens)) ""))
(setq LTxtMens (parseComment TxtMens *MaxLenLineDlg*))
(setq Tmp (apply
(function max)
(mapcar (function GetDclWidth) LTxtMens)))
(if (> (setq Tmp (+ Tmp 0.5)) maxLenStr)
(setq maxLenStr Tmp)
)
)
(t (setq TxtMens nil))
);c.cond
;;Default :
(cond
((not Default) (setq Default (car ListItems)))
((and (= (type Default) 'STR)
(vl-position (setq Default (vl-string-trim " " Default)) ListItems))
)
(T (setq Default (car ListItems)))
)
;;-------------- GO ---------------------------
(setq FichDlg (Wrt_dialog))
(setq dcl_ID (load_dialog FichDlg))
(cond ((not (new_dialog "Dclradiopick" dcl_ID))
(prompt "\nDialog box loading error!")
(exit)
)
)
(cond
(TxtMens
(setq i 0)
(mapcar (function (lambda (s)
(set_tile (strcat "txtm" (itoa (setq i (1+ i)))) s)
)) LTxtMens)
)
)
(if LabelLBox (set_tile "labelbox" LabelLBox))
(set_tile "temp0" Default)
;;acciones
(action_tile "accept" "(setq RetVal (get_tile \"temp0\"))(done_dialog 1)")
;;initiate the dialog
(setq accion (start_dialog))
(unload_dialog dcl_ID)
(cond
((= accion 1)) ;;Accept
((= accion 0) ;;Cancel
(setq RetVal nil)
)
);c.cond
RetVal
);c.defun
DD_ChkOpts_Pick
Muestra un cuadro de diálogo con controles del tipo toggle. Los textos y valores de
estos controles se indican como un argumento de lista de pares de punto:
Contiene dos botones adicionales para "Seleccionar todo" o Deseleccionar. Se devén indicar los siguiente argumentos:
|
Ejemplos
Select all
Resultado
(setq TxtMens
(strcat
"Lorem ipsum dolor sit amet, consectetur adipiscing elit. Sed quis nisl vel mauris placerat accumsan "
"sed nec augue. Vestibulum eu luctus ex. Duis pellentesque sem sem, et fermentum massa hendrerit at. "
"\n "
"\nDonec volutpat, justo in aliquam congue, leo leo dictum quam, vel pulvinar quam "
"nisi et augue. Nunc varius risus nisi, vel consequat augue malesuada et. Duis vulputate nisi "
"non enim vestibulum, nec suscipit elit scelerisque."))
(DD_ChkOpts_Pick
"La Marmita. config." "Texto de opciones:" TxtMens
(list '("Opción 1" . 1) '("Opción 2" . 1) '("Opción 3" . 0) '("Opción 4" . 1)))Código
Select all
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; DD_ChkOpts_PICK ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Function: seleccion desde lista de opciones toogle
;; Argumentos:
;;;Title ;; (string o nil) Dialog box Titulo
;;;LabelLBox ;; (string o nil) Texto superior de la ventana contenedora de opciones.
;;;TxtMens ;; (string o nil) Texto descriptivo (puede incluir "\n")
;;;ListItems ;; (list of pair) Listado para seleccionar opciones
;;
;;Ejemplo:
;;; (setq TxtMens (strcat "Lorem ipsum dolor sit amet, consectetur adipiscing elit. "
;;; "Morbi sed dictum quam. \nMorbi nisi augue, aliquam a ultricies sit amet, "
;;; "eleifend in metus."))
;;; (DD_ChkOpts_PICK "Titulito" "Texto ventana de opciones:" TxtMens
;;; (list '("pepe" . 1) '("juan" . 1) '("antonio" . 0) '("manolo" . 1)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun DD_ChkOpts_PICK (Title LabelLBox TxtMens ListItems
/
maxLenStr LTxtMens i j NameDlg Tmp FichDlg RetVal
accion ItemLst dcl_ID itemsKeysDlg
;|functions|; Wrt_dialog OK_Dialog do_btn_sel
)
;;_______________________________________________________
;;Accion de botones de seleccionar todo o nada
(defun do_btn_sel (iVal)
(mapcar (function (lambda (key)
(set_tile key (itoa iVal))
)) itemsKeysDlg)
)
;;_______________________________________________________
;;Accion de aceptar
(defun OK_Dialog ()
(setq RetVal
(mapcar (function (lambda (pair key)
(cons (car pair)
(atoi (get_tile key)))
)) ListItems itemsKeysDlg)
)
(done_dialog 1)
)
;;_______________________________________________________
;;Función de creación del cuadro de dialogo
(defun Wrt_dialog ( / NameDlg dir sfile file j)
(setq NameDlg "$DD_CHKOPTS_PICK$.dcl")
(setq dir (getvar "TEMPPREFIX"))
(setq sfile (strcat dir NameDlg))
(setq file (open sfile "w"))
(write-line "chkopts_pick : dialog {" file)
(write-line (STRCAT " label=\"" Title "\";") file)
(cond
(TxtMens
(setq i 0)
(write-line ": paragraph {" file)
(foreach j LTxtMens
(write-line ": text_part {" file)
(write-line (strcat "key = \"txtm" (itoa (setq i (1+ i))) "\";") file)
(write-line (strcat "width = " (rtos maxLenStr 2 3) ";") file)
;;(write-line (strcat " label = \"" j "\";") file)
(write-line "}" file)
);c.foreach
(write-line "}" file)
(write-line ":spacer { height = 0.1; }" file)
)
)
;;Texto de la ventana contenedora de opciones:
(cond
(LabelLBox
(write-line " : text {" file)
(write-line " vertical_margin = none;" file)
(write-line " key=\"labelbox\";" file)
(write-line (strcat "width = " (rtos maxLenStr 2 3) ";") file)
(write-line "}" file)
)
)
(write-line " : boxed_column {" file)
(write-line " vertical_margin = none;" file)
(write-line " children_fixed_height=true;" file)
(write-line " key=\"temp0\";" file)
;;(list '("pepe" . 1) '("juan" . 1) '("antonio" . 0) '("manolo" . 1))
(setq i 0)
(setq itemsKeysDlg
(mapcar (function (lambda (pair / key)
(setq key (strcat (itoa i) "_TmpKey"))
(write-line " : toggle {" file)
(write-line (strcat " key = \"" key "\";") file)
(write-line (strcat " label=\"" (car Pair) "\";") file)
(write-line (strcat " value=\"" (itoa (cdr Pair)) "\";") file)
(write-line " }" file)
(setq i (1+ i))
key
)) ListItems);c.mapcar
);c.setq
(write-line ":spacer { height = 0.1; }" file)
(write-line " }" file)
(write-line ": row {fixed_width = true;" file)
(write-line ": button {" file)
(write-line " label = \"Seleccionar todo\";" file)
(write-line " key = \"ssAll\";" file)
(write-line " width = 12; fixed_width = true;}" file)
(write-line ": button {" file)
(write-line " label = \"Deseleccionar\";" file)
(write-line " key = \"ssNone\";" file)
(write-line " width = 12; fixed_width = true;}" file)
(write-line "}" file)
(write-line ":spacer { height = 0.1; }" file)
(write-line ": row {" file)
(write-line ":spacer { width = 1; }" file)
(write-line "ok_cancel;" file)
(write-line ":spacer { width = 1; }" file)
(write-line "}" file)
(write-line ":spacer { height = 0.1; }" file)
(write-line "}" file)
(setq file (close file))
sfile
)
;;---------------------------- MAIN -------------------------------------
;;Comprobaciones
;; Title del cuadro de dialogo
(cond
((and (= (type Title) 'STR)
(/= (setq Title (vl-string-trim " " Title)) ""))
)
(T (setq Title "Lista de opciones."))
);c.cond
;;Texto de cabecera encima de la lista de opciones:
(cond
((not LabelLBox))
((and (= (type LabelLBox) 'STR)
(/= (setq LabelLBox (vl-string-trim " " LabelLBox)) ""))
(setq Tmp (Str2Lst_WithBlank LabelLBox *MaxLenLineDlg*))
(if (> (length Tmp) 1)
(setq LabelLBox (strcat (car Tmp) "..."))
)
(setq maxLenStr (GetDclWidth LabelLBox))
(setq maxLenStr (+ maxLenStr 0.5))
)
(T (setq LabelLBox nil))
);c.cond
;; TxtMens
(cond
((not TxtMens))
((and (= (type TxtMens) 'STR)
(/= (setq TxtMens (vl-string-trim " " TxtMens)) ""))
(setq LTxtMens (parseComment TxtMens *MaxLenLineDlg*))
(setq Tmp (apply
(function max)
(mapcar (function GetDclWidth) LTxtMens)))
(if (> (setq Tmp (+ Tmp 0.5)) maxLenStr)
(setq maxLenStr Tmp)
)
)
(t (setq TxtMens nil))
);c.cond
;;-------------- GO ---------------------------
(setq FichDlg (Wrt_dialog))
(setq dcl_ID (load_dialog FichDlg))
(cond ((not (new_dialog "chkopts_pick" dcl_ID))
(prompt "\nDialog box loading error!")
(exit)
)
)
(cond
(TxtMens
(setq i 0)
(mapcar (function (lambda (s)
(set_tile (strcat "txtm" (itoa (setq i (1+ i)))) s)
)) LTxtMens)
)
)
(if LabelLBox (set_tile "labelbox" LabelLBox))
;;acciones
(action_tile "ssNone" "(do_btn_sel 0)")
(action_tile "ssAll" "(do_btn_sel 1)")
(action_tile "accept" "(OK_Dialog)")
;;initiate the dialog
(setq accion (start_dialog))
(unload_dialog dcl_ID)
(cond
((= accion 1)) ;;Accept
((= accion 0) ;;Cancel
(setq RetVal nil)
)
);c.cond
RetVal
);c.defun
InputBox
Muestra un cuadro de diálogo tipo "input" en Visual Basic para obtener una cadena del usuario.
Le he añadido la opción de un argumento de tipo "boolean" para que muestre caracteres tipo password("*"). Se déven indicar los siguiente argumentos:
|
Ejemplos
Select all
Resultado
(InputBox
"Indique una contraseña valida de \nadministrador:" "Jose ® - Gestión" "Contraseña" t)
Select all
Resultado
(setq TxtMens
(strcat
"Lorem ipsum dolor sit amet, consectetur adipiscing elit. Sed quis nisl vel mauris placerat accumsan "
"sed nec augue. Vestibulum eu luctus ex. Duis pellentesque sem sem, et fermentum massa hendrerit at. "
"\n "
"\nDonec volutpat, justo in aliquam congue, leo leo dictum quam, vel pulvinar quam "
"nisi et augue. Nunc varius risus nisi, vel consequat augue malesuada et. Duis vulputate nisi "
"non enim vestibulum, nec suscipit elit scelerisque."))
(InputBox TxtMens "La Marmita ®" "Lorem ipsum" nil)Código
Select all
;;------------------------------------------ InputBox -------------------------------------------------
;; José Luis García G. 05/2005
;; Programa para Pedir un texto tipo input de VB con aceptar o cancelar y posible password
;; Argumentos:
;; TxtMens: Texto Descriptivo de lo que se pide se le pueden dar retornos de carro con "\n"
;; Title : Titulo del cuadro de dialogo, si es nil se mostrara "Autocad Input Box"
;; TxtDef : Si no es nil se mostrara en edit_box
;; PassW : Si no es nil se mostrarán ****** en edit_box
;;
;;Ejemplo:
;;; (setq TxtMens (strcat "Lorem ipsum dolor sit amet, consectetur adipiscing elit. "
;;; "Morbi sed dictum quam. \nMorbi nisi augue, aliquam a ultricies sit amet, "
;;; "eleifend in metus.))
;;; (InputBox TxtMens (strcat "Jose" " ® - Gestión") nil T)
;;-----------------------------------------------------------------------------------------------------
(defun InputBox (TxtMens Title TxtDef PassW / accion dcl_ID val RetVal ltxt j
c_dialog FichDlg LTxtMens maxLenStr i
;|functions|; Wrt_dialog)
;;_______________________________________________________
(defun Wrt_dialog ( / NameDlg dir sfile j file )
(setq NameDlg "$InputBox$.dcl")
(setq dir (getvar "TEMPPREFIX"))
(setq sfile (strcat dir NameDlg))
(setq file (open sfile "w"))
(write-line "inputbox : dialog { initial_focus=\"input\"; key = sn;" file)
(write-line ": column {" file)
;;Textos de Información
(cond
(TxtMens
(setq i 0)
(write-line ": paragraph {" file)
(foreach j LTxtMens
(write-line ": text_part {" file)
(write-line (strcat "key = \"txtm" (itoa (setq i (1+ i))) "\";") file)
(write-line (strcat "width = " (rtos maxLenStr 2 3) ";") file)
;;(write-line (strcat " label = \"" j "\";") file)
(write-line "}" file)
);c.foreach
(write-line "}" file)
(write-line ":spacer { height = 0.1; }" file)
)
)
(write-line "}" file)
(write-line "spacer;" file)
(write-line ":edit_box {key = \"input\";" file) ;fixed_width = true;
(write-line "allow_accept = true;" file)
(If PassW
(write-line "label = \"&Password:\";edit_width = 20;fixed_width = true;edit_limit = 12;password_char = \"*\";" file)
)
(write-line "}" file)
(write-line ":spacer { height = 0.5; }" file)
(write-line ":row { fixed_width = true; alignment = centered;" file)
(write-line ":spacer { width = 0.1; }" file)
(write-line ":button { label = \"&Aceptar\"; is_default = true; key = \"accept\"; width = 10; fixed_width = true;}" file)
(write-line ":spacer { width = 2; }" file)
(write-line ":button { label = \"&Cancelar\"; is_cancel = true; key = \"cancel\"; width = 10; fixed_width = true;}" file)
(write-line ":spacer { width = 0.1; }" file)
(write-line "}}" file)
(close file)
sfile
);c.defun
;;------------------------ MAIN -----------------------------------------
;;Comprobaciones
;; Titulo del cuadro de dialogo
(cond
((and (= (type Title) 'STR)
(/= (setq Title (vl-string-trim " " Title)) ""))
)
(T (setq Title "Autocad Input Box."))
);c.cond
;; Comentario
(cond
((not TxtMens))
((and (= (type TxtMens) 'STR)
(/= (setq TxtMens (vl-string-trim " " TxtMens)) ""))
(setq LTxtMens (parseComment TxtMens *MaxLenLineDlg*))
(setq maxLenStr (apply
(function max)
(mapcar (function GetDclWidth) LTxtMens)))
(setq maxLenStr (+ maxLenStr 0.5))
)
(t (setq TxtMens nil))
);c.cond
;;-------------- GO ---------------------------
(setq FichDlg (Wrt_dialog))
(setq dcl_ID (load_dialog FichDlg))
(cond
((not (new_dialog "inputbox" dcl_ID "" p_dia)))
(T
(cond
(TxtMens
(setq i 0)
(mapcar (function (lambda (s)
(set_tile (strcat "txtm" (itoa (setq i (1+ i)))) s)
)) LTxtMens)
)
)
(set_tile "sn" Title)
(if (and TxtDef (= (type TxtDef) 'STR)) (set_tile "input" TxtDef))
(action_tile "input" "(setq RetVal $value)")
;;________________________
(setq accion (start_dialog))
(unload_dialog dcl_ID)
(cond
((= accion 0)(setq RetVal nil))
((= accion 1)
(if (not (and RetVal (/= RetVal "")))
(setq RetVal nil)
);c.if
)
);c.cond
)
)
RetVal
);c.defun
DD_Select
Muestra un cuadro de diálogo para seleccionar elementos de una lista. El argumento para la lista de
elementos será una lista de cadenas.
Se déven indicar los siguiente argumentos:
|
- Si el argumento "MultiSel" es T(true) aparecerá un control tipo "toogle" como una opción para seleccionar todos los elementos de la lista. ("Seleccionar todo")
- Si el argumento "MultiSel" es T(true) y el argumento "Default" es igual a "*", se seleccionarán todos los elementos de la lista al inicio de la ejecución de la función.
- Se recomienda no añadir mas de 256 items a la lista en modo "Selección Múltiple" ya que DCL tiene restricciones no implementadas por autodesk (o yo no las he encontrado). Ver mensajes y comentarios en el código.
Ejemplos
Select all
Resultado
(setq i 0 iList nil)(repeat 256 (setq iList (cons (strcat "Item_" (itoa (setq i (1+ i)))) iList)))
(setq iList (reverse iList))
(DD_SELECT
"La Marmita ®" "Listado de elementos:"
"Seleccione un elemento \nde la lista:" iList nil "Item_12")
Select all
Resultado
(setq TxtMens
(strcat
"Lorem ipsum dolor sit amet, consectetur adipiscing elit. Sed quis nisl vel mauris placerat accumsan "
"sed nec augue. Vestibulum eu luctus ex. Duis pellentesque sem sem, et fermentum massa hendrerit at. "
"\n "
"\nDonec volutpat, justo in aliquam congue, leo leo dictum quam, vel pulvinar quam "
"nisi et augue. Nunc varius risus nisi, vel consequat augue malesuada et. Duis vulputate nisi "
"non enim vestibulum, nec suscipit elit scelerisque."))
(setq i 0 iList nil)(repeat 256 (setq iList (cons (strcat "Item_" (itoa (setq i (1+ i)))) iList)))
(setq iList (reverse iList))
(DD_SELECT "La Marmita ®" "Listado de elementos:" TxtMens iList T "Item_40")Código
Select all
;;---------------------------------------- DD_SELECT --------------------------------------------------
;; José Luis García G. 05/2005
;; Argumentos:
;; Title ;; (string) Titulo del cuadro de dialogo o NIL
;; LabelLBox ;; (string) Texto de cabecera del list box o NIL
;; TxtMens ;; (string) Texto descriptivo, puede incluir "\n" o NIL
;; sList ;; (list) Lista de cadenas del list_box o NIL
;; MultiSel ;; (boolean) T = Multiple seleccion select, nil = Selección simple.
;; Default ;; (string) Elemento por defecto seleccionado al inicio o NIL
;;
;;Notas:
;; (1) Si MultiSel es T y Default = "*" -> Todo seleccionado al inicio.
;; (2) Se recomienda no añadir mas de 256 items a la lista en modo Multiselección ya que DCL
;; tiene restricciones No implementadas por autodesk. (ver mensajes y comentarios en el codigo)
;;
;;Ejemplo:
;; (setq i 0 iList nil)(repeat 256 (setq iList (cons (strcat "Item_" (itoa (setq i (1+ i)))) iList)))
;; (setq iList (reverse iList))
;; (setq TxtMens (strcat "Lorem ipsum dolor sit amet, consectetur adipiscing elit. "
;; "Morbi sed dictum quam. \nMorbi nisi augue, aliquam a ultricies sit amet, "))
;; (DD_SELECT "Titulo dlg.." "pepe\tjuan" iList TxtMens T "Item_408")
;;-----------------------------------------------------------------------------------------------------
(defun DD_SELECT (Title LabelLBox TxtMens sList MultiSel Default
/
FichDlg accion Selection_List LComent j Tmp RetVal sel_all NameDlg Item
;|functions|; SetValAll List_Item_Select Wrt_dialog
)
;;--------------------------- Funciones auxiliares -----------------------------------------
;;_____________________________________________________________________
;;Escritura el cuadro de dialogo en un fichero del directorio temporal
(defun Wrt_dialog ( / NameDlg dir sfile j file )
(setq NameDlg "$DD_Select$2.dcl")
(setq dir (getvar "TEMPPREFIX"))
(setq sfile (strcat dir NameDlg))
(setq file (open sfile "w"))
(write-line "ddselect : dialog {" file)
(write-line (strcat "label=\"" Title "\";") file)
(write-line "width=35;fixed_width= true;" file)
(cond
(TxtMens
(setq i 0)
(write-line ": paragraph {" file)
(foreach j LTxtMens
(write-line ": text_part {" file)
(write-line (strcat "key = \"txtm" (itoa (setq i (1+ i))) "\";") file)
(write-line (strcat "width = " (rtos maxLenStr 2 3) ";") file)
;;(write-line (strcat " label = \"" j "\";") file)
(write-line "}" file)
);c.foreach
(write-line "}" file)
(write-line ":spacer { height = 0.1; }" file)
)
)
;;Texto de la ventana contenedora de opciones:
(cond
(LabelLBox
(write-line " : text {" file)
(write-line " vertical_margin = none;" file)
(write-line " key=\"labelbox\";" file)
(write-line (strcat "width = " (rtos maxLenStr 2 3) ";") file)
;;(write-line (strcat " label=\"" (vl-string-trim " " LabelLBox) "\";" ) file)
(write-line "}" file)
)
)
(write-line (strcat ":list_box {") file)
(write-line (strcat "key=\"listBox\";" ) file)
(write-line "height=15; " file)
(write-line "fixed_height= true; " file)
;;(write-line "fixed_width_font = true; " file)
(if MultiSel
(progn
(princ "multiple_select=true;}" file)
(write-line ":toggle {label = \"&Seleccionar todo\"; key = \"sel_all\";}" file)
);c.prg
(write-line "allow_accept=true; multiple_select=false;}" file)
);c.if
(write-line "spacer;" file)
(write-line "ok_cancel_err;" file)
(write-line "}" file)
(setq file (close file))
sfile
);c.defun
;;______________________________________________________________________________
(defun List_Item_Select (Key Value / Item)
(set_tile "error" "")
(cond
(MultiSel
(set_tile "sel_all" "0")
(setq sel_all "0")
)
)
;;Si se seleccionan mas de 256 items en la lista get-tile genera un error:
;;Value = "0 1 2 3 4 5 6 7 8 9 ..... 251 252 253 254 255 256"
;;(Error No implementado por autodesk)
(if (not (setq Item (get_tile Key))) ;campo de list_box demasiado largo
(progn
(setq Item Value)
(set_tile "error" "No se pueden seleccionar mas de 256 elementos.")
(set_tile "listBox" "")
(set_tile "listBox" Item)
)
);c.if
(cond
(MultiSel
(set_tile "sel_all" "0")
(setq sel_all "0")
)
)
(setq Selection_List (read (strcat "(" Item ")" )))
);c.defun
;;______________________________________________________________________________
(defun SetValAll ( / LNum Err)
(set_tile "error" "")
(setq LNum "")
(cond
((= sel_all "1")
(mapcar (function (lambda (x)
;;IMPORTANTISIMO: 2010 Maxima Longitud de campo para un "list_box" (no implementado por autodesk)
(if (< (strlen Lnum) 2000)
(setq Lnum (strcat Lnum " " (itoa (vl-position x sList))))
(if (not Err) (setq Err x))
);c.if
)) sList);c.mapcar
;;Test Err:
;;(if Err (set_tile "error" (strcat "Seleccion hasta item: (" (itoa (1+ (vl-position Err sList))) ")[" Err "]")))
(setq LNum (vl-string-left-trim " " LNum)
Selection_List T
)
(set_tile "listBox" "")
(set_tile "listBox" LNum)
)
(T
(setq Selection_List '(0))
(set_tile "listBox" "")
(set_tile "listBox" "0")
)
)
);c.defun
;;------------------------------ MAIN -----------------------------------------------------------
;;Comprobaciones
;; Title del cuadro de dialogo
(cond
((and (= (type Title) 'STR)
(/= (setq Title (vl-string-trim " " Title)) ""))
)
(T (setq Title "Lista de opciones."))
);c.cond
;;Texto de cabecera encima de la lista:
(cond
((not LabelLBox))
((and (= (type LabelLBox) 'STR)
(/= (setq LabelLBox (vl-string-trim " " LabelLBox)) ""))
(setq Tmp (Str2Lst_WithBlank LabelLBox *MaxLenLineDlg*))
(if (> (length Tmp) 1)
(setq LabelLBox (strcat (car Tmp) "..."))
)
(setq maxLenStr (GetDclWidth LabelLBox))
(setq maxLenStr (+ maxLenStr 0.5))
)
(T (setq LabelLBox nil))
);c.cond
;; TxtMens
(cond
((not TxtMens))
((and (= (type TxtMens) 'STR)
(/= (setq TxtMens (vl-string-trim " " TxtMens)) ""))
(setq LTxtMens (parseComment TxtMens *MaxLenLineDlg*))
(setq Tmp (apply
(function max)
(mapcar (function GetDclWidth) LTxtMens)))
(if (> (setq Tmp (+ Tmp 0.5)) maxLenStr)
(setq maxLenStr Tmp)
)
)
(t (setq TxtMens nil))
);c.cond
;;Default :
(cond
((not Default) (setq Default (car sList)))
((= (type Default) 'STR)
(setq Default (vl-string-trim " " Default))
(cond
((= Default "*"))
((vl-position Default sList))
(T (setq Default (car sList)))
)
)
(T (setq Default (car sList)))
)
;;-------------- GO DCL ---------------------------
(setq FichDlg (Wrt_dialog))
(setq dcl_ID (load_dialog FichDlg))
(cond
((not (new_dialog "ddselect" dcl_ID "" p_dia)))
(T
(cond
(TxtMens
(setq i 0)
(mapcar (function (lambda (s)
(set_tile (strcat "txtm" (itoa (setq i (1+ i)))) s)
)) LTxtMens)
)
)
(if LabelLBox (set_tile "labelbox" LabelLBox))
(start_list "listBox")
(mapcar 'add_list sList)
(end_list)
(if Default
(cond
((and MultiSel (= Default "*"))
(setq sel_all "1")
(set_tile "sel_all" sel_all)
(SetValAll)
)
((setq Item (vl-position Default sList))
(set_tile "listBox" (itoa Item))
(setq Selection_List (list Item))
)
);c.cond
);c.if
(action_tile "listBox" "(List_Item_Select $key $value)")
(action_tile "sel_all" "(setq sel_all $value)(SetValAll)")
(setq accion (start_dialog))
(unload_dialog dcl_ID)
(if (and (= accion 1) Selection_List)
(if (= sel_all "1")
(setq RetVal sList)
(if sList
(setq RetVal (mapcar '(lambda (X) (nth X sList)) Selection_List))
)
);c.if
);c.if
);c.prg
);c.if
RetVal
);c.defun
Las utilidades de este archivo ("jlgg_AuxDialog.lsp") también usan funciones auxiliares para el manejo de cadenas, parrafos, etc, que están en el archivo auxiliar del proyecto de "La Marmita": "jlgg_Auxiliares.lsp", este archivo se ha actualizado.
Se necesitan los dos archivos para la buena ejecución de todo el proyecto.
Configuración
Los archivos han de estar en una ruta de AutoCAD valida (ver Ordenación y carga de nuestros archivos de programación en AutoCAD)Al igual que el archivo "jlgg_Auxiliares.lsp", colocaremos el archivo "jlgg_AuxDialog.lsp" dentro de la ruta principal (no sub-directorio) de nuestro proyecto: "LaMarmita".
He añadido la carga del archivo al código de "LaMarmita.mnl" y se ha añadido algun icono al archivo CUIX:
;;Carga de funciones de La Marmita:
(setq MiListLISP
'("jlgg_Auxiliares.lsp"
"jlgg_AuxDialog.lsp"
;;simbolos:
"Simbolos\\InsertEscalasGRP.lsp"
"Simbolos\\SimbDetallesSecciones.lsp"
;;Utiles:
"Utiles\\UCSAux.lsp"
)
)
Actualizaciones necesarias.
El programa necesitará que estén cargadas y actualizadas las funciones comunes para los programas publicados en VisualLisp
en La Marmita.
Descargar actualización: funciones Auxiliares Para usarlo con el proyecto global de "La Marmita" se necesitan los archivos actualizados de menú de autocad.
Descargar actualización: Archivos de menú de La Marmita Descarga.
Descargar actualización: funciones Auxiliares Para usarlo con el proyecto global de "La Marmita" se necesitan los archivos actualizados de menú de autocad.
Descargar actualización: Archivos de menú de La Marmita Descarga.
Como siempre, espero sea de utilidad.
Un saludo a tod@s desde España.
No hay comentarios:
Publicar un comentario