（20230209不终更强迫症）-增删行滑杆/翻页版dcl模拟表格编辑

wzg356

20230209更滑杆增删行版比较适用，适当改进，数据检查现场纠错，实战案例http://bbs.mjtd.com/thread-187098-1-1.html


升级更新，dcl模拟表格编辑3个版本，滑杆增删行/翻页版源码收币下载下载程序中有使用例子返回表，表格式及与原表相同，区分整数、实数的数据类型

我无实际应用，想起抽空写的，有回复提出解决翻页/滑杆/增删行功能，故升级。
在我看来，简约版最强，程序越是精细，就越会失去通用性、越会弱化其改造的想象空间。

另外，翻页/滑杆版的"行号列"用的是image，如用edit-box不能调整列宽，不知原因，有高手能解决吗？

==================================
滑杆/增删行版  20220316更新 增加删除/插入行  
下载文件已更新为“dcl模拟表格编辑滑杆增删行版.lsp”

删/增行:双/单击±-击行号

调用格式：(dcltable  b w HGV lst)
;参数b:面板最大行数，小于表长自动增加滑杆
;参数w:列宽
;参数HGV：控制面板显示的滑杆初值，nil则程序自取默认数
;参数lst：（list 子表1 子表2 子表3 子表4.......）
表为等长子表组成的表，单页行数小于表长自动增加滑杆
===============================

翻页版，20220315修改补充，下载文件已更新
调用格式：(dcltable 单页行数 列宽 （list 子表1 子表2 子表3 子表4.......）)

表为等长子表组成的表，单页行数小于表长自动增加翻页功能

