Check boxes in DCL

Hello everyone,

I have been trying to implement check boxes in dcl. It appears whether I select or not the return value from the toggle is same (the 0 value). I give below the code and the dialog used.

Any help to get this sorted out will be greatly appreciated.

Aloy

samp8 : dialog {				//dialog name
     label = "Pipe Lines" ;      //give it a label

      : row {					//define row

      :boxed_column {			//define radio column
      label = "Pipe diameters used (mm)" ; //give it a label

       : toggle {			//define toggle
    	  key = "tog1" ;				//give it a name
    	  label = "150" ;	                //give it a label
    	    				
    	  }					

    	: toggle {			//define toggle
    	  key = "tog2" ;				//give it a name
    	  label = "200" ;		//give it a label
    	}				

    	: toggle {			//define toggle
    	  key = "tog3" ;				//give it a name
    	  label = "225" ;	                //give it a label
    	  }					

    	: toggle {			//define toggle
    	  key = "tog4" ;				//give it a name
    	  label = "250" ;		        //give it a label
    	}					

    	: toggle {			//define toggle
    	  key = "tog5" ;				//give it a name
    	  label = "300" ;	               //give it a label
    	  }					

    	: toggle {			//define toggle
    	  key = "tog6" ;				//give it a name
    	  label = "375" ;	                //give it a label
    	}

    	: toggle {			//define toggle
    	  key = "tog7" ;				//give it a name
    	  label = "450" ;	                //give it a label
    	}

    	: toggle {			//define toggle
    	  key = "tog8" ;				//give it a name
    	  label = "600" ;	               //give it a label
    	}

       }					//end toggle collumn

       : boxed_column {			//define boxed column
       label = "Variables" ;
       
       

    	: edit_box {				//edit box
       key = "eb1" ;
       label = "Manning 'n'" ;                   
       edit_width = 6 ;				
       
       
       }

       : edit_box {				//edit box
       key = "eb2" ;		           	
       label = "% part full" ;
       edit_width = 6 ;		
       }

      }					//end boxed collumn
      

     
       }				

    ok_cancel ;				//predifined OK/Cancel 
   
   					//end text
    }
(defun C:samp8 ()
 (setq dcl_id(load_dialog "samp8.dcl"))
 (if(not(new_dialog "samp8" dcl_id)
    )
   (exit)
 )
 (set_tile "eb1" "0.013")
  (set_tile "eb2" "50")
 (setq t1(atoi(get_tile "tog1")))
 
 (setq t2(atoi(get_tile "tog2")))
 
 (setq t3(atoi(get_tile "tog3")))
 
 (setq t4(atoi(get_tile "tog4")))

 (setq t5(atoi(get_tile "tog5")))
 
 (setq t6(atoi(get_tile "tog6")))
 
 (setq t7(atoi(get_tile "tog7")))
 
 (setq t8(atoi(get_tile "tog8")))
 

 (start_dialog)
 (unload_dialog dcl_id)
 )
 

Toggle's value varies from "0" to "1", those are string-integers:

"0" is the value when its unchecked

"1" is the value when its checked

Or in LISP words "0" -> nil ; "1" -> T.

It would be nice if it was possible to obtain the label attribute in the callback, but generally the available attributes are: $key $value $data $reason $x $y.

But you can still get what you want with a bit of list manipulation (assoc lists) or 2 lists: one that collects the toggle values (results) when user clicks OK and second that holds all the pipe diameters.

Or something similair:

