DCL Dialog Box Create routine

**peter** · 2015-08-31, 01:29 AM

Have you ever wanted to make dialog boxes in LISP and found it cumbersome?

I have been creating a dialog builder routine.

If any of you all are interested I can post the code, but here is the demo video.

Thoughts?

**peter** · 2015-08-31, 09:56 PM

Ever need to have a password entered in your routines?

Password3.jpg

Code:

;___________________________________________________________________________________________________________ 
;
; Dialog Box for Entering a password
; Written By: Peter Jamtgaard copyright 2015
; 
;___________________________________________________________________________________________________________

(defun C:Password ()
 (passworddialog "MyPassword1" "Default")
)

;___________________________________________________________________________________________________________ 
;
; Function that includes two arguments (the correct password and the default value)
; Function returns T for success
;___________________________________________________________________________________________________________

(defun PasswordDialog (strPassword strEntry / id)
 (or (findfile "password.dcl")
     (PasswordDialogWrite)
 )
 (if (setq id (load_dialog "password.dcl"))
  (progn
   (new_dialog "PasswordDialog" id)
   (set_tile "edit_box01" strEntry)
   (mode_tile "edit_box01" 0)
   (mode_tile "edit_box01" 2)
   (action_tile "edit_box01" "(setq strEntry $Value)")
   (and (= (start_dialog) 1)
        (= strPassword strEntry)
   )
  )
 )
)

;___________________________________________________________________________________________________________ 
;
; Function for creating a dcl file for the password lsp routine
;___________________________________________________________________________________________________________

(defun PasswordDialogWrite (/ strFolder z)
 (setq strFolder (getvar "dwgprefix"))
 (setq z (open (strcat strFolder "password.dcl") "w"))
 (write-line "selectitems : dialog {" z)
 (write-line "  label=\" Material Density Dialog\";" z)
 (write-line "" z)
 (write-line "  : boxed_column {" z)
 (write-line "    : text_part { key              = \"question\"; \t" z)
 (write-line "                  fixed_width_font = true; " z)
 (write-line "                  height           = 1.5;" z)
 (write-line "    }" z)
 (write-line "    : list_box { key             = \"listofitems\"; " z)
 (write-line "                 height          = 20;" z)
 (write-line "                 width           = 50;" z)
 (write-line "                 fixed_width_font = true; " z)
 (write-line "                 allow_accept    = true;" z)
 (write-line "    }" z)
 (write-line "  }" z)
 (write-line "  : row {" z)
 (write-line "    : text_part { label            = \" Unit Weight: \"; \t" z)
 (write-line "                  fixed_width_font = true; " z)
 (write-line "    }  " z)
 (write-line "    : edit_box { is_tab_stop      = true;" z)
 (write-line "                 key              = \"edit\";" z)
 (write-line "                 fixed_width_font = true; " z)
 (write-line "                 width            = 5;" z)
 (write-line "    }" z)
 (write-line "  }" z)
 (write-line "  ok_cancel;" z)
 (write-line "}" z)
 (close z)
)

(vl-load-com)

**peter** · 2015-09-01, 02:31 AM

I was playing around with my dialog builder and thought I would do some basic dialogs that I thought may be useful to others.

Do any of you have a dialog you would like to see?

I can do the generic one and you can modify them.

Also notice I am not providing the dcl file, but am including a function in the lisp routine to write the dcl file on the fly.

I can share the routine that converts the dcl file to the lisp function if anyone is interested.

P=

LISTBOX1.jpg

Code:

;___________________________________________________________________________________________________________ 
;
; Dialog Box for Selecting an item from a list box.
; Written By: Peter Jamtgaard copyright 2015
; 
;___________________________________________________________________________________________________________

; A list of strings (Atoms which could be reals, integers etc...)

(defun C:Listbox1 ()
 (listboxdialog (list "Alpha" "Beta" "Gamma" "Delta") )
)

; In case you want to include information that is not shown in the list box

(defun C:Listbox2 ()
 (listboxdialog (list (list "Alpha" 1.0 "A")
                      (list "Beta"  2.0 "B")
                      (list "Gamma" 3.0 "C")
                      (list "Delta" 4.0 "D")
                ) 
 )
)


