社区 › AutoLISP/Visual LISP 编程技术 › 通用的对话框DCL赋值与取值函数

言戲無軍 发表于 2022-3-11 15:50:28

通用的对话框DCL赋值与取值函数

本帖最后由 言戲無軍 于 2022-3-13 10:35 编辑

dcl对话框界面可以用飞诗dcl编辑器生成，dcl对话框的赋值与取值对新手来说入门比较难，论坛上有很多通用的函数，一直没有满意的，故写下此2函数。
抛转引玉一起交流，水平有限轻拍。附带了dcl完整测试程序文件。新增dcl创建函数 dcl_create

[*]dcl_setTile 赋值
[*]dcl_getTile 取值
[*]dcl_create

;;说明:对dcl对话框进行批量赋值及初始化
;;参数:lst: 控件keys 和 值组成的表
;;返回:
(defun dcl_setTile(lst / a)
(mapcar
    '(lambda(x)
       (cond
         ((= (type (cadr x)) 'list)
         (start_list (car x) );;(caadr x)
         (mapcar 'add_list   (val2str(cadadr x)))
         (end_list)
         (setq a (caadr x))
         (if (= (type a)'LIST)
             (set_tile (car x)
               (vl-string-right-trim " " (apply 'strcat (mapcar '(lambda(y)(strcat y " "))(val2str a))))               
             )                        
             (set_tile (car x) (val2str(caadr x)))
         )         
         )
         (t (set_tile (car x) (val2str (cadr x))) )
       )
   )
    lst
)   
)
;;说明:获取对话框控件值 需要注意的是没有进行数据合法性检查，自行增加
;;参数:lst: 控件keys和值组成的表 即变量保存列表*vars&vals*
;;返回:获取的控件变量
;;说明:
(defun dcl_getTile(lst / lst0key v)
;(setq lst0 lst)
(mapcar
    '(lambda(x)
       (setq key (car x))
       (setq v (get_tile key))
       (cond
         ((= (type (cadr x)) 'list)
         (setq a (caadr x))
         (if (/= (type a)'LIST)
             (setq v (atoi v))
             (setq v (read (strcat "(" v ")")))            
         )
         (list key (list v (cadadr x)))                     
         )
         (t(list key (str2val v (cadr x))));;(str2val "123.5" 10.1)
       )
   )
    lst
)
)
传入的lst要求是2维表(setq *vars&vals* ;;;全局变量用于初始化及保存dcl中所有的值 (setq *vars&vals* nil)
    '(
       ("op1" 1);radio1选则1选中 0不选 1选中
       ("op2" 0);radio1选则2未选中 0不选 1选中
       ("edit1" 123.5);;editbox实数
       ("edit2" "asbda");;editbox字符串
       ("tog1" 0);;toggle复选框 0不选 1选中。
       ("pop1"(2 (0.2 0.5 1.0 2.0 5.0))   );;popuplist下拉框列表 0 代表默认为列表中第一个值1代表第二个...
       ;(0.2 0.5 1.0 2.0 5.0)代表下拉列表框中显示的值
       ("list1"((1) ("物品1" "物品2" "物品3" "物品4"))   );;listbox下拉框列表1 代表默认为列表中第二个值2代表第三个...
       ;;("物品1" "物品2" "物品3" "物品4")list1中显示的值 ;如果列表支持多选 1换为 表 (1) (1 2 3)等
    )
)

(defun dcl_Create ( / dcl des dcl_id)
(setq dcl (vl-filename-mktemp nil nil ".dcl"))
(setq des (open dcl "w"))
(write-line (apply 'strcatdclLst )des)
(close des)
(setq dcl_id (load_dialog dcl))
(vl-file-delete dcl)
(setq dlg (car (vl-remove-if-not '(lambda (x) (wcmatch x "*dialog*")) dcllst)))
(setq dlg (car (LM:str->lst dlg ":" )))

(if (null (new_dialog dlg dcl_id))
    (exit)                                 
)
dcl_id

)


顺便附上对话框dcl文件转lisp文件程序，也就是程序中用到的dcllist 就不用单独打包dcl文件了。

hhh454 发表于 2022-3-12 20:07:14

本帖最后由 hhh454 于 2022-3-12 20:18 编辑

;; String to List-Lee Mac
;; Separates a string using a given delimiter
;; str - String to process
;; del - Delimiter by which to separate the string
;; Returns: List of strings

(defun LM:str->lst ( str del / len lst pos )
    (setq len (1+ (strlen del)))
    (while (setq pos (vl-string-search del str))
      (setq lst (cons (substr str 1 pos) lst)
            str (substr str (+ pos len))
      )
    )
    (reverse (cons str lst))
)

xyp1964 发表于 2022-3-12 20:34:11

(defun LM:str->lst (str del / n lst n1)
(setq n (1+ (strlen del)))
(while (setq n1 (vl-string-search del str))
    (setq lst (cons (substr str 1 n1) lst)
          str (substr str (+ n1 n))
    )
)
(vl-remove "" (reverse (cons str lst)))
)

言戲無軍 发表于 2022-4-5 13:21:04

kozmosovia 发表于 2022-4-2 16:30
https://www.zhihu.com/column/vldcl

膜拜了 vl dcl太专业了 只是自由度差了点，入门有点难

liuyj 发表于 2022-3-11 15:57:41

函数不全，缺val2str

言戲無軍 发表于 2022-3-11 16:03:44

在附件中，下载即可。

20060510412 发表于 2022-3-12 10:23:34

LM:str->lst
缺少这个函数

至野异族 发表于 2022-3-12 21:48:37

这个思路比较好，借鉴了，多谢分享

20060510412 发表于 2022-3-12 23:32:57

非常实用，dcl的设置流程得到了大大简化，多谢楼主。

AndyWang 发表于 2022-3-15 09:23:03

非常感谢楼主的分享

hnfsf 发表于 2022-3-28 22:27:20

这个思路很不错，多谢分享

查看完整版本: 通用的对话框DCL赋值与取值函数