列表数据引导用户点击

dcl1214 · 发表于 2024-4-25 13:07:53

本帖最后由 dcl1214 于 2024-4-25 15:18 编辑

(defun delsame (lst / s-car new)
;删除表中重复项，删除重复
(setq lst (vl-remove nil lst))
(while (setq s-car (car lst))
(if (vl-position s-car new)
()
(set 'new (cons s-car new))
)
(setq lst (cdr lst))
)
(setq new (reverse new))
new
)
(defun list>Split (lst len / g i gs)
;分段，点表拆分，拆分表，按照指定长度拆分表，按长度拆分表，表拆分，表分段，列表分割，列表分组，分段拆分表(另一个函数叫做sn:splitlst)（本函数是2018年0806日写的）,点表分割,按个数分割
;切分表lst成若干段长度为len的子表，子表的个数
(if (and len
(= (type len) 'int)
(> len 0)
lst
(= (type lst) 'list)
)
(if (= len 1)
(setq gs (mapcar 'list lst))
(progn
(while lst
(setq g nil)
(setq i 1)
(while (and lst (<= i len))
(setq cars (car lst))
(setq g (cons cars g))
(setq lst (cdr lst))
(setq i (1+ i))
)
(setq g (reverse g))
(setq gs (cons g gs))
)
(setq gs (reverse gs))
)
)
)
gs
)
(defun wire:list-fill-with-title (dot-pare-list keys
/ gen-row-string
content colum-widths
row-string
)
;;;将点表对变成有标题的listbox填充，列表填充，填充列表，\t方式填充列表，填充listbox
;;; :: dot-pare-list 数据源点表对
;;; :: keys 表头，如果没有表头则所有点表对的表头
;;; :: 返回排成行了的结果,第一行为表头
(defun gen-row-string (str-list width-list /)
;将字串按各列宽度串在一起
(apply 'strcat
(mapcar '(lambda (a b)
(if (not a)
(setq a "")
)
(if (not (= (type a) 'str))
(setq a (vl-princ-to-string a))
)
(setq a (strcat "|" a))
(while (< (strlen a) b)
(setq a (strcat a " "))
)
a
)
str-list
width-list
)
)
)
(if (and dot-pare-list
keys
(= (type dot-pare-list) 'list)
(= (type (car dot-pare-list)) 'list)
(= (type (caar dot-pare-list)) 'list)
(= (type (caaar dot-pare-list)) 'str)
(= (type keys) 'list)
(= (type (car keys)) 'str)
)
(progn
(if (not keys)
(setq keys
(DELSAME
(apply 'append
(mapcar '(lambda (a) (mapcar 'car a)) dot-pare-list)
)
)
)
)
(setq
content (mapcar
'(lambda (a)
(if (member 'nil a)
(print "wire:list-fill-with-title 遇到nil值")
)
(mapcar '(lambda (b)
(if (cdr (assoc b a))
(cdr (assoc b a))
""
)
)
keys
)
)
dot-pare-list
)
)
;;;计算列宽
(setq colum-widths
(mapcar
'(lambda (a)
(apply
'max
(mapcar
(function
(lambda (b)
(if (and b (= (type b) 'list) (= (length b) 1))
(setq b (car b))
(setq b (vl-princ-to-string b))
)
(strlen b)
)
)
a
)
)
)
(apply 'mapcar (cons 'list (cons keys content)))
)
)
(setq colum-widths
(mapcar '1+
(mapcar '(lambda (a)
(if (< a 3)
3
a
)
)
colum-widths
)
)
)
(setq row-string
(mapcar (function (lambda (a / str)
(setq str (gen-row-string a colum-widths))
(setq str (vl-string-left-trim "|" str))
)
)
(cons keys content)
)
)
)
)
row-string
)
(defun AddList (key lst)
;对话框控件填充
(IF (AND key lst)
(PROGN
(if (= (type lst) 'str)
(setq lst (list lst))
)
(start_list key)
(foreach x lst (AND X (= (type x) 'str) (add_list x)))
(end_list)
)
(PROGN
(start_list key)
(end_list)
)
)
lst
)
(defun $xuan-ze$ (label data f-c lst / $d$
$xuan-ze-xq$ _xz_dcl agxh-db d dclid
jz old_time si sql startNum tbn-agk
zds
)
;label 顶部提示语
;data 点表格式的数据，不是矩阵数据
;f-c 第一列的列名
;lst 预留参数
;|
;示例
($xuan-ze$ "请选择mo_xing_ming_cheng"
'((("id" . "3")
("an_gui_hao" . "HL-061-1")
("zhuan_yong_ke_hu" . "")
("guo_bie" . "0")
("guo_bie_biao_zhi" . "BSMI")
("zhen_jiao_shu" . "3")
("zhi_wan" . "直")
("e_ding_dian_liu" . "9A")
("e_ding_dian_ya" . "125V")
("zheng_shu_bian_hao" . "CI362060510465")
("ren_zheng_fan_wei_yan_se" . "")
("mo_xing_ming_cheng" . "台规三插")
("bei_zhu" . "")
)
(("id" . "7")
("an_gui_hao" . "HL-061-2")
("zhuan_yong_ke_hu" . "")
("guo_bie" . "33")
("guo_bie_biao_zhi" . "BSMI")
("zhen_jiao_shu" . "3")
("zhi_wan" . "3")
("e_ding_dian_liu" . "10A")
("e_ding_dian_ya" . "125V")
("zheng_shu_bian_hao" . "CI362060510465")
("ren_zheng_fan_wei_yan_se" . "")
("mo_xing_ming_cheng" . "台规三插")
("bei_zhu" . "")
)
(("id" . "8")
("an_gui_hao" . "HL-028")
("zhuan_yong_ke_hu" . "")
("guo_bie" . "巴西")
("guo_bie_biao_zhi" . "UC")
("zhen_jiao_shu" . "2")
("zhi_wan" . "直")
("e_ding_dian_liu" . "2.5A")
("e_ding_dian_ya" . "250V")
("zheng_shu_bian_hao" . "TüV 23.1140")
("ren_zheng_fan_wei_yan_se" . "")
("mo_xing_ming_cheng" . "8字尾")
("bei_zhu" . "")
)
(("id" . "9")
("an_gui_hao" . "HL-028")
("zhuan_yong_ke_hu" . "")
("guo_bie" . "巴西")
("guo_bie_biao_zhi" . "UC")
("zhen_jiao_shu" . "2")
("zhi_wan" . "直")
("e_ding_dian_liu" . "7A")
("e_ding_dian_ya" . "125V")
("zheng_shu_bian_hao" . "TüV 23.1140")
("ren_zheng_fan_wei_yan_se" . "")
("mo_xing_ming_cheng" . "8字尾")
("bei_zhu" . "")
)
(("id" . "10")
("an_gui_hao" . "HL-061-3")
("zhuan_yong_ke_hu" . "")
("guo_bie" . "台湾")
("guo_bie_biao_zhi" . "BSMI")
("zhen_jiao_shu" . "3")
("zhi_wan" . "直")
("e_ding_dian_liu" . "11A")
("e_ding_dian_ya" . "125V")
("zheng_shu_bian_hao" . "CI362060510465")
("ren_zheng_fan_wei_yan_se" . "")
("mo_xing_ming_cheng" . "台规三插")
("bei_zhu" . "")
)
)
"mo_xing_ming_cheng"
nil
)
|;
(defun _xz_dcl (lst / f p lst dcl-n file)
(setq dcl-n "_xz_dcl")
(SETQ F (VL-FILENAME-DIRECTORY (VL-FILENAME-MKTEMP)))
(SETQ P (STRCAT F "\\" DCL-N))
(if (findfile p)
(VL-FILE-DELETE P)
)
(or (and (setq w (cdr (assoc "width" lst)))
(= (type w) 'str)
(= (type (read w)) 'int)
)
(setq w "100")
)
(setq lst (list
"head:list_box {"
" is_enabled = false ;"
" fixed_height = true ;"
" height = 2 ;"
" vertical_margin = none ;"
" horizontal_margin = none ;"
"}"
""
"xz:dialog {"
" key = \"xz\" ;"
" :paragraph {"
" :head {"
" key = \"h\" ;"
" }"
" :list_box {"
" height = 18 ;"
" key = \"d\" ;"
(strcat " width = " w " ;")
" vertical_margin = none ;"
" horizontal_margin = none ;"
" }"
" }"
" :button {"
" height = 3 ;"
" is_cancel = true ;"
" key = \"tc\" ;"
" label = \"< < < 返回上一级\" ;"
" }"
"}"
)
)
(setq p nil)
(setq p (STRCAT f "\\xz.dcl"))
(if (setq file (open p "w"))
(progn
(foreach line lst
(write-line line file)
)
(close file)
)
)
(if (findfile p)
p
nil
)
)
(defun $xuan-ze-xq$
(data / _xiangqing_dcl dcl_id
dqy i keys s sjs
startnum str str-l
)
(defun _xiangqing_dcl (texts / tmp_folder tmp_file tmp_lst)
(defun $rows$ (texts)
(mapcar
(function
(lambda (a / s)
(setq
s
(mapcar
(function
(lambda (b)
(list
" :text {"
" fixed_width = true ;"
(strcat " label = \""
(car b)
"\" ;"
)
" width = 30 ;"
" vertical_margin = none ;"
" horizontal_margin = none ;"
" }"
" :text {"
(strcat " label = \""
(cdr b)
"\" ;"
)
" width = 60 ;"
" vertical_margin = none ;"
" horizontal_margin = none ;"
" }"
)
)
)
a
)
)
(setq s (apply 'append s))
(setq s
(cons " :concatenation { fixed_width = true ;"
s
)
)
(setq
s
(append
s
(list
" vertical_margin = none ; horizontal_margin = none ; }"
)
)
)
)
)
texts
)
)
(setq tmp_folder (strcat (vl-filename-directory (vl-filename-mktemp))
"\\"
)
tmp_file (strcat
tmp_folder
"xiangqing.dcl"
)
)
(if
(findfile tmp_file)
(vl-file-delete tmp_file)
)
(setq texts (vl-remove-if-not
(function (lambda (a) (= (type (cdr a)) 'str)))
texts
)
)
(if (> (length texts) 70)
(setq texts (list>Split texts 2))
(setq texts (mapcar 'list texts))
)
(setq tmp_lst
(append
(list (LIST "xq:dialog {"))
(list (list " label = \"详情预览\" ;"))
($rows$ texts)
(list (LIST " ok_only;"))
(list
(list
" vertical_margin = none ;"
)
)
(list (LIST "}"))
)
)
(setq tmp_lst (apply 'append tmp_lst))
(if (setq file (open tmp_file "w"))
(progn
(cond ((= (type tmp_lst) 'STR)
(write-line tmp_lst file)
)
((= (type tmp_lst) 'LIST)
(foreach line tmp_lst
(write-line line file)
)
)
)
(close file)
)
(setq tmp_file nil)
)
;(_sensor:lst->dat tmp_file tmp_lst T NIL)
tmp_file
)
(setq s DATA)
(setq dcl_id (load_dialog (_xiangqing_dcl s)))
(new_dialog "xq" dcl_id)
(start_dialog)
(unload_dialog dcl_id)
)
(defun $d$ (data old_time / new_time pass_time pick si)
(setq new_time (read (substr (rtos (getvar "date") 2 15) 9 6)))
(setq pass_time (- new_time old_time))
(setq pick (get_tile "d"))
(setq pick (atoi pick))
(setq si (nth pick data))
(if (<= pass_time 4)
($xuan-ze-xq$ si)
)
(list pick new_time)
)
(IF (NOT old_time)
(SETq
old_time (- (read (substr (rtos (getvar "date") 2 15) 9 6)) 4)
)
)
(setq zds (delsame (mapcar 'car (apply 'append data))))
(if f-c
(setq zds (cons f-c (vl-remove f-c zds)))
) ;第一列强制
(setq d nil)
(setq jz (wire:list-fill-with-title data zds))
(setq dclid (load_dialog (_xz_dcl lst)))
(new_dialog "xz" dclid "" (list -1 -1))
(and label (set_tile "xz" label))
(addlist "d" (cdr jz))
(addlist "h" (list (car jz)))
(action_tile "tc" "(setq pick(get_tile \"d\"))")
(action_tile
"d"
"(mapcar 'set(list 'd 'old_time)($d$ data old_time))"
)
(setq startNum (start_dialog))
(COND ((= STARTNUM 0) (princ)))
(unload_dialog dclid)
(if (and pick data)
(setq si (nth (atoi pick) data))
)
si ;返回给上一级
)

(defun delsame (lst / s-car new) 
                                        ;删除表中重复项，删除重复 
  (setq lst (vl-remove nil lst)) 
  (while (setq s-car (car lst)) 
    (if        (vl-position s-car new) 
      () 
      (set 'new (cons s-car new)) 
    ) 
    (setq lst (cdr lst)) 
  ) 
  (setq new (reverse new)) 
  new 
) 
(defun list>Split (lst len / g i gs) 
                                        ;分段，点表拆分，拆分表，按照指定长度拆分表，按长度拆分表，表拆分，表分段，列表分割，列表分组，分段拆分表(另一个函数叫做sn:splitlst)（本函数是2018年0806日写的）,点表分割,按个数分割 
                                        ;切分表lst成若干段长度为len的子表，子表的个数 
  (if (and len 
           (= (type len) 'int) 
           (> len 0) 
           lst 
           (= (type lst) 'list) 
      ) 
    (if        (= len 1) 
      (setq gs (mapcar 'list lst)) 
      (progn 
        (while lst 
          (setq g nil) 
          (setq i 1) 
          (while (and lst (<= i len)) 
            (setq cars (car lst)) 
            (setq g (cons cars g)) 
            (setq lst (cdr lst)) 
            (setq i (1+ i)) 
          ) 
          (setq g (reverse g)) 
          (setq gs (cons g gs)) 
        ) 
        (setq gs (reverse gs)) 
      ) 
    ) 
  ) 
  gs 
) 
(defun wire:list-fill-with-title (dot-pare-list         keys 
                                  /                 gen-row-string 
                                  content         colum-widths 
                                  row-string 
                                 ) 
;;;将点表对变成有标题的listbox填充，列表填充，填充列表，\t方式填充列表，填充listbox 
;;;                :: dot-pare-list 数据源点表对 
;;;                :: keys 表头，如果没有表头则所有点表对的表头 
;;;                :: 返回排成行了的结果,第一行为表头 
  (defun gen-row-string        (str-list width-list /) 
                                        ;将字串按各列宽度串在一起 
    (apply 'strcat 
           (mapcar '(lambda (a b) 
                      (if (not a) 
                        (setq a "") 
                      ) 
                      (if (not (= (type a) 'str)) 
                        (setq a (vl-princ-to-string a)) 
                      ) 
                      (setq a (strcat "|" a)) 
                      (while (< (strlen a) b) 
                        (setq a (strcat a " ")) 
                      ) 
                      a 
                    ) 
                   str-list 
                   width-list 
           ) 
    ) 
  ) 
  (if (and dot-pare-list 
           keys 
           (= (type dot-pare-list) 'list) 
           (= (type (car dot-pare-list)) 'list) 
           (= (type (caar dot-pare-list)) 'list) 
           (= (type (caaar dot-pare-list)) 'str) 
           (= (type keys) 'list) 
           (= (type (car keys)) 'str) 
      ) 
    (progn 
      (if (not keys) 
        (setq keys 
               (DELSAME 
                 (apply        'append 
                        (mapcar '(lambda (a) (mapcar 'car a)) dot-pare-list) 
                 ) 
               ) 
        ) 
      ) 
      (setq 
        content        (mapcar 
                  '(lambda (a) 
                     (if (member 'nil a) 
                       (print "wire:list-fill-with-title 遇到nil值") 
                     ) 
                     (mapcar '(lambda (b) 
                                (if (cdr (assoc b a)) 
                                  (cdr (assoc b a)) 
                                  "" 
                                ) 
                              ) 
                             keys 
                     ) 
                   ) 
                  dot-pare-list 
                ) 
      ) 
;;;计算列宽 
      (setq colum-widths 
             (mapcar 
               '(lambda        (a) 
                  (apply 
                    'max 
                    (mapcar 
                      (function 
                        (lambda        (b) 
                          (if (and b (= (type b) 'list) (= (length b) 1)) 
                            (setq b (car b)) 
                            (setq b (vl-princ-to-string b)) 
                          ) 
                          (strlen b) 
                        ) 
                      ) 
                      a 
                    ) 
                  ) 
                ) 
               (apply 'mapcar (cons 'list (cons keys content))) 
             ) 
      ) 
      (setq colum-widths 
             (mapcar '1+ 
                     (mapcar '(lambda (a) 
                                (if (< a 3) 
                                  3 
                                  a 
                                ) 
                              ) 
                             colum-widths 
                     ) 
             ) 
      ) 
      (setq row-string 
             (mapcar (function (lambda (a / str) 
                                 (setq str (gen-row-string a colum-widths)) 
                                 (setq str (vl-string-left-trim "|" str)) 
                               ) 
                     ) 
                     (cons keys content) 
             ) 
      ) 
    ) 
  ) 
  row-string 
) 
 
(defun AddList (key lst) 
                                        ;对话框控件填充 
  (IF (AND key lst) 
    (PROGN 
      (if (= (type lst) 'str) 
        (setq lst (list lst)) 
      ) 
      (start_list key) 
      (foreach x lst (AND X (= (type x) 'str) (add_list x))) 
      (end_list) 
    ) 
    (PROGN 
      (start_list key) 
      (end_list) 
    ) 
  ) 
  lst 
) 
 
(defun $xuan-ze$ (label     data      f-c       lst      /         $d$ 
      $xuan-ze-xq$      _xz_dcl  agxh-db  d         dclid 
      jz     old_time si       sql      startNum tbn-agk 
      zds 
     ) 
          ;label 顶部提示语 
          ;data 点表格式的数据，不是矩阵数据 
          ;f-c 第一列的列名 
          ;lst 预留参数 
     ;| 
;示例 
($xuan-ze$ "请选择mo_xing_ming_cheng" 
     '((("id" . "3") 
        ("an_gui_hao" . "HL-061-1") 
        ("zhuan_yong_ke_hu" . "") 
        ("guo_bie" . "0") 
        ("guo_bie_biao_zhi" . "BSMI") 
        ("zhen_jiao_shu" . "3") 
        ("zhi_wan" . "直") 
        ("e_ding_dian_liu" . "9A") 
        ("e_ding_dian_ya" . "125V") 
        ("zheng_shu_bian_hao" . "CI362060510465") 
        ("ren_zheng_fan_wei_yan_se" . "") 
        ("mo_xing_ming_cheng" . "台规三插") 
        ("bei_zhu" . "") 
       ) 
       (("id" . "7") 
        ("an_gui_hao" . "HL-061-2") 
        ("zhuan_yong_ke_hu" . "") 
        ("guo_bie" . "33") 
        ("guo_bie_biao_zhi" . "BSMI") 
        ("zhen_jiao_shu" . "3") 
        ("zhi_wan" . "3") 
        ("e_ding_dian_liu" . "10A") 
        ("e_ding_dian_ya" . "125V") 
        ("zheng_shu_bian_hao" . "CI362060510465") 
        ("ren_zheng_fan_wei_yan_se" . "") 
        ("mo_xing_ming_cheng" . "台规三插") 
        ("bei_zhu" . "") 
       ) 
       (("id" . "8") 
        ("an_gui_hao" . "HL-028") 
        ("zhuan_yong_ke_hu" . "") 
        ("guo_bie" . "巴西") 
        ("guo_bie_biao_zhi" . "UC") 
        ("zhen_jiao_shu" . "2") 
        ("zhi_wan" . "直") 
        ("e_ding_dian_liu" . "2.5A") 
        ("e_ding_dian_ya" . "250V") 
        ("zheng_shu_bian_hao" . "TüV 23.1140") 
        ("ren_zheng_fan_wei_yan_se" . "") 
        ("mo_xing_ming_cheng" . "8字尾") 
        ("bei_zhu" . "") 
       ) 
       (("id" . "9") 
        ("an_gui_hao" . "HL-028") 
        ("zhuan_yong_ke_hu" . "") 
        ("guo_bie" . "巴西") 
        ("guo_bie_biao_zhi" . "UC") 
        ("zhen_jiao_shu" . "2") 
        ("zhi_wan" . "直") 
        ("e_ding_dian_liu" . "7A") 
        ("e_ding_dian_ya" . "125V") 
        ("zheng_shu_bian_hao" . "TüV 23.1140") 
        ("ren_zheng_fan_wei_yan_se" . "") 
        ("mo_xing_ming_cheng" . "8字尾") 
        ("bei_zhu" . "") 
       ) 
       (("id" . "10") 
        ("an_gui_hao" . "HL-061-3") 
        ("zhuan_yong_ke_hu" . "") 
        ("guo_bie" . "台湾") 
        ("guo_bie_biao_zhi" . "BSMI") 
        ("zhen_jiao_shu" . "3") 
        ("zhi_wan" . "直") 
        ("e_ding_dian_liu" . "11A") 
        ("e_ding_dian_ya" . "125V") 
        ("zheng_shu_bian_hao" . "CI362060510465") 
        ("ren_zheng_fan_wei_yan_se" . "") 
        ("mo_xing_ming_cheng" . "台规三插") 
        ("bei_zhu" . "") 
       ) 
      ) 
     "mo_xing_ming_cheng" 
     nil 
) 
  |; 
  (defun _xz_dcl (lst / f p lst dcl-n file) 
    (setq dcl-n "_xz_dcl") 
    (SETQ F (VL-FILENAME-DIRECTORY (VL-FILENAME-MKTEMP))) 
    (SETQ P (STRCAT F "\\" DCL-N)) 
    (if  (findfile p) 
      (VL-FILE-DELETE P) 
    ) 
    (or  (and (setq w (cdr (assoc "width" lst))) 
       (= (type w) 'str) 
       (= (type (read w)) 'int) 
  ) 
  (setq w "100") 
    ) 
    (setq lst (list 
    "head:list_box {" 
    "    is_enabled = false ;" 
    "    fixed_height = true ;" 
    "    height = 2 ;" 
    "    vertical_margin = none ;" 
    "    horizontal_margin = none ;" 
    "}" 
    "" 
    "xz:dialog {" 
    "            key = \"xz\" ;" 
    "    :paragraph {" 
    "        :head {" 
    "            key = \"h\" ;" 
    "        }" 
    "        :list_box {" 
    "            height = 18 ;" 
    "            key = \"d\" ;" 
    (strcat "            width = " w " ;") 
    "            vertical_margin = none ;" 
    "            horizontal_margin = none ;" 
    "        }" 
    "    }" 
    "    :button {" 
    "        height = 3 ;" 
    "        is_cancel = true ;" 
    "        key = \"tc\" ;" 
    "        label = \"< < < 返回上一级\" ;" 
    "    }" 
    "}" 
        ) 
    ) 
    (setq p nil) 
    (setq p (STRCAT f "\\xz.dcl")) 
    (if  (setq file (open p "w")) 
      (progn 
  (foreach line lst 
    (write-line line file) 
  ) 
  (close file) 
      ) 
    ) 
    (if  (findfile p) 
      p 
      nil 
    ) 
  ) 
  (defun $xuan-ze-xq$ 
          (data  /   _xiangqing_dcl     dcl_id 
           dqy  i   keys    s     sjs 
           startnum  str   str-l 
          ) 
    (defun _xiangqing_dcl (texts / tmp_folder tmp_file tmp_lst) 
      (defun $rows$ (texts) 
  (mapcar 
    (function 
      (lambda (a / s) 
        (setq 
    s 
     (mapcar 
       (function 
         (lambda (b) 
           (list 
       "        :text {" 
       "            fixed_width = true ;" 
       (strcat "            label = \"" 
         (car b) 
         "\" ;" 
       ) 
       "            width = 30 ;" 
       "            vertical_margin = none ;" 
       "            horizontal_margin = none ;" 
       "        }" 
       "        :text {" 
       (strcat "            label = \"" 
         (cdr b) 
         "\" ;" 
       ) 
       "            width = 60 ;" 
       "            vertical_margin = none ;" 
       "            horizontal_margin = none ;" 
       "        }" 
           ) 
         ) 
       ) 
       a 
     ) 
        ) 
        (setq s (apply 'append s)) 
        (setq s 
         (cons "    :concatenation {       fixed_width = true ;" 
         s 
         ) 
        ) 
        (setq 
    s 
     (append 
       s 
       (list 
         "                        vertical_margin = none ;                        horizontal_margin = none ;    }" 
       ) 
     ) 
        ) 
      ) 
    ) 
    texts 
  ) 
      ) 
      (setq tmp_folder (strcat (vl-filename-directory (vl-filename-mktemp)) 
             "\\" 
           ) 
      tmp_file   (strcat 
       tmp_folder 
       "xiangqing.dcl" 
           ) 
      ) 
      (if 
  (findfile tmp_file) 
   (vl-file-delete tmp_file) 
      ) 
      (setq texts (vl-remove-if-not 
        (function (lambda (a) (= (type (cdr a)) 'str))) 
        texts 
      ) 
      ) 
      (if (> (length texts) 70) 
  (setq texts (list>Split texts 2)) 
  (setq texts (mapcar 'list texts)) 
      ) 
      (setq tmp_lst 
       (append 
         (list (LIST "xq:dialog {")) 
         (list (list "            label = \"详情预览\" ;")) 
         ($rows$ texts) 
         (list (LIST "    ok_only;")) 
         (list 
     (list 
       "                        vertical_margin = none ;" 
     ) 
         ) 
         (list (LIST "}")) 
       ) 
      ) 
      (setq tmp_lst (apply 'append tmp_lst)) 
      (if (setq file (open tmp_file "w")) 
  (progn 
    (cond  ((= (type tmp_lst) 'STR) 
     (write-line tmp_lst file) 
    ) 
    ((= (type tmp_lst) 'LIST) 
     (foreach line tmp_lst 
       (write-line line file) 
     ) 
    ) 
    ) 
    (close file) 
  ) 
  (setq tmp_file nil) 
      ) 
          ;(_sensor:lst->dat tmp_file tmp_lst T NIL) 
      tmp_file 
    ) 
    (setq s DATA) 
    (setq dcl_id (load_dialog (_xiangqing_dcl s))) 
    (new_dialog "xq" dcl_id) 
    (start_dialog) 
    (unload_dialog dcl_id) 
  ) 
  (defun $d$ (data old_time / new_time pass_time pick si) 
    (setq new_time (read (substr (rtos (getvar "date") 2 15) 9 6))) 
    (setq pass_time (- new_time old_time)) 
    (setq pick (get_tile "d")) 
    (setq pick (atoi pick)) 
    (setq si (nth pick data)) 
    (if  (<= pass_time 4) 
      ($xuan-ze-xq$ si) 
    ) 
    (list pick new_time) 
  ) 
  (IF (NOT old_time) 
    (SETq 
      old_time (- (read (substr (rtos (getvar "date") 2 15) 9 6)) 4) 
    ) 
  ) 
  (setq zds (delsame (mapcar 'car (apply 'append data)))) 
  (if f-c 
    (setq zds (cons f-c (vl-remove f-c zds))) 
  )          ;第一列强制 
  (setq d nil) 
  (setq jz (wire:list-fill-with-title data zds)) 
  (setq dclid (load_dialog (_xz_dcl lst))) 
  (new_dialog "xz" dclid "" (list -1 -1)) 
  (and label (set_tile "xz" label)) 
  (addlist "d" (cdr jz)) 
  (addlist "h" (list (car jz))) 
  (action_tile "tc" "(setq pick(get_tile \"d\"))") 
  (action_tile 
    "d" 
    "(mapcar 'set(list 'd 'old_time)($d$ data old_time))" 
  ) 
  (setq startNum (start_dialog)) 
  (COND ((= STARTNUM 0) (princ))) 
  (unload_dialog dclid) 
  (if (and pick data) 
    (setq si (nth (atoi pick) data)) 
  ) 
  si          ;返回给上一级 
)

伊江痕 · 发表于 2024-4-25 13:13:26

来学习了

ssyfeng · 发表于 2024-4-25 14:20:16

缺少函数：delsame，wire:list-fill-with-title，addlist，list>Split

dcl1214 · 发表于 2024-4-25 14:58:52

ssyfeng 发表于 2024-4-25 14:20
缺少函数：delsame，wire:list-fill-with-title，addlist，list>Split

缺少的函数已经补充了

账号		自动登录	找回密码
密码			注册

[经验] 列表数据引导用户点击

评分