Dialog box not by .DCL files
Hi,
Here's a example:
;; ListBox (gile)
;; Dialog box to make one ore many choices in a list
;;
;; Arguments
;; title : title of the dialog (string)
;; msg : message (string), "" or nil for none
;; keylab : associative list of key label ((key1 . label1) (key2 . label2) ...)
;; flag : 0 = popup list
;; 1 = single choice list
;; 2 = multiple choices list
;;
;; Return : key of the option (flag = 0 or 1) or the list of keys (flag = 2)
;;
;; Using example
;; (listbox "Layouts" "Choose a layout" (mapcar 'cons (layoutlist) (layoutlist)) 1)
(defun ListBox (title msg keylab flag / str2lst tmp file dcl_id choice)
(defun str2lst (str sep / pos)
(if (setq pos (vl-string-search sep str))
(cons (substr str 1 pos)
(str2lst (substr str (+ (strlen sep) pos 1)) sep)
)
(list str)
)
)
(setq tmp (vl-filename-mktemp "tmp.dcl")
file (open tmp "w")
)
(write-line
(strcat "ListBox:dialog{label=\"" title "\";")
file
)
(if (and msg (/= msg ""))
(write-line (strcat ":text{label=\"" msg "\";}") file)
)
(write-line
(cond
((= 0 flag) "spacer;:popup_list{key=\"lst\";")
((= 1 flag) "spacer;:list_box{key=\"lst\";")
(T "spacer;:list_box{key=\"lst\";multiple_select=true;")
)
file
)
(write-line "}spacer;ok_cancel;}" file)
(close file)
(setq dcl_id (load_dialog tmp))
(if (not (new_dialog "ListBox" dcl_id))
(exit)
)
(start_list "lst")
(mapcar 'add_list (mapcar 'cdr keylab))
(end_list)
(action_tile
"accept"
"(or (= (get_tile \"lst\") \"\")
(if (= 2 flag) (progn
(foreach n (str2lst (get_tile \"lst\") \" \")
(setq choice (cons (nth (atoi n) (mapcar 'car keylab)) choice)))
(setq choice (reverse choice)))
(setq choice (nth (atoi (get_tile \"lst\")) (mapcar 'car keylab)))))
(done_dialog)"
)
(start_dialog)
(unload_dialog dcl_id)
(vl-file-delete tmp)
choice
)
You can find some more examples on this page:
Accepted solution
Here's the translated 'GetLayer' dialog from the upper link
;; GETLAYERS (gile) 02/12/07
;; Returns the list of the checked layers in the dialog box
;;
;; arguments
;; title : title of the dialog box or nil (default = Choose the layers)
;; lst1 : list of the pre-checked layers or nil
;; lst2 : list of the unable layers (greyed out) or nil
(defun getlayers (title lst1 lst2 / sublist
toggle_column tmp file lay layers
len dcl_id lst
)
(defun sublist (lst start leng / n r)
(if (or (not leng) (< (- (length lst) start) leng))
(setq leng (- (length lst) start))
)
(setq n (+ start leng))
(repeat leng
(setq r (cons (nth (setq n (1- n)) lst) r))
)
)
(defun toggle_column (lst)
(apply 'strcat
(mapcar
(function
(lambda (x)
(strcat ":toggle{key="
(vl-prin1-to-string x)
";label="
(vl-prin1-to-string x)
";}"
)
)
)
lst
)
)
)
(setq tmp (vl-filename-mktemp "tmp.dcl")
file (open tmp "w")
)
(while (setq lay (tblnext "LAYER" (not lay)))
(setq layers (cons (cdr (assoc 2 lay)) layers))
)
(setq layers (vl-sort layers '<)
len (length layers)
)
(write-line
(strcat
"GetLayers:dialog{label="
(cond (title (vl-prin1-to-string title))
("\"Choose the layers\"")
)
";:boxed_row{:column{"
(cond
((< len 12) (toggle_column layers))
((< len 24)
(strcat (toggle_column (sublist layers 0 (/ len 2)))
"}:column{"
(toggle_column (sublist layers (/ len 2) nil))
)
)
((< len 45)
(strcat (toggle_column (sublist layers 0 (/ len 3)))
"}:column{"
(toggle_column (sublist layers (/ len 3) (/ len 3)))
"}:column{"
(toggle_column (sublist layers (* (/ len 3) 2) nil))
)
)
(T
(strcat (toggle_column (sublist layers 0 (/ len 4)))
"}:column{"
(toggle_column (sublist layers (/ len 4) (/ len 4)))
"}:column{"
(toggle_column (sublist layers (/ len 2) (/ len 4)))
"}:column{"
(toggle_column (sublist layers (* (/ len 4) 3) nil))
)
)
)
"}}spacer;ok_cancel;}"
)
file
)
(close file)
(setq dcl_id (load_dialog tmp))
(if (not (new_dialog "GetLayers" dcl_id))
(exit)
)
(foreach n lst1
(set_tile n "1")
)
(foreach n lst2
(mode_tile n 1)
)
(action_tile
"accept"
"(setq lst nil)
(foreach n layers
(if (= (get_tile n) \"1\")
(setq lst (cons n lst))))
(done_dialog)"
)
(start_dialog)
(unload_dialog dcl_id)
(vl-file-delete tmp)
lst
)
Accepted solution
Try this
;; List Box - Lee Mac
;; Displays a DCL list box allowing the user to make a selection from the supplied data.
;; msg - [str] Dialog label
;; lst - [lst] List of strings to display
;; bit - [int] 1=allow multiple; 2=return indexes
;; Returns: [lst] List of selected items/indexes, else nil
(defun LM:listbox ( msg lst bit / dch des tmp rtn )
(cond
( (not
(and
(setq tmp (vl-filename-mktemp nil nil ".dcl"))
(setq des (open tmp "w"))
(write-line
(strcat "listbox:dialog{label=\"" msg "\";spacer;:list_box{key=\"list\";multiple_select="
(if (= 1 (logand 1 bit)) "true" "false") ";width=50;height=15;}spacer;ok_cancel;}"
)
des
)
(not (close des))
(< 0 (setq dch (load_dialog tmp)))
(new_dialog "listbox" dch)
)
)
(prompt "\nError Loading List Box Dialog.")
)
( t
(start_list "list")
(foreach itm lst (add_list itm))
(end_list)
(setq rtn (set_tile "list" "0"))
(action_tile "list" "(setq rtn $value)")
(setq rtn
(if (= 1 (start_dialog))
(if (= 2 (logand 2 bit))
(read (strcat "(" rtn ")"))
(mapcar '(lambda ( x ) (nth x lst)) (read (strcat "(" rtn ")")))
)
)
)
)
)
(if (< 0 dch)
(unload_dialog dch)
)
(if (and tmp (setq tmp (findfile tmp)))
(vl-file-delete tmp)
)
rtn
)
(defun select_layers ( / layer_collection layerlist)
(setq layer_collection(vla-get-Layers(vla-get-ActiveDocument(vlax-get-acad-object))))
(vlax-for item layer_collection (setq layerlist (cons (vlax-get item 'Name) layerlist)))
(LM:listbox "Layers:" (reverse layerlist) 1)
)
(setq sel (select_layers))
Miljenko Hatlak
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
Accepted solution
If you have less than say 25 layers can use this also, it will make a dcl with radio buttons. There are 4 versions available Multi Radio Buttons, multi getvals, multi toggles and Multi getvals image, the simplest download location is Cadtutor\downloads. Else email info@alanh.com.au and will send all back to you.
The code needed
(setq lst (list of layers))
(if (not AH:Butts)(load "Multi Radio buttons.lsp"))
(if (= but nil)(setq but 1))
(setq ans (ah:butts but "V" lst)) ; in this case returns layer name.
Glad to help. RLX has some nice library DCL's as well.
This is the two columns choice
; Multi ah:button Dialog box for 2 columns choice replacement of initget
; By Alan H Feb 2021 info@alanh.com.au
; It will remember what ah:button ws pressed if ran again with same request.
; (if (not ah:buttscol)(load "Multi radio buttons 2col.lsp")); loads the program if not loaded already
; (if (not ah:but)(setq ah:but 1)) ; this is needed to set default ah:button
; (if (not ah:but2)(setq ah:but2 1)) ; you can reset default ah:button to user pick
; just use "but" value and compare to a list
; if you want a number use (atof (nth ah:but ah:butlst) or (atoi (nth ah:but2 ah:butlst2)
; (if (not ah:buttscol)(load "Multi Radio buttons 2col.lsp"))
; (if (= ah:but nil)(setq ah:but 1))
; (if (= ah:but2 nil)(setq ah:but2 1))
; (setq lst (list "Select angle" "2 pts" "45" "90" "180" "225" "270" "315" ))
; (setq lst2 (list "Select type" "Rotate" "Label" "Marker" "Both"))
; (ah:buttscol ah:but ah:but2 "Rotate point" lst lst2)
;(if (= ah:2col nil)(setq ah:2col 1))
;(if (= ah:2col2 nil)(setq ah:2col2 1))
;(setq lst (list "Select number" "1" "2" "3" "4" "5" "6" "7" "8" "9" "10"))
;(setq lst2 (list "Select Char" "A" "B" "C" "D"))
;(ah:buttscol ah:2col ah:2col2 "Please choose" lst lst2)
;(setq ans1 (nth ah:2col ah:butlst))
;(setq ans2 (nth ah:2col2 ah:butlst2))
;(ah:buttscol ah:but ah:but2 "please choose" '("Yes or No" "Yes" "No") '("up" "down") )
(defun col1 ( / l)
(setq x 1)
(repeat (length ah:butlst)
(setq l (strcat "1Rb" (rtos x 2 0)))
(if (= (get_tile l) "1" )
(setq ah:col1 x)
)
(setq x (+ x 1))
)
(princ)
)
(defun col2 ( / j )
(setq x 1)
(repeat (length ah:butlst)
(setq j (strcat "2Rb" (rtos x 2 0)))
(if (= (get_tile j) "1" )
(setq ah:col2 x)
)
(setq x (+ x 1))
)
(princ)
)
(defun ah:buttscol (ahdef1 ahdef2 toplabel ah:butlst ah:butlst2 / fo fname x k )
(setq len1 (length ah:butlst) len2 (length ah:butlst2))
; do wid1 wid2 next version
(setq fo (open (setq fname "d:\\acadtemp\\test.dcl") "w"))
;(setq fo (open (setq fname (vl-filename-mktemp "" "" ".dcl")) "w"))
(write-line "AHbuttscol : dialog {" fo)
(write-line (strcat " label = " (chr 34) toplabel (chr 34) ";" ) fo)
(write-line " : row {" fo)
(write-line " : boxed_radio_column {" fo)
(write-line (strcat " width = 24 ;") fo)
(setq x 1)
(write-line (strcat " label = " (chr 34) (nth 0 ah:butlst) (chr 34) " ;" )fo)
(repeat (- (length ah:butlst) 1)
(write-line " : radio_button {" fo)
(write-line (strcat "key = " (chr 34) "1Rb" (rtos x 2 0) (chr 34) ";") fo)
(write-line (strcat "label = " (chr 34) (nth x ah:butlst) (chr 34) ";") fo)
(write-line " }" fo)
(write-line "spacer_1 ;" fo)
(setq x (+ x 1))
)
(if (< len1 len2)
(repeat (- len2 len1)
(write-line "spacer_1 ;" fo)
)
)
(write-line " }" fo)
(write-line " : boxed_radio_column {" fo)
(write-line (strcat " width = 24 ;") fo)
(setq x 1)
(write-line (strcat " label = " (chr 34) (nth 0 ah:butlst2) (chr 34) " ;" )fo)
(repeat (- (length ah:butlst2) 1)
(write-line " : radio_button {" fo)
(write-line (strcat "key = " (chr 34) "2Rb" (rtos x 2 0) (chr 34) ";") fo)
(write-line (strcat "label = " (chr 34) (nth x ah:butlst2) (chr 34) ";") fo)
(write-line " }" fo)
(write-line "spacer_1 ;" fo)
(setq x (+ x 1))
)
(if (< len2 len1)
(repeat (- len1 len2)
(write-line "spacer_1 ;" fo)
)
)
(write-line " }" fo)
(write-line " }" fo)
(write-line "spacer_1 ;" fo)
(write-line " ok_cancel ;" fo)
(write-line " }" fo)
(close fo)
(setq dcl_id (load_dialog fname))
(if (not (new_dialog "AHbuttscol" dcl_id) )
(exit)
)
(setq x 1)
(repeat (- (length ah:butlst) 1)
(setq k (strcat "1Rb" (rtos x 2 0)))
(action_tile k (strcat "(setq ah:2col " (rtos x 2 0) ")" ))
(if (= ahdef1 x)(set_tile k "1"))
(setq x (+ x 1))
)
(setq x 1)
(repeat (- (length ah:butlst2)1)
(setq k (strcat "2Rb" (rtos x 2 0)))
(action_tile k (strcat "(setq ah:2col2 " (rtos x 2 0) ")" ))
(if (= ahdef2 x)(set_tile k "1"))
(setq x (+ x 1))
)
(action_tile "accept" "(col1) (col2) (done_dialog)")
(action_tile "cancel" "(done_dialog) (exit)")
(start_dialog)
(unload_dialog dcl_id)
(vl-file-delete fname)
(princ)
) ; end defun
