[编程交流] 灰显弹出列表

(defun c:greytest (/)
 (setq ONOFF "0")
(greytestdcl)
 )
       
(defun greytestdcl (/  ReturnValue  GradTypeTile)
(defun CheckOnClose (/ )
(cond
((not(setq GradTypeTile (get_tile "GradType")))
(mode_tile "GradType" 2)
)
  (T
(setq
    XFallLhs     (nth (read (get_tile "XFallLhs"  ))XFallLhsList)
    XFallRhs     (nth (read (get_tile "XFallRhs"  ))XFallRhsList)
    XFall        (nth (read (get_tile "XFall"      ))XFallList)
 );setq
 (done_dialog 1)
);T
);cond
);defun CheckOnClose
(if (> (setq DLGID (load_dialog "greytest.dcl")) 0)
(progn
(new_dialog "greytest" DLGID)
(setq XFallLhsList '( "0.5" "1.0" "1.5" "2.0" "2.5" "3.0" "3.5" "4.0" ))
(start_list "XFallLhs")
(mapcar 'add_list   XFallLhsList)
(end_list)
(if (member XFallLhs XFallLhsList)
(set_tile "XFallLhs" (rtos (vl-position XFallLhs XFallLhsList) 2 0))
(set_tile "XFallLhs" "3")
);if
(setq XFallRhsList '( "0.5" "1.0" "1.5" "2.0" "2.5" "3.0" "3.5" "4.0" ))
(start_list "XFallRhs")
(mapcar 'add_list   XFallrhsList)
(end_list)
(if (member XFallRhs XFallRhsList)
(set_tile "XFallRhs" (rtos (vl-position XFallRhs XFallRhsList) 2 0))
(set_tile "XFallRhs" "3")
);if
(setq XFallList '( "0.5" "1.0" "1.5" "2.0" "2.5" "3.0" "3.5" "4.0" ))
(start_list "XFall")
(mapcar 'add_list   XFallList)
(end_list)
(if (member XFall XFallList)
(set_tile "XFall" (rtos (vl-position XFall XFallList) 2 0))
(set_tile "XFall" "3")
);if
(action_tile "XFallLhs" "(ErrorDLG 0)")
(action_tile "XFallRhs" "(ErrorDLG 0)")
(action_tile "XFall" "(ErrorDLG 0)")
 (action_tile "onoff" "(setq onoff $value)(onf)")
 (action_tile "accept" "(CheckOnClose)")
 (action_tile "cancel" "(exit)")
 (if (= ONOFF "1")
 (set_tile "onoff" "1") 
 );if
 (ONF)
 
(setq ReturnValue(start_dialog))
(unload_dialog DLGID)
);progn
(not (princ "\nNo DCL"))
);if
ReturnValue
);defun 
(defun ONF ()
(if (= ONOFF "1")
(progn
(mode_tile "XFall" 0) 
);progn
(progn
(mode_tile "XFall" 1) 
);progn
);if
);defun
(defun ErrorDLG (pErr)
(cond
((= pErr 0) (set_tile "error" ""))
);cond
);defun
dcl_settings : default_dcl_settings { audit_level = 3 ; }
greytest : dialog {
  label = "Grey test" ;
  spacer_1;
  :boxed_radio_column  {
  fixed_width = true ;
  label =  "Road Gradient Type"  ;
  key = "GradType";
  :radio_button {
  label =  "Cross Fall                                                                " ;
  key = "CrossFall" ;
  }
  :radio_button {
  label =  "Camber";
  key = "Camber" ;
  }
  }//End radio row
:boxed_column {
   width = 1 ;
  :popup_list {  
  label = "Camber % Left                                             ";
  key = "XFallLhs" ;
  }//popup list
  width = 1 ;
  :popup_list {
  label = "Camber % Right                                          ";
  key = "XFallRhs" ;
  }//popup list
  width = 1 ;
  :popup_list {
  label = "Crossfall %                                                  ";
  key = "XFall" ;
  }//popup list
  
width = 1 ;
 spacer_1 ;
    }//boxed column
 
  errtile ;
  ok_cancel ;
  }//dialog

(defun c:greytest (/)
 (setq ONOFF "0")
(greytestdcl)
 )
(defun greytestdcl (/  ReturnValue  GradTypeTile)
(defun CheckOnClose (/ )
(cond
((not(setq GradTypeTile (get_tile "GradType")))
(mode_tile "GradType" 2)
)
  (T
(setq
    XFallLhs     (nth (read (get_tile "XFallLhs"  ))XFallLhsList)
    XFallRhs     (nth (read (get_tile "XFallRhs"  ))XFallRhsList)
    XFall        (nth (read (get_tile "XFall"      ))XFallList)
 );setq
 (done_dialog 1)
);T
);cond
);defun CheckOnClose
(if (> (setq DLGID (load_dialog "greytest.dcl")) 0)
(progn
(new_dialog "greytest" DLGID)
(setq XFallLhsList '( "0.5" "1.0" "1.5" "2.0" "2.5" "3.0" "3.5" "4.0" ))
(start_list "XFallLhs")
(mapcar 'add_list   XFallLhsList)
(end_list)
(if (member XFallLhs XFallLhsList)
(set_tile "XFallLhs" (rtos (vl-position XFallLhs XFallLhsList) 2 0))
(set_tile "XFallLhs" "3")
);if
(setq XFallRhsList '( "0.5" "1.0" "1.5" "2.0" "2.5" "3.0" "3.5" "4.0" ))
(start_list "XFallRhs")
(mapcar 'add_list   XFallrhsList)
(end_list)
(if (member XFallRhs XFallRhsList)
(set_tile "XFallRhs" (rtos (vl-position XFallRhs XFallRhsList) 2 0))
(set_tile "XFallRhs" "3")
);if
(setq XFallList '( "0.5" "1.0" "1.5" "2.0" "2.5" "3.0" "3.5" "4.0" ))
(start_list "XFall")
(mapcar 'add_list   XFallList)
(end_list)
(if (member XFall XFallList)
(set_tile "XFall" (rtos (vl-position XFall XFallList) 2 0))
(set_tile "XFall" "3")
);if
[color=blue](mode_tile "XFallLhs" 1)[/color]
[color=blue](mode_tile "XFallRhs" 1)[/color]
[color=blue](mode_tile "XFall" 1)[/color]
[color=blue](action_tile "CrossFall" "(Modetest)")[/color]
[color=blue](action_tile "Camber"  "(Modetest)")[/color]
(action_tile "XFallLhs" "(ErrorDLG 0)")
(action_tile "XFallRhs" "(ErrorDLG 0)")
(action_tile "XFall" "(ErrorDLG 0)")
 (action_tile "onoff" "(setq onoff $value)(onf)")
 (action_tile "accept" "(CheckOnClose)")
 (action_tile "cancel" "(exit)")
 (if (= ONOFF "1")
 (set_tile "onoff" "1") 
 );if
 (ONF)
(setq ReturnValue(start_dialog))
(unload_dialog DLGID)
);progn
(not (princ "\nNo DCL"))
);if
ReturnValue
);defun 
(defun ONF ()
(if (= ONOFF "1")
(progn
(mode_tile "XFall" 0) 
);progn
(progn
(mode_tile "XFall" 1) 
);progn
);if
);defun
(defun ErrorDLG (pErr)
(cond
((= pErr 0) (set_tile "error" ""))
);cond
);defun
[color=blue](defun ModeTest ()[/color]
[color=blue] (if (eq  (get_tile "CrossFall") "1")[/color]
[color=blue]    (progn (mode_tile "XFallLhs" 1)[/color]
[color=blue]            (mode_tile "XFallRhs" 1)[/color]
[color=blue]        (mode_tile "XFall" 0))[/color]
[color=blue]    (progn (mode_tile "XFallLhs" 0)[/color]
[color=blue]            (mode_tile "XFallRhs" 0)[/color]
[color=blue]        (mode_tile "XFall" 1))[/color]
[color=blue]   )[/color]
[color=blue])[/color]

(set_tile  "1")