==========================
以下是初始贴，无翻页功能的简约版
有同学已完善代码在8楼， 我这儿改为纯文本发帖就正常了
(defun c:ttt nil(dcltable t lst))
;dcl模拟表格编辑
;表最大26列
;参数b:t锁定第一行 nil锁定第一列 类似不可编辑的字段名称 根据表格式选用
;参数lst：如下格式
(setq lst(list
        '("姓名" "性别" "学历" "年龄")
        '("张大"   "男"  "高中" 18)
        '("李幺妹" "女" "博士" 47))
)
;(setq lst(list '("字段1" 33 1.50 55) '("字段2" "B" "C" "D")'("字段3" "aa" "C" "C")))
;返回表，表格式及与原表相同，区分整数、实数的数据类型
(defun dcltable (b lst /  STRlabel gatdata type1 type2 atlst checknum lst_abc
                         file f k kk key keys key0s keyAS lst1 lstN dcl_id dd kk)        
    (defun STRlabel (key w v)            
            (strcat ":edit_box{key="  (vl-prin1-to-string(strcat key))
                    ";width=" (itoa w)
                    ";value=" (if v(vl-prin1-to-string v) (vl-prin1-to-string ""))
                    ";fixed_width=true;vertical_margin=none;horizontal_margin=none ;}"
                )
        )
        (defun gatdata(keys)(mapcar 'get_tile keys))
        (defun type1(v);原表数值类型
                (setq v(type v))
                (cond
                        ((= v 'INT) 'INT)
                        ((= v 'REAL) 'REAL)
                        (T 'STR)
                )
        )
        (defun type2(v / v1);输入框的输入数据类型
                (if        (and(setq v1(type (read v)))
                                (or(not(vl-string-search " " v))(/= 0(vl-string-search " " v)))
                        );容错前面的空格
                        (cond
                                ((= v1 'INT) 'INT)
                                ((= v1 'REAL) 'REAL)
                                (T 'STR)
                        )
                         'STR
                )                        
        )
        ;返回元素出现的所有索引位置
        (defun atlst (at lst / a nlst)
                (setq a 0)
                (mapcar '(lambda(x)(and(eq x at)(setq nlst(cons a nlst)))(setq a(1+ a))) lst)
                (reverse nlst)
        )
        ;检查在lst1中元素数字位置与lst2中相应位置是否是数字字符串        
        ;且lst1中整数在lst2中相应位置也须为整数
        ;符合则把lst2中相应数字字符串转换为数值，否则返回nil
        (defun checknum(lst1 lst2 / lsta lstb)
                (setq lsta(mapcar 'type1 lst1) lstb(mapcar 'type2 lst2))
                (if        (and(not(vl-remove-if '(lambda(x)(= x 'INT))(mapcar '(lambda(x) (nth x lstb))(atlst 'INT lsta))))
                                (not(vl-remove-if '(lambda(x)(or(= x 'INT)(= x 'REAL)))(mapcar '(lambda(x) (nth x lstb))(atlst 'REAL lsta))))
                                (setq lst2(mapcar '(lambda(x y)
                                        (cond
                                                ((= x 'INT)(atoi y))
                                                ((= x 'REAL)(atof y))
                                                (t y)
                                        ))lsta lst2)
                                )
                        )lst2 nil
                )               
        )
        (setq lst_abc '("A" "B" "C" "D" "E" "F" "G" "H" "I" "J" "K" "L" "M" "N" "O" "P" "Q" "R" "S" "T" "U" "V" "W" "X" "Y" "Z"))               
        (setq file (vl-filename-mktemp "DclTemp.dcl"))
    (setq f (open file "w"))
    (write-line "test:dialog {label = \"XX表\"; " f)
    (write-line ":column {" f)
    (setq k(length lst) kk(apply 'max (mapcar 'length lst)) n -1)
    (repeat k            
            (write-line ":row {" f)
            (setq m -1 lst1(nth(setq n(1+ n))lst))
            (repeat kk
                    (setq keys(cons(setq key (strcat (nth(setq m(1+ m)) lst_abc) (itoa n)))keys));所有key
                    (write-line (STRlabel key 10 (nth m lst1)) f)
                    (if (wcmatch key "A*")(setq keyAs(cons key keyAs)));a列key
                    (if (wcmatch key "*0")(setq key0s(cons key key0s)));0行key
                )               
            (write-line ":concatenation{vertical_margin=none;horizontal_margin=none;}}" f)               
    )
    (write-line "}ok_cancel;}" f)               
    (close f)   
    (setq keys(reverse keys))   
    (new_dialog "test" (setq dcl_id (load_dialog  file)))
    (mapcar '(lambda(x)(mode_tile x 1)) (if b key0s keyAs));锁定0行或A列   
    (action_tile "accept" (strcat
            "(if (not(setq kvs(checknum (apply 'append lst) (gatdata keys))))"
            "(alert \"输入非法！\")"
            "(done_dialog 1))")
    )
    (setq dd (start_dialog))
    (unload_dialog dcl_id)
    (vl-file-delete file);删除临时dcl文件
    (setq lst1 nil)
    (if (and(= dd 1)(setq kvs(reverse kvs)))
            (foreach kk(reverse(mapcar 'length lst))
                    (repeat kk(setq lst1(cons(car kvs) lst1) kvs(cdr kvs)))
                    (setq lstN(cons lst1 lstN) lst1 nil)
                    lstN
            );返回新表
            lst;返回原表
        )
)

1028695446

修正代码中的DCL对话框错误

菜卷鱼

是不是CAD 版本的问题。
有两行的引号前少了\
    (write-line "test:dialog {label = \"XX表\"; " f)   

   "(alert \"输入非法！\")"

vitalgg

如果无法播放，请点击此处在新窗口打开

1. (require 'ui:*)(setq ui:*table-numbers-per-page* 15)
   
2. (setq ui:*table-widths* '(10 20 5 3 30))
   
3. (ui:table
   
4. (cons '("a""b""C""D""E")
   
5.        (progn
   
6.          (setq lst '())(setq i% 0)
   
7.          (reverse
   
8.           (repeat 1006
   
9.                   (setq lst
   
10.                         (cons
    
11.                          (list (strcat "A" (itoa (setq i% (1+ i%))))
    
12.                                (strcat "B" (itoa i%))
    
13.                                (strcat "C" (itoa i%))
    
14.                                (strcat "D" (itoa i%))
    
15.                                (strcat "E" (itoa i%)))
    
16.                          lst)))))))
    
17. (ui:table '(("姓名" "性别" "年龄" "身高")("张三" "男" 18 180)("李四" "女" 18 170)("王五" "男" 18 180)))

(require 'ui:*)(setq ui:*table-numbers-per-page* 15)<br /> (setq ui:*table-widths* '(10 20 5 3 30))<br /> (ui:table<br /> (cons '("a""b""C""D""E")<br />        (progn<br />          (setq lst '())(setq i% 0)<br />          (reverse<br />           (repeat 1006<br />                   (setq lst<br />                         (cons <br />                          (list (strcat "A" (itoa (setq i% (1+ i%))))<br />                                (strcat "B" (itoa i%))<br />                                (strcat "C" (itoa i%))<br />                                (strcat "D" (itoa i%))<br />                                (strcat "E" (itoa i%)))<br />                          lst)))))))<br /> (ui:table '(("姓名" "性别" "年龄" "身高")("张三" "男" 18 180)("李四" "女" 18 170)("王五" "男" 18 180)))

xj6019

就是为了更直观的编辑吗，确定后还是返回列表吧，什么场景需要这样的操作呀

没玩起来！！

sniper1111

很不做一直想找这样的形式表格，直观，操作方便

紫苏炒黄瓜

以前也想过，但不知道怎么解决超出行数后下拉翻页的问题

yoyoho

指令: AP
APPLOAD TTT.LSP  成功载入。
指令: TTT
引数太多

yoyoho

谢谢! wzg356 分享程序!
谢谢! 菜卷鱼 依照你的指点AUTOCAD2012测试O.K.

wzg356

菜卷鱼 发表于 2022-3-10 08:59
是不是CAD 版本的问题。
有两行的引号前少了\
    (write-line "test:dialog {label = \"XX表\"; " f)    ...

我操作不当，阅览有误，编辑页面看到的正常。改为纯文本发帖正常了

wzg356

xj6019 发表于 2022-3-10 07:30
就是为了更直观的编辑吗，确定后还是返回列表吧，什么场景需要这样的操作呀

没玩起来！！

主要用于交换参数输入，比如母表为默认参数，用dcl交互输入