;___________________________________________________________________________________________________________ 
;
; Function that includes two arguments (the correct password and the default value)
; Function returns T for success
;___________________________________________________________________________________________________________

(defun ListBoxDialog (lstItems  / id intItem lstItems)
 (if (and 
      (or (findfile "listbox1.dcl")
          (ListBox1DialogWrite)
      )
      (setq id (load_dialog (findfile "listbox1.dcl")))
     )
  (progn
   (new_dialog "ListBoxDialog" id)
   (start_list "list_box01")
    (mapcar 'add_list (mapcar 'AtomOrCar lstItems))
    (end_list)
   (set_tile "list_box01" "0")
   (mode_tile "list_box01" 0)
   (mode_tile "list_box01" 2)
   (action_tile "list_box01" "(setq intItem (atoi $Value))")
   (if (= (start_dialog) 1)
    (nth intItem lstItems)
   )
  )
 )
)



;___________________________________________________________________________________________________________ 
;
; Function for converting an atoms to a string or it also delivers the first item in a list (Car) as a string
;___________________________________________________________________________________________________________

(defun AtomOrCar (Value)
 (if (= (type Value) 'LIST)
  (vl-princ-to-string (car Value))
  (vl-princ-to-string Value)
 )
)

;___________________________________________________________________________________________________________ 
;
; Function for creating a dcl file for the listbox1 lisp routine
;___________________________________________________________________________________________________________

(defun ListBox1DialogWrite ()
 (setq z (open (strcat (getvar "dwgprefix") "listbox1.dcl") "w"))
 (write-line "ListBoxDialog :  dialog {" z)
 (write-line "  label               = \"Select Item\";" z)
 (write-line "  : list_box {" z)
 (write-line "    fixed_width_font    = true;" z)
 (write-line "    height              = 10.0;" z)
 (write-line "    is_enabled          = true;" z)
 (write-line "    key                 = \"list_box01\";" z)
 (write-line "    list                = \"A\\nB\\nC\";" z)
 (write-line "    value               = \"1\";" z)
 (write-line "    width               = 20.0;" z)
 (write-line "  }" z)
 (write-line "  ok_only;" z)
 (write-line "}" z)
 (close z)
 T
)

(vl-load-com)

**garcigj** · 2015-09-03, 09:34 AM

Code:

;;------------------------------------------ InputBox ---------------------------------------------
;; José Luis García G. 05/2005                                                                     
;; Programa para Pedir un texto tipo input de VBA con aceptar o cancelar y posible password        
;; Argumentos:										           
;; txt.- Texto Descriptivo de lo que se pide se le pueden dar retornos de carro con "\n"           
;; tit.- 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:                                                                                        
;;   (InputBox "Indique Contraseña de administrador." (strcat "Jose" " ® - Gestión") nil T)        
;;-------------------------------------------------------------------------------------------------
(defun InputBox (txt tit TxtDef PassW / s_n n_dia val RetVal ltxt j dir c_dialog
		                        ;|functions|; str2lst Wrt_dialog)
  	;;_______________________________________________________
 	(defun str2lst (str pat / pos )
	 (if (setq pos (vl-string-search pat str))
	  (vl-remove "" (cons (substr str 1 pos)
			      (str2lst (substr str (+ pos 1 (strlen pat))) pat)
			))
	  (list str)
	 )
	)
 	;;_______________________________________________________
	(defun Wrt_dialog ( txtD PassW / f )
         (setq dir (getvar "TEMPPREFIX"))
         (setq f (open (strcat dir "$InputBox$.dcl") "w"))
	 (write-line "inputbox : dialog { initial_focus=\"input\";alignment = centered; label = \"Autocad Input Box\";  key = sn;" f) ;fixed_width = true;
	 (write-line ": column {" f)
	 ;;Textos de Información
	 (if txtD
	  (progn
	   (write-line ": paragraph {" f)
	   (setq ltxt (str2lst txtD "\n"))
	   (foreach j ltxt
            (write-line (strcat ":text_part {label = \"" j "\";") f)
	    (write-line (strcat " width = " (itoa (strlen j)) ";") f)
	    (write-line "fixed_width = true; }" f) ;alignment = centered;
	   );c.foreach
	   (write-line "}" f)
	  )
	 );c.if
	 (write-line "}" f)
	 (write-line "spacer;" f)
         (write-line ":edit_box {key = \"input\";" f) ;fixed_width = true;
         (write-line "allow_accept = true;" f) 
         (If PassW  (write-line "label = \"&Password  :\";edit_width = 10;fixed_width = true;edit_limit = 12;password_char = \"*\"; }" f)
	   (write-line "}" f)
	 );end if
	 (write-line "spacer;" f)
	 (write-line ":row { fixed_width = true; alignment = centered;" f)
	 (write-line ":button { label = \"&Aceptar\"; is_default = true; key = \"accept\"; width = 10; fixed_width = true;}" f)
	 (write-line ":spacer { width = 2; }" f)
	 (write-line ":button { label = \"&Cancelar\"; is_cancel = true; key = \"cancel\"; width = 10; fixed_width = true;}" f)
	 (write-line "}}" f)
	 (close f)
	):c.defun
 ;;------------------------ MAIN -----------------------------------------
 (Wrt_dialog txt PassW)
 (setq n_dia (load_dialog (strcat dir "$InputBox$.dcl")))
 (cond
  ((not (new_dialog "inputbox" n_dia "" p_dia)))
  (T
   (if txt (set_tile "t_sino" txt))
   (if tit (set_tile "sn" tit))
   (if (and TxtDef (= (type TxtDef) 'STR)) (set_tile "input" TxtDef))
   (action_tile "input" "(setq RetVal $value)")
   ;;________________________
   (setq s_n (start_dialog))
   (if (= s_n 1)
    (if (not (and RetVal (/= RetVal "")))
     (setq RetVal nil)
    );c.if
   );end if
  )
 )
 RetVal
);c.defun

Examples:

Code:

(InputBox "Please\nEnter Administrator Password:" (strcat "garcigj®" " - inputbox") nil T)
(InputBox "Please \nSpecify user name \nfor this configuration." nil "Text Default" nil)
(InputBox nil nil nil nil)

best regards

**garcigj** · 2015-09-03, 08:09 PM

Code:

;;----------------------------- DclMensExt ------------------------------------------------
;;programa para mostrar informacion en cuadro de dialogo con opción de casilla de          
;;verificación de "No volver a mostrar este mensaje"                                       
;;Argumentos:                                                                              
;; tit.- Titulo del cuadro de dialogo, si es nil se mostrara !! Autocad Mensaje !!         
;; txt.- Texto Descriptivo de lo que se pide se le pueden dar retornos de carro con "\n"   
;; ButtonType  .- Tipos de botones                                                         
;; OpcToggle   .- Visualiza el toogle de "No volver a mostrar este mensaje" si se ha       
;;                                                                                         
;;;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		4		Display Yes, No, and Cancel buttons.               
;;;YesNo		8		Display Yes and No buttons.                        
;;;RetryCancel		16		Display Retry and Cancel buttons.                  
;;;VbDefaultButton1	0		First button is default.                           
;;;VbDefaultButton2	256		Second button is default.                          
;;;VbDefaultButton3	512		Third button is default.                           
;;;                                                                                        
;;;Return Values                                                                           
;;;Constant	Value	Description                                                        
;;;OK		1	OK                                                                 
;;;Cancel	2	Cancel                                                             
;;;Abort	3	Abort                                                              
;;;Retry	4	Retry                                                              
;;;Ignore	5	Ignore                                                             
;;;Yes		6	Yes                                                                
;;;No		7	No                                                                 
;;;                                                                                        
;; Ejemplo: (DclMensExt "Titulo cuadro" "Texto de ejemplo\nSegunda línea" (+ 8 256) t)     
;;-----------------------------------------------------------------------------------------
(defun DclMensExt (Tit txt ButtonType OpcToggle / accion RetVal Id_Dlg Dir ValToggle
		                                    ;|functions|; str2lst Wrt_dialog)
 
 	;;_______________________________________________________
 	(defun str2lst (str pat / pos )
	 (if (setq pos (vl-string-search pat str))
	  (vl-remove "" (cons (substr str 1 pos)
			      (str2lst (substr str (+ pos 1 (strlen pat))) pat)
			))
	  (list str)
	 )
	)
 	;;_______________________________________________________
        ;;Función de creación del cuadro de dialogo
	(defun Wrt_dialog (txtD ButtonType OpcToggle / f ltxt j)
         (setq Dir (getvar "TEMPPREFIX"))
         (setq f (open (strcat Dir "$DclMensage2$.dcl") "w"))
	 (write-line "dclmensage : dialog {" f)
	 (write-line "             alignment = left;" f)
	 (write-line "             label = \"Autocad Mensaje\";" f)
	 (write-line "             key = \"sn\";" f)
	 (write-line "               spacer;" f)
	 (write-line "               : column {" f)
	 (write-line "                 spacer;" f)
	 (if txtD
          (progn
	   (setq ltxt (str2lst txtD "\n"))
	   (foreach j ltxt
	    (write-line "                 : text_part {" f)
	    (write-line (strcat "                   label = \"" j "\";") f)
	    (write-line (strcat "                   width = " (itoa (strlen j)) ";") f)
	    (write-line "                   fixed_width = true;" f)
	    (write-line "                 }" f)
	   );c.foreach
	  );c.prg
         );c.if
	 (write-line "               }" f)
	 (write-line "             : spacer {height = 0.5;}" f)
         (if OpcToggle
          (write-line "             : toggle {label = \"Do not show this message again.\";  key = \"rb\";}" f)
         );c.if
         (write-line "             : spacer {height = 0.1;}" f)
         (write-line "             : row {" f)
         (write-line "               fixed_width = true;" f)
         (write-line "               alignment = centered;" f)
	 (cond
	  ;;OKCancel
	  ((= 1 (logand 1 ButtonType)) 
	   (write-line (strcat ": button {label = \"&Aceptar\"; key = \"accept\";"
			       " is_default = " (if (zerop (logand 256 ButtonType)) "true" "false") ";"
			       " width = 12; fixed_width = true;}") f)
	   (write-line ":spacer { width = 1; }" f)
	   (write-line (strcat ":button { label = \"&Cancelar\"; key = \"cancel\"; is_cancel = true;"
		      " is_default = " (if (zerop (logand 256 ButtonType)) "false" "true") ";"
		      " width = 12; fixed_width = true;}") f)
	  )
	  ;;VbAbortRetryIgnore
	  ((= 2 (logand 2 ButtonType)) 
	   (write-line (strcat ": button {label = \"&Abortar\"; key = \"abort\";"
			       " is_default = " (if (and (zerop (logand 256 ButtonType))
							 (zerop (logand 512 ButtonType))) "true" "false") ";"
			       " width = 12; fixed_width = true;}") f)
	   (write-line ":spacer { width = 1; }" f)
	   (write-line (strcat ":button { label = \"&Reintentar\"; key = \"retry\";"
		      " is_default = " (if (zerop (logand 256 ButtonType)) "false" "true") ";"
		      " width = 12; fixed_width = true;}") f)
	   (write-line ":spacer { width = 1; }" f)
	   (write-line (strcat ":button { label = \"&Ignorar\"; key = \"ignore\";"
		      " is_default = " (if (zerop (logand 512 ButtonType)) "false" "true") ";"
		      " width = 12; fixed_width = true;}") f)
	  )
	  ;;YesNoCancel
	  ((= 4 (logand 4 ButtonType)) 
	   (write-line (strcat ": button {label = \"&Si\"; key = \"yes\";"
			       " is_default = " (if (and (zerop (logand 256 ButtonType))
							 (zerop (logand 512 ButtonType))) "true" "false") ";"
			       " width = 12; fixed_width = true;}") f)
	   (write-line ":spacer { width = 1; }" f)
	   (write-line (strcat ":button { label = \"&No\"; key = \"no\";"
		      " is_default = " (if (zerop (logand 256 ButtonType)) "false" "true") ";"
		      " width = 12; fixed_width = true;}") f)
	   (write-line ":spacer { width = 4; }" f)
	   (write-line (strcat ":button { label = \"&Cancelar\"; key = \"cancel\"; is_cancel = true;"
		      " is_default = " (if (zerop (logand 512 ButtonType)) "false" "true") ";"
		      " width = 12; fixed_width = true;}") f)
	  )
	  ;;YesNo
	  ((= 8 (logand 8 ButtonType)) 
	   (write-line (strcat ": button {label = \"&Si\"; key = \"yes\";"
			       " is_default = " (if (zerop (logand 256 ButtonType)) "true" "false") ";"
			       " width = 12; fixed_width = true;}") f)
	   (write-line ":spacer { width = 1; }" f)
	   (write-line (strcat ":button { label = \"&No\"; key = \"no\";"
		      " is_default = " (if (zerop (logand 256 ButtonType)) "false" "true") ";"
		      " width = 12; fixed_width = true;}") f)
	  )
	  ;;RetryCancel
	  ((= 16 (logand 16 ButtonType)) 
	   (write-line (strcat ": button {label = \"&Reintentar\"; key = \"retry\";"
			       " is_default = " (if (zerop (logand 256 ButtonType)) "true" "false") ";"
			       " width = 12; fixed_width = true;}") f)
	   (write-line ":spacer { width = 1; }" f)
	   (write-line (strcat ":button { label = \"&Cancelar\"; key = \"cancel\"; is_cancel = true;"
		      " is_default = " (if (zerop (logand 256 ButtonType)) "false" "true") ";"
		      " width = 12; fixed_width = true;}") f)
	  )
	  (T ;;OKOnly
	   (write-line ": button {label = \"&Aceptar\"; key = \"accept\"; is_default = true; is_cancel = true; width = 10; fixed_width = true;}" f)
	  )
	 )
	 (write-line "             }" f)
         (write-line "           }" f)
	 (Close f)
	);c.defun
  
 ;--------------------------------- Main ---------------------------------------------------------------
 (if (not ButtonType)(setq ButtonType 0))
 (Wrt_dialog txt ButtonType OpcToggle)
 (setq Id_Dlg (load_dialog (strcat Dir "$DclMensage$.dcl"))) 
 (if (not (new_dialog "dclmensage" Id_Dlg "" p_dia_DclMx)) (exit))
 (if Tit (set_tile "sn" Tit))
 (if OpcToggle (setq ValToggle 0))
 (action_tile "rb" "(setq ValToggle (read $value))")
 (action_tile "accept"  "(setq RetVal 1 p_dia_DclMx (done_dialog 1))")
 (action_tile "cancel"  "(setq RetVal 0 p_dia_DclMx (done_dialog 1))")
 (action_tile "abort"   "(setq RetVal 3 p_dia_DclMx (done_dialog 1))")
 (action_tile "retry"   "(setq RetVal 4 p_dia_DclMx (done_dialog 1))")
 (action_tile "ignore"  "(setq RetVal 5 p_dia_DclMx (done_dialog 1))")
 (action_tile "yes"     "(setq RetVal 6 p_dia_DclMx (done_dialog 1))")
 (action_tile "no"      "(setq RetVal 7 p_dia_DclMx (done_dialog 1))")
 (setq accion (start_dialog))
 (unload_dialog Id_Dlg)
 (cond
  ((= accion 1)
   (list RetVal ValToggle)
  )
 );c.cond
);c.defun

best regards

**garcigj** · 2015-09-03, 08:13 PM

Examples DclMensExt:

Code:

(DclMensExt "Title dialog box" "Text example \nsecond line \nthird line" 0 nil)
(DclMensExt "Title dialog box" "Text example \nsecond line \nthird line" (+ 1 256) nil)
(DclMensExt "Title dialog box" "Text example \nsecond line \nthird line" (+ 2 512) nil)
(DclMensExt "Title dialog box" "Text example \nsecond line \nthird line" (+ 4 256) nil)
(DclMensExt "Title dialog box" "Text example \nsecond line \nthird line" (+ 8 256) nil)
(DclMensExt "Title dialog box" "Text example \nsecond line \nthird line" (+ 16) nil)
(DclMensExt nil nil nil nil)

Example OpcToggle:

Code:

(if (not (vl-registry-read (strcat "HKEY_CURRENT_USER\\SOFTWARE\\MiApp\\MiCommand") "NoMensDlg"))
  (if (= 7 (setq RetVal
	    (DclMensExt
	     "Alert RestoreHatch"
	     (strcat "This command will restore all hatch in this drawing"
		     "\nthat does not belong to a block or external references,"
		     "\neliminating the associativity to the drawing entities "
		     "\nand possible errors of these."
		     "\n "
		     "\nIt is possible that some hatch containing errors."
		     "\nwill disappear after save and restore the drawing."
		     "\n "
		     "\nDo you want to continue the operation?..."
	     )
	     (+ 8 256) T)))
   (exit)
   (if (= (last Retval) 1)
    (vl-registry-write (strcat "HKEY_CURRENT_USER\\SOFTWARE\\MiApp\\MiCommand") "NoMensDlg" 1)
   );c.if
  );c.if
);c.if

Code:

;;Restore message:
(vl-registry-delete (strcat "HKEY_CURRENT_USER\\SOFTWARE\\MiApp\\MiCommand") "NoMensDlg")

2015-09-03_22-12-02.png

best regards

**BIG-AL** · 2015-09-06, 01:26 AM

here is another simple 1 2 3 or even more auto dcl generator just load as required and in program code is only a couple of lines.

Getvals.jpg

Code:

; Input  Dialog box with variable title
; multiple lines of dcl supported
; add extra lines if required by copying code defun
; By Alan H 2015

; example code just use these next two lines
; (if (not AH:getval1)(load "getvals"))
; (ah:getval1 "Enter size " 5 4)  ;

; 1 line dcl
; sample code (ah:getval1 "line 1" 5 4)
(defun AH:getval1 (title width limit / fo)
; you can hard code a directory if you like for dcl file
(setq fname (strcat (getvar "SAVEFILEPATH") "\\getval1.dcl"))
(setq fo (open fname "w"))
(write-line "ddgetval : dialog {" fo)
(write-line " : row {" fo)
(write-line ": edit_box {" fo)
(write-line (strcat "    key = "  (chr 34) "key1" (chr 34) ";") fo)
(write-line  (strcat " label = "  (chr 34) title (chr 34) ";"  )   fo)
; these can be replaced with shorter value etc
(write-line (strcat "     edit_width = " (rtos width 2 0) ";" ) fo)
(write-line (strcat "     edit_limit = " (rtos limit 2 0) ";" ) fo)
(write-line "   is_enabled = true;" fo)
(write-line "    }" fo)
(write-line "  }" fo)
(write-line "ok_only;}" fo)
(close fo)

(setq dcl_id (load_dialog  fname))
(if (not (new_dialog "ddgetval" dcl_id))
(exit))
(action_tile "key1" "(setq val1 $value)")
(mode_tile "key1" 3)
(start_dialog)
(done_dialog)
(unload_dialog dcl_id)
; returns the value of val1 as a string
) ; defungetval1

; 2 line dcl
; sample code (ah:getval2 "line 1" 5 4 "line2" 8 7)
(defun AH:getval2 (title1 width1 limit1 title2 width2 limit2 / fo)
(setq fname (strcat (getvar "SAVEFILEPATH") "\\getval2.dcl"))
(setq fo (open fname "w"))
(write-line "ddgetval2 : dialog {" fo)
(write-line " : column {" fo)
(write-line ": edit_box {" fo)
(write-line (strcat "    key = " (chr 34) "key1" (chr 34) ";") fo)
(write-line  (strcat " label = "  (chr 34) title1 (chr 34) ";" ) fo)
(write-line (strcat "     edit_width = " (rtos width1 2 0) ";" ) fo)
(write-line (strcat "     edit_limit = " (rtos limit1 2 0) ";" ) fo)
(write-line "   is_enabled = true ;" fo)
(write-line "    }" fo)
(write-line "spacer_1 ;" fo)
(write-line ": edit_box {" fo)
(write-line (strcat "    key = " (chr 34) "key2" (chr 34) ";") fo)
(write-line (strcat " label = "  (chr 34) title2 (chr 34) ";"  ) fo)
(write-line (strcat "     edit_width = " (rtos width2 2 0) ";" ) fo)
(write-line (strcat "     edit_limit = " (rtos limit2 2 0) ";" ) fo)
(write-line "   is_enabled = true ;" fo)
(write-line "    }" fo)
(write-line "    }" fo)
(write-line "spacer_1 ;" fo)
(write-line "ok_only;}" fo)
(close fo)

; code part
(setq dcl_id (load_dialog  fname))
(if (not (new_dialog "ddgetval2" dcl_id))
(exit))
(mode_tile "key1" 3)
(action_tile "key1" "(setq val1 $value)")
(mode_tile "key2" 3)
(action_tile "key2" "(setq val2 $value)")
(start_dialog)
(done_dialog)
(unload_dialog dcl_id)
; returns the value of val1 and val2 as strings
) ; defungetval2

; 3 line dcl
; sample code (ah:getval3 "line 1" 5 4 "line2" 8 7 "line3" 6 4)

(defun AH:getval3 (title1 width1 limit1 title2 width2 limit2 title3 width3 limit3 / fo)
(setq fname (strcat (getvar "SAVEFILEPATH") "\\getval3.dcl"))
(setq fo (open fname "w"))
(write-line "ddgetval3 : dialog {" fo)
(write-line " : column {" fo)
(write-line ": edit_box {" fo)
(write-line (strcat "    key = " (chr 34) "key1" (chr 34) ";") fo)
(write-line  (strcat " label = "  (chr 34) title1 (chr 34) ";" ) fo)
(write-line (strcat "     edit_width = " (rtos width1 2 0) ";" ) fo)
(write-line (strcat "     edit_limit = " (rtos limit1 2 0) ";" ) fo)
(write-line "   is_enabled = true ;" fo)
(write-line "    }" fo)
(write-line "spacer_1 ;" fo)
(write-line ": edit_box {" fo)
(write-line (strcat "    key = " (chr 34) "key2" (chr 34) ";") fo)
(write-line (strcat " label = "  (chr 34) title2 (chr 34) ";"  ) fo)
(write-line (strcat "     edit_width = " (rtos width2 2 0) ";" ) fo)
(write-line (strcat "     edit_limit = " (rtos limit2 2 0) ";" ) fo)
(write-line "   is_enabled = true ;" fo)
(write-line "    }" fo)
(write-line "spacer_1 ;" fo)
(write-line ": edit_box {" fo)
(write-line (strcat "    key = " (chr 34) "key3" (chr 34) ";") fo)
(write-line (strcat " label = "  (chr 34) title3 (chr 34) ";"  ) fo)
(write-line (strcat "     edit_width = " (rtos width3 2 0) ";" ) fo)
(write-line (strcat "     edit_limit = " (rtos limit3 2 0) ";" ) fo)
(write-line "   is_enabled = true ;" fo)
(write-line "    }" fo)
(write-line "    }" fo)
(write-line "spacer_1 ;" fo)
(write-line "ok_only;}" fo)
(close fo)

; code part
(setq dcl_id (load_dialog  fname))
(if (not (new_dialog "ddgetval3" dcl_id))
(exit))
(mode_tile "key1" 3)
(action_tile "key1" "(setq val1 $value)")
(mode_tile "key2" 3)
(action_tile "key2" "(setq val2 $value)")
(mode_tile "key3" 3)
(action_tile "key3" "(setq val3 $value)")
(start_dialog)
(done_dialog)
(unload_dialog dcl_id)
; returns the value of val1 and val2 val3 as strings
) ; defungetval3

**fedupsumhow** · 2019-10-28, 07:16 PM

Prompt Box.jpg

HTML Code:

(defun C:HUS ; = Hatches Under Slope
  (/ pline n p1 p2 slope)
  (setq
    pline (car (entsel "\nSelect slope profile Polyline: "))
    depth (getdist "\nVertical depth of under-Hatching: ")
    n 0
    LowSlopeDist 0
    MedSlopeDist 0
    SteepSlopeDist 0
  ); setq
  (repeat (1- (cdr (assoc 90 (entget pline))))
    (setq
      p1 (vlax-curve-getPointAtParam pline n)
      p2 (vlax-curve-getPointAtParam pline (setq n (1+ n)))
      slope (/ (abs (- (cadr p1) (cadr p2))) (abs (- (car p1) (car p2))) 10)
    )
    (command  "_.hatch")
    (cond ;;; EDIT pattern scales
      ((< slope 0.05) (command "AR-SAND" 0.9 0)); [shallow slope]
      ((< slope 0.1) (command "GRAVEL" 4 0)); [medium slope]
      ((command "GRAVEL" 8 0)); [steep slope]
    ); cond
    (command "" "_no"
        ;; direct-draw boundary, don't keep it
      "_none" p1
      "_none" p2
      "_none" (polar p2 (* pi 1.5) depth)
      "_none" (polar p1 (* pi 1.5) depth)
      "_close"
      ""
    ); command
    (setq which
      (cond ;;; EDIT pattern scales
        ((< slope 0.05) 'LowSlopeDist); [shallow slope]
        ((< slope 0.1) 'MedSlopeDist); [medium slope]
        ('SteepSlopeDist); [steep slope]
      ); cond
    ); setq
    (set which
      (+
        (eval which) ; value so far
        (sqrt (+ (expt (/ (- (cadr p1) (cadr p2)) 10) 2) (expt (- (car p1) (car p2)) 2)))
          ;; length of segment, corrected for vertical exaggeration
      ); +
    ); set
  ); repeat
  (prompt
    (strcat
      "\nLow Slope total = " (rtos LowSlopeDist) "."
      "\nMedium Slope total = " (rtos MedSlopeDist) "."
      "\nSteep Slope total = " (rtos SteepSlopeDist) "."
    ); strcat
  ); prompt
  (princ)
); defun

Not sure if anyone will even respond here since its so old, but figured Id give it a shot. I have this lisp routine (above) that works great, however, i need it to become user friendly. If someone needs to adjust hatch, or slope variable, they would need to open the lisp and adjust and some people are not comfortable with messing with it (even though its a simply lisp).
What I would like to do is create a user friendly prompt/dialog box that first gives them the option to input the slope percentage (you can see this conditional code in the above text (cond ;;; EDIT pattern scales
((< slope 0.05) 'LowSlopeDist); [shallow slope]
((< slope 0.1) 'MedSlopeDist); [medium slope]
('SteepSlopeDist); [steep slope]
); cond )
Then I would like them to be able to adjust the hatch, layer, depth under the pline and scaling all through the prompt.

In case you would like to know what this routine does, it allows a user to select a pline and add a hatch under it that will change hatch scale and pattern conditional upon the slope grade.
So anyway, you asked if anyone has a dialog box they want to see, and i am in need of help. Thank you and maybe someone will see this

Thread: DCL Dialog Box Create routine

Thread Tools

Display

DCL Dialog Box Create routine

Re: DCL Dialog Box Create routine

Re: DCL Dialog Box Create routine

Re: DCL Dialog Box Create routine

Re: DCL Dialog Box Create routine

Re: DCL Dialog Box Create routine

Re: DCL Dialog Box Create routine

Re: DCL Dialog Box Create routine

Similar Threads

Need help updating a Layer name change routine with dialog box

Dialog box within LISP routine causes AutoCAD to not respond

Is it possible to have a input dialog box come up with a lisp routine?

Using stripmext[3].lsp routine, dialog box via the associated DCL does not display

Add dialog box to routine

Posting Permissions