（20230209不终更强迫症）-增删行滑杆/翻页版dcl模拟表格编辑
本帖最后由 wzg356 于 2023-2-10 13:12 编辑20230209更滑杆增删行版比较适用，适当改进，数据检查现场纠错，实战案例http://bbs.mjtd.com/thread-187098-1-1.html
升级更新，dcl模拟表格编辑3个版本，滑杆增删行/翻页版源码收币下载下载程序中有使用例子返回表，表格式及与原表相同，区分整数、实数的数据类型
我无实际应用，想起抽空写的，有回复提出解决翻页/滑杆/增删行功能，故升级。
在我看来，简约版最强，程序越是精细，就越会失去通用性、越会弱化其改造的想象空间。
另外，翻页/滑杆版的"行号列"用的是image，如用edit-box不能调整列宽，不知原因，有高手能解决吗？
==================================
滑杆/增删行版20220316更新 增加删除/插入行
下载文件已更新为“dcl模拟表格编辑滑杆增删行版.lsp”
删/增行:双/单击±-击行号
调用格式：(dcltableb 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_dialogfile)))
(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;返回原表
)
)
修正代码中的DCL对话框错误 是不是CAD 版本的问题。
有两行的引号前少了\
(write-line "test:dialog {label = \"XX表\"; " f)
"(alert \"输入非法！\")" 本帖最后由 vitalgg 于 2022-3-13 23:21 编辑
http://atlisp.cn/static/videos/ui-table-ed.mp4
(require 'ui:*)(setq ui:*table-numbers-per-page* 15)
(setq ui:*table-widths* '(10 20 5 3 30))
(ui:table
(cons '("a""b""C""D""E")
(progn
(setq lst '())(setq i% 0)
(reverse
(repeat 1006
(setq lst
(cons
(list (strcat "A" (itoa (setq i% (1+ i%))))
(strcat "B" (itoa i%))
(strcat "C" (itoa i%))
(strcat "D" (itoa i%))
(strcat "E" (itoa i%)))
lst)))))))
(ui:table '(("姓名" "性别" "年龄" "身高")("张三" "男" 18 180)("李四" "女" 18 170)("王五" "男" 18 180)))
本帖最后由 xj6019 于 2022-3-10 07:46 编辑
就是为了更直观的编辑吗，确定后还是返回列表吧，什么场景需要这样的操作呀
没玩起来！！
很不做一直想找这样的形式表格，直观，操作方便
以前也想过，但不知道怎么解决超出行数后下拉翻页的问题 指令: AP
APPLOAD TTT.LSP成功载入。
指令: TTT
引数太多
谢谢! wzg356 分享程序!
谢谢! 菜卷鱼 依照你的指点AUTOCAD2012测试O.K.
本帖最后由 wzg356 于 2022-3-10 20:51 编辑
菜卷鱼 发表于 2022-3-10 08:59
是不是CAD 版本的问题。
有两行的引号前少了\
(write-line "test:dialog {label = \"XX表\"; " f) ...
我操作不当，阅览有误，编辑页面看到的正常。改为纯文本发帖正常了 xj6019 发表于 2022-3-10 07:30
就是为了更直观的编辑吗，确定后还是返回列表吧，什么场景需要这样的操作呀
没玩起来！！
主要用于交换参数输入，比如母表为默认参数，用dcl交互输入