(defun C:test ( / *error* dcl des dch dcf togglekeys t1 t2 t3 t4 t5 t6 t7 t8 )
 
 (defun *error* ( msg )
   (and (< 0 dch) (unload_dialog dch))
   (and (eq 'FILE (type des)) (close des))
   (and (eq 'STR (type dcl)) (findfile dcl) (vl-file-delete dcl))
   (and msg (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\nError: " msg)) ))
   (princ)
 ); defun *error*
 
 (cond 
   (
     (and (setq dcl (vl-filename-mktemp nil nil ".dcl")) (setq des (open dcl "w"))
       (mapcar (function (lambda (x) (princ (strcat "\n" x) des))) 
         '("samp8 : dialog "
           "{ label = \"Pipe Lines\";"
           "  : row "
           "  { : boxed_column "
           "    { label = \"Pipe diameters used (mm)\";  "
           "      : toggle { key = \"tog1\"; label = \"150\"; }"
           "      : toggle { key = \"tog2\"; label = \"200\"; }"
           "      : toggle { key = \"tog3\"; label = \"225\"; }"
           "      : toggle { key = \"tog4\"; label = \"250\"; }"
           "      : toggle { key = \"tog5\"; label = \"300\"; }"
           "      : toggle { key = \"tog6\"; label = \"375\"; }"
           "      : toggle { key = \"tog7\"; label = \"450\"; }"
           "      : toggle { key = \"tog8\"; label = \"600\"; }"
           "    }"
           "    : boxed_column"
           "    { label = \"Variables\";"
           "      : edit_box { key = \"eb1\"; label = \"Manning 'n'\"; edit_width = 6 ; value = \"0.013\"; }"
           "      : edit_box { key = \"eb2\"; label = \"% part full\"; edit_width = 6 ; value = \"50\"; }"
           "    }"
           "  }"
           "  ok_cancel;"
           "}"
         ); list
       ); mapcar
       (not (setq des (close des))) (< 0 (setq dch (load_dialog dcl))) (new_dialog "samp8" dch)
     ); and
     (setq togglekeys '("tog1" "tog2" "tog3" "tog4" "tog5" "tog6" "tog7" "tog8"))
     ; (client_data_tile "mykey" "mydata")
     ; (mapcar 'client_data_tile togglekeys '("150" "200" "225" "250" "300" "375" "450" "600")) ; this won't work in my plan here
     (client_data_tile "accept" (vl-prin1-to-string '("150" "200" "225" "250" "300" "375" "450" "600")))
     (action_tile "accept"
       (vl-prin1-to-string
         '(progn (mapcar 'set '(t1 t2 t3 t4 t5 t6 t7 t8) (read $data))
           (mapcar '(lambda (a b) (if (= a "0") (set b nil))) (mapcar 'get_tile togglekeys) '(t1 t2 t3 t4 t5 t6 t7 t8) )
           (done_dialog 1)
         ); progn
       ); vl-prin1-to-string
     ); action_tile 
     (if (= 1 (setq dcf (start_dialog)))
       (alert (strcat "\nUser has chosen toggles:\n" (vl-prin1-to-string (vl-remove-if 'null (list t1 t2 t3 t4 t5 t6 t7 t8)))))
       (princ "\nUser cancelled the dialog.")
     )
   )
 ); cond
 (*error* nil) (princ)
); defun C:test

Also try to compact your code (the DCL language is easy to read).

The other way is use a list box with the pipe sizes in it and pick the required size nice thing is its easy to add another size or type etc

150pvc 150conc

Check Lee's site for list box dcl.

Like BIGAL mentioned, list_box is the usual way to perform such task (IMO thats the most flexible tile, that could substitute toggles/buttons/radio_buttons/popup_lists).

Anyway heres another way by assigning action to every toggle, like this:

(action_tile "tog4" 
 (vl-prin1-to-string 
   '(cond 
     ( (= "0" $value) (setq t4 nil) )
     ( (= "1" $value) (setq t4 250) )
   )
 )
)

But doing such thing requires alot of repetition, so without list processing you'll end up with a very long code.

Grrr,

Your earlier solution also works fine. However for simplicity I prefer your second option.

Thanks a lot Grrr.

aloy had a go using a list see what you think.

: credit to lee-mac for original dcl list routine
(defun C:samp8 ( )
 (setq lst (list "150" "200" "225" "250" "300" "375" "450" "600"))
 (setq dcl_id (load_dialog "c:\\acadtemp\\samp8.dcl")) ;  change directory path to known location
 (if (not (new_dialog "samp8" dcl_id))
   (exit)
 )
 (set_tile "eb1" "0.013")
 (set_tile "eb2" "50")
 (start_list "list")
 (foreach itm lst (add_list itm))
 (end_list)
 (setq rtn (set_tile "list" "0"))
 (action_tile "list" "(setq rtn (atof (nth (atoi $value) lst)))")
 (action_tile "eb1" "(setq mann (atof $value))")
 (action_tile "eb2" "(setq perc (atof $value))")
 (start_dialog)
 (unload_dialog dcl_id)
(alert "use !rtn !perc !mann to see answers") ; rub this line out later
)

samp8 : dialog {				//dialog name
      label = "Pipe Lines" ;      //give it a label
      : row {				//define row
      :boxed_column {			//define 2 x column
      label="Pipe diameters used (mm)" ; //give it a label
      spacer;
      :list_box{key="list";
      multiple_select=false;
      width=10;
      height=15;
      }                              //end list box
      }			      //end boxed column

      : boxed_column {			//define boxed column
      label = "Variables" ;
      : edit_box {			//edit box
      key = "eb1" ;
      label = "Manning 'n'" ;                   
      edit_width = 6 ;
      }                                //end edit box

      : edit_box {			//edit box
      key = "eb2" ;		           	
      Label = "% part full" ;
      edit_width = 6 ;		
      }				//end edit box
      }				//end boxed collumn      
      }		                //end row	

      ok_cancel ;			//predifined OK/Cancel 
}

BIGAL,

The code doesn't seem to work. I could not see the list box. Will try to sort out after reading the samples.

Thanks.

Aloy

You need to change the directories name I hard coded to my pc for testing and the samp8.dcl needs to exist in your chosen directory.

"c:\\acadtemp\\samp8.dcl"

BIGAL you could use something like this:

(if
 (or
   (setq dcf (findfile "samp8.dcl"))
   (setq dcf (getfiled "Samp8.dcl Not Found, Please Specify the DCL file" "" "dcl" 0))
 )
 (setq dcl_id (load_dialog dcf))
 (exit)
); if 

to avoid "it doesn't work" replies.

Thanks BIGAL, yes it works. However I need the all the multiple pipes selected to be included in rtn. It gives me one pipe at a time. My efforts by changing the multiple selections 'true' did not work either.

I couldn't resist:

(defun C:test ( / *error* dcl des dch dcf L r mann perc ChosenDiameters )
 
 (defun *error* ( msg )
   (and (< 0 dch) (unload_dialog dch))
   (and (eq 'FILE (type des)) (close des))
   (and (eq 'STR (type dcl)) (findfile dcl) (vl-file-delete dcl))
   (and msg (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\nError: " msg)) ))
   (princ)
 ); defun *error*
 
 (if 
   (and ; write the dialog on the fly - temporary use 
     (setq dcl (vl-filename-mktemp nil nil ".dcl")) 
     (setq des (open dcl "w"))
     (princ
       (strcat
         "samp8 : dialog"
         "{ label = \"Pipe Lines\";"
         "  : row"
         "  { : boxed_column"
         "    { label = \"Pipe diameters used (mm)\"; spacer;"
         "      : list_box { key = \"LB\"; multiple_select = true; width = 10; height = 15; }"
         "    }"
         "    : boxed_column "
         "    { label = \"Variables\";"
         "      : edit_box { key = \"eb1\"; label = \"Manning 'n'\"; edit_width = 6 ; value = \"0.013\"; }"
         "      : edit_box { key = \"eb2\"; label = \"% part full\"; edit_width = 6 ; value = \"50\"; }"
         "    }"
         "  }"
         "  ok_cancel;"
         "}"
       ); strcat
       des
     ); princ
     (not (setq des (close des)))
     (setq dch (load_dialog dcl))
     (new_dialog "samp8" dch)
   ); and
   (progn
     ; Populate the list_box tile:
     (start_list "LB") 
     (mapcar 'add_list (setq L '("150" "200" "225" "250" "300" "375" "450" "600")))
     (end_list)
     ; Set the first item as default value in the list box:
     (set_tile "LB" "0") 
     ; Set default values - if ok is pressed without any input:
     (setq r (get_tile "LB"))
     (setq mann (get_tile "eb1"))
     (setq perc (get_tile "eb2"))
     ; Set default actions for the tiles:
     (action_tile "LB" "(setq r $value)")
     (action_tile "eb1" "(setq mann $value)")
     (action_tile "eb2" "(setq perc $value)")
     (action_tile "accept" "(done_dialog 1)")
     ; Store the result - if user pressed OK, dcf will be 1, else 0
     (setq dcf (start_dialog))
   ); progn
 ); if
 (*error* nil) ; unload, and erase the temporary dcl file
 
 ; Check if user pressed OK
 (if (= 1 dcf) 
   (alert ; Display the results:
     (strcat
       "\nList of selected diameters: \n"
       (vl-prin1-to-string (setq ChosenDiameters (mapcar '(lambda (x) (nth x L)) (read (strcat "(" r ")")))))
       "\nManning: " mann
       "\nPercentage: " perc
     ); strcat
   ); alert
 ); if 
 (princ)
); defun

Credits to Lee Mac ofcourse (but basically every DCL code I write, he's hidden there - In my knowledge).

Understand you want to be able to pick multiple sizes from the list check out lee-mac listbox lsp allows multi select I will check it out also.

; credit to lee-mac for original dcl list routine
(defun C:samp8 ( )
(setq lst (list "150" "200" "225" "250" "300" "375" "450" "600"))
(setq rtn '())
(setq dcl_id (load_dialog "c:\\acadtemp\\samp8.dcl")) ; change directory path to known location
(if (not (new_dialog "samp8" dcl_id))
(exit)
)
(set_tile "eb1" "0.013")
(set_tile "eb2" "50")
(start_list "list")
(foreach itm lst (add_list itm))
(end_list)
(setq ans (set_tile "list" "0"))
(action_tile "list" "(setq rtn (cons (atof (nth (atoi $value) lst)) rtn))")

(action_tile "eb1" "(setq mann (atof $value))")
(action_tile "eb2" "(setq perc (atof $value))")
(start_dialog)


(unload_dialog dcl_id)
(alert "use !rtn !perc !mann to see answers") ; rub this line out later
)

The $value string for a multi select list_box can contain multiple integers (e.g. "5 1 3"). You can use something like this to process it:

(action_tile "list" "(setq rtn (mapcar '(lambda (idx) (nth idx lst)) (read (strcat \"(\" $value \")\"))))")

Thanks BIGAL, Grrr and Roy,

My aim of trying to find a solution was to automatically select the most appropriate diameter and slope for a particular flow with other condition that apply like the value n and 'percentage full'. I was able to do it successfully using the dcl in my posting No.1 and the method for capturing the selection given by Grrr nicely in his post No.4 as follows:

(defun C:samp11 ()
 (setq dcl_id(load_dialog "samp11.dcl"))
 (if(not(new_dialog "samp11" dcl_id)
    )
   (exit)
 )
 
(action_tile "tog1"
 (vl-prin1-to-string
   '(cond
      ( (= "0" $value) (setq t1 nil))
      ( (= "1" $value) (setq t1 150)))))
(action_tile "tog2"
 (vl-prin1-to-string
   '(cond
      ( (= "0" $value) (setq t2 nil))
      ( (= "1" $value) (setq t2 200)))))
(action_tile "tog3"
 (vl-prin1-to-string
   '(cond
      ( (= "0" $value) (setq t3 nil))
      ( (= "1" $value) (setq t3 225)))))
(action_tile "tog4"
 (vl-prin1-to-string
   '(cond
      ( (= "0" $value) (setq t4 nil))
      ( (= "1" $value) (setq t4 250)))))
(action_tile "tog5"
 (vl-prin1-to-string
   '(cond
      ( (= "0" $value) (setq t5 nil))
      ( (= "1" $value) (setq t5 300)))))
(action_tile "tog6"
 (vl-prin1-to-string
   '(cond
      ( (= "0" $value) (setq t6 nil))
      ( (= "1" $value) (setq t6 375)))))
(action_tile "tog7"
 (vl-prin1-to-string
   '(cond
      ( (= "0" $value) (setq t7 nil))
      ( (= "1" $value) (setq t7 450)))))
(action_tile "tog8"
 (vl-prin1-to-string
   '(cond
      ( (= "0" $value) (setq t8 nil))
      ( (= "1" $value) (setq t8 600)))))
(start_dialog)
 (unload_dialog dcl_id)
 )
 

(defun pdandslope()
 (setq lst nil)
 (setq p150 '((150.0 120.0) (150.0 110.0) (150.0 100.0)))
 (setq p200 '((200.0 150.0) (200.0 140.0) (200.0 120.0)))
 (setq p225 '((225.0 180.0) (225.0 170.0) (225.0 160.0) (225.0 150.0)))
 (setq p250 '((250.0 200.0) (250.0 180.0) (225.0 170.0) (225.0 160.0)))
 (setq p300 '((300.0 300.0) (300.0 280.0) (300.0 260.0) (300.0 250.0) (300.0 240.0) (300.0 220.0) 
              (300.0 200.0) (300.0 180.0)))
 (setq p375 '((375.0 350.0) (375.0 320.0) (375.0 300.0) (375.0 280.0)))
 (setq p450 '((450.0 400.0) (450.0 370.0) (450.0 350.0) (450.0 320.0)))
 (setq p600 '((600.0 500.0) (600.0 450.0) (600.0 420.0) (600.0 400.0)))  
(if (= t1 150)
 (setq lst(cons p150 lst))
 )
(if (= t2 200)
 (setq lst(cons p200 lst))
 )
(if (= t3 225)
 (setq lst(cons p225 lst))
 )
(if (= t4 250)
 (setq lst(cons p250 lst))
 )
(if (= t5 300)
 (setq lst(cons p300 lst))
 )
(if (= t6 375)
 (setq lst(cons p375 lst))
 )
(if (= t7 450)
 (setq lst(cons p450 lst))
 )
(if (= t8 600)
 (setq lst(cons p600 lst))  
 )
 (setq lst(reverse lst))
)  

The list 'lst' was used elsewhere successfully to get the final outcome. Thanks for guiding me.

Aloy

I would suggest the following:

([color=BLUE]defun[/color] c:samp12 ( [color=BLUE]/[/color] bit cnt dch lst rtn )
   ([color=BLUE]setq[/color] lst
      '(
           ((150.0 120.0) (150.0 110.0) (150.0 100.0))
           ((200.0 150.0) (200.0 140.0) (200.0 120.0))
           ((225.0 180.0) (225.0 170.0) (225.0 160.0) (225.0 150.0))
           ((250.0 200.0) (250.0 180.0) (225.0 170.0) (225.0 160.0))
           ((300.0 300.0) (300.0 280.0) (300.0 260.0) (300.0 250.0) (300.0 240.0) (300.0 220.0) (300.0 200.0) (300.0 180.0))
           ((375.0 350.0) (375.0 320.0) (375.0 300.0) (375.0 280.0))
           ((450.0 400.0) (450.0 370.0) (450.0 350.0) (450.0 320.0))
           ((600.0 500.0) (600.0 450.0) (600.0 420.0) (600.0 400.0))
       )
   )
   ([color=BLUE]cond[/color]
       (   ([color=BLUE]<=[/color] ([color=BLUE]setq[/color] dch ([color=BLUE]load_dialog[/color] [color=MAROON]"samp11.dcl"[/color])) 0)
           ([color=BLUE]princ[/color] [color=MAROON]"\nsamp11.dcl not found or could not be loaded."[/color])
       )
       (   ([color=BLUE]not[/color] ([color=BLUE]new_dialog[/color] [color=MAROON]"samp11"[/color] dch))
           ([color=BLUE]princ[/color] [color=MAROON]"\nError in samp11.dcl file."[/color])
       )
       (   ([color=BLUE]setq[/color] bit 1 cnt 1 rtn 0)
           ([color=BLUE]repeat[/color] ([color=blue]length[/color] lst)
               ([color=BLUE]action_tile[/color]
                   ([color=BLUE]strcat[/color] [color=MAROON]"tog"[/color] ([color=BLUE]itoa[/color] cnt))
                   ([color=BLUE]strcat[/color] [color=MAROON]"(setq rtn (boole (+ 4 (* 3 (atoi $value))) "[/color] ([color=BLUE]itoa[/color] bit) [color=MAROON]" rtn))"[/color])
               )
               ([color=BLUE]setq[/color] bit ([color=BLUE]lsh[/color] bit 1) cnt ([color=BLUE]1+[/color] cnt))
           )
           ([color=BLUE]if[/color] ([color=BLUE]=[/color] 1 ([color=BLUE]start_dialog[/color]))
               ([color=BLUE]setq[/color] bit 1
                     lst
                   ([color=BLUE]vl-remove-if[/color]
                      '([color=BLUE]lambda[/color] ( x [color=BLUE]/[/color] flg ) ([color=BLUE]setq[/color] flg ([color=BLUE]zerop[/color] ([color=BLUE]logand[/color] bit rtn)) bit ([color=BLUE]lsh[/color] bit 1)) flg)
                       lst
                   )
               )
           )
       )
   )
   ([color=BLUE]if[/color] ([color=BLUE]<[/color] 0 dch) ([color=BLUE]unload_dialog[/color] dch))
   ([color=BLUE]princ[/color])
)

BTW wouldn't:

(setq lst
 '(
   ((150.0 120.0) (150.0 110.0) (150.0 100.0))
   ((200.0 150.0) (200.0 140.0) (200.0 120.0))
   ((225.0 180.0) (225.0 170.0) (225.0 160.0) (225.0 150.0))
   ((250.0 200.0) (250.0 180.0) (225.0 170.0) (225.0 160.0))
   ((300.0 300.0) (300.0 280.0) (300.0 260.0) (300.0 250.0) (300.0 240.0) (300.0 220.0) (300.0 200.0) (300.0 180.0))
   ((375.0 350.0) (375.0 320.0) (375.0 300.0) (375.0 280.0))
   ((450.0 400.0) (450.0 370.0) (450.0 350.0) (450.0 320.0))
   ((600.0 500.0) (600.0 450.0) (600.0 420.0) (600.0 400.0))
 )
)

This list format be better:

(setq lst
 '(
   (150.0 (120.0 110.0 100.0))
   (200.0 (150.0 140.0 120.0))
   (225.0 (180.0 170.0 160.0 150.0))
   (250.0 (200.0 180.0))
   (300.0 (300.0 280.0 260.0 250.0 240.0 220.0 200.0 180.0))
   (375.0 (320.0 300.0 280.0))
   (450.0 (400.0 370.0 350.0 320.0))
   (600.0 (500.0 450.0 420.0 400.0))
 )
)

If the first sub-sub-items per item are the same.

I was wondering what you were doing there may be a better approach all together, if you look at the flow formula for a pipe it includes slope as part of its calculation, given a flow and starting at say 150 you will get a slope answer if this is way off ie vertical then go to next dia till it starts to give a reasonable slope answer then you could say do a + or - and lock in pipe dia. This is a method employed by a lot of civil drainage design software start with a seed flow and increase dia in our case a dialouge box with a up down arrow.

I use this for instant flows just draw a circle for a pipe true size or a shape for a channel using a pline and can trim horizontal to work out open channel size.

; channel flow based on mannings value and a horizontal pline
; By alan H
(defun mannpipe ( / vlent ent objlen objarea vel r slope Qcap)
(princ "this is in lisp")
(vl-load-com)
(setq ent (entsel "\npick pline or circle"))
(setq vlent (vlax-ename->vla-object (car ent)))
;; check to see if the object selected is a polyline or circle
(if (= (vla-get-objectname vlent) "AcDbPolyline")
(PROGN
(setq objLEN (vla-get-LENGTH vlent))
(setq objAREA (vla-get-AREA vlent))
)
)
(if (= (vla-get-objectname vlent) "AcDbCircle")
     (PROGN
     (setq RAD (vla-get-Radius vlent))
     (setq objarea (vla-get-area vlent))
     (setq objlen (vla-get-Circumference vlent))
     )
)
     (setq R (/ objarea objlen))
     (setq mannings (getreal "\nEnter mannings value"))
     (setq slope (getreal "\nEnter slope in % "))
     (setq p1 (/ 2.0 3.0))
     (setq vel (/ (* (expt r p1) (sqrt (/ slope 100.0))) mannings  )) ;mannings formula
     (setq Qcap (* 1000.0 (* Vel objarea))) ; lt/s
(if (= Qcap nil)
 (princ "\nSelect again not a pline or Circle")
)
(PRINC (strcat "\Flow " (rtos Qcap 2 0) " l/s Velocity " (rtos Vel  2 2) " m/s"))
)
; end of defun
(mannpipe)

q=AR2/3 *(sqrt slope)/n

I would suggest the following:

Impressive, I didn't understood a thing!

Neat and nice. It works by making lst global.

Many thanks Lee.