[编程交流] 下拉选项

;list select dialog
;create a temp DCL multi-select list dialog from provided list
;value is returned in list form, DCL file is deleted when finished
;example: (setq the_list (AT:listselect "This is my list title" "Select items to make a list" "25" "30" "true" (list "object 1" "object 2" "object 3"))
;if mytitle is longer than defined width, the width will be ignored and it will fit to title string
;if mylabel is longer than defined width, mylabel will be truncated
;myheight and mywidth must be strings, not numbers
;mymultiselect must either be "true" or "false" (true for multi, false for single)
;created by: alan thompson, 9.23.08
;some coding borrowed from http://www.jefferypsanders.com (thanks for the DCL examples)
(defun AT:listselect  ( mytitle       ;title for dialog box
           mylabel       ;label right above list box
           myheight      ;height of dialog box !!*MUST BE STRING*!!
           mywidth       ;width of dialog box !!*MUST BE STRING*!!
           mymultiselect ;"true" for multiselect, "false" for single select
           mylist        ;list to display in list box
           / retlist readlist count item savevars fn fo valuestr dcl_id )
(defun saveVars(/ readlist count item)
 (setq retList(list))
 (setq readlist(get_tile "mylist"))
 (setq count 1)
 (while (setq item (read readlist))
   (setq retlist(append retList (list (nth item myList))))
   (while
     (and
       (/= " " (substr readlist count 1))
       (/= ""   (substr readlist count 1))
     )
     (setq count (1+ count))
   )
   (setq readlist (substr readlist count))
 )
);defun
(setq fn (vl-filename-mktemp "" "" ".dcl"))
(setq fo (open fn "w"))
(setq valuestr (strcat "value = "" mytitle "";"))
(write-line (strcat "list_select : dialog {
           label = "" mytitle "";") fo)
(write-line 
(strcat "          : column {
           : row {
             : boxed_column {
              : list_box {
                 label ="" mylabel "";
                 key = "mylist";
                 allow_accept = true;
                 height = " myheight ";
                 width = " mywidth ";
                 multiple_select = " mymultiselect ";
                 fixed_width_font = false;
                 value = "0";
               }
             }
           }
           : row {
             : boxed_row {
               : button {
                 key = "accept";
                 label = " Okay ";
                 is_default = true;
               }
               : button {
                 key = "cancel";
                 label = " Cancel ";
                 is_default = false;
                 is_cancel = true;
               }
             }
           }
         }
}") fo)
(close fo)
(setq dcl_id (load_dialog fn))
(new_dialog "list_select" dcl_id)
 (start_list "mylist" 3)
 (mapcar 'add_list myList)
 (end_list)
 (action_tile "cancel" "(setq ddiag 1)(done_dialog)")
 (action_tile "accept" "(setq ddiag 2)(saveVars)(done_dialog)")
 (start_dialog)
 (if (= ddiag 1)
    (setq retlist nil)
 )
(unload_dialog dcl_id)
(vl-file-delete fn)
retlist
);defun

(defun menuoptions ()
 (if (= mass nil)(setq Mass 0.00000785))                        ;End if
 (if (= mass 0.00000818)(setq masstype "316 S.S."))                    ;End if
 (if (= mass 0.00000785)(setq masstype "MILD STEEL"))                    ;End if
 (if (= mass 0.0000078029)(setq masstype "SAF 3402"))                    ;End if
 (if (= masli nil)(setq masli "YES"))                                    ;End if
;--------------------------------settings------------------------------------
 (cond
   ((= "AU" sectionlocation)
    (princ "\n-----AUSTRALIAN SECTIONS------"))
   ((= "C" sectionlocation)
    (princ "\n------CANADIAN SECTIONS------"))
   ((= "AM" sectionlocation)
    (princ "\n------AMERICAN SECTIONS-------"))
   ((= "S" sectionlocation)
    (princ "\n------SOUTH AFRICAN SECTIONS------"))
   )
 (princ "\n<SE>  = SETTINGS, ALLOWS YOU TO SET MASS PROPERTIES")
 (princ "\n<N>   = SET ITEM NUMBER")
 (princ "\n<M>   = TOGGLE MASS BOX INSERTION ON/OFF")
 (princ "\n<C>   = CONE PROGRAM, FINDS OUT WEIGHT OF A CONE")
 (princ "\n<D>   = FOR PIPE OR FLANGE SIZES")
 (princ "\n<CU>  = CUSTOM FLANGE")
 ; CHANGES DEPENDING ON SETTING FOR CAN AMERICAN OR SA SECTIONS
 (if (= nil sectionlocation)
   (setq sectionlocation "AU")
 )
 (cond 
       ((= "AU" sectionlocation)
           (progn
             (princ "\n<E>   = EQUAL ANGLE")
             (princ "\n<U>   = UNEQUAL ANGLES")
             (princ "\n<P>   = PFC")
             (princ "\n<B>   = UNVERSAL BEAM")
             (princ "\n<UC>  = UNVERSAL COLUMN")
             (princ "\n<NA>  = NON-AUSTRLIAN SECTION")
            )
       )
       ((OR (= "AM" sectionlocation)(= "C" sectionlocation))
           (progn 
               (princ "\n<W>   = 'W'  TYPE BEAM")
               (princ "\n<H>   = 'HP' TYPE BEAM")
               (princ "\n<MM>  = 'M'  TYPE BEAM")
               (princ "\n<S>   = 'S'  TYPE BEAM")
               (princ "\n<MC>  = 'MC' TYPE BEAM")
               (princ "\n<CC>   = CHANNEL")
               (princ "\n<A>   = ANGLE")
           )
       )
       ;((= "C" sectionlocation) THE CAN IS THE SAME AS THE AMERICAN ONE,
       ((= "S" sectionlocation)
           (progn
               (princ "\n<W>   = 'W'  TYPE BEAM")
               (princ "\n<H>   = 'HP' TYPE BEAM")
               (princ "\n<MM>  = 'M'  TYPE BEAM")
               (princ "\n<S>   = 'S'  TYPE BEAM")
               (princ "\n<MC>  = 'MC' TYPE BEAM")
               (princ "\n<C>   = CHANNEL")
               (princ "\n<A>   = ANGLE")
           )
       )
 )
 
       
 (princ "\nWelcome To weight calc ")
 (if (= masli "YES")
 (princ "\nYou currently want Mass box insertion ON")
 (princ "\nYou currently want Mass box insertion OFF")
 )
 (princ "\nCurrent Metal is : ")(princ Masstype) 
 (command "textscr") 
 (initget 7 "SE C N D E U P B UC NA CU M W H MM S MC CC A")
 (setq    mp1 (getdist "\nENTER WIDTH PLATE, or key for options : "))
 (command "graphscr")
 )