DCL 文件浏览示例

在特定的情况下,需要对一些文件进行浏览时,比如 dwg 图库、幻灯片、lsp 程序 等等,可以用此方法进行。

;|***********************************************************
文件列表浏览设计   by  yxp   2017-5-10
引入五个控件
    1. 一个 popup_list  控件,用来显示当前全路径的下拉列表
    2. 两个 list_box  控件,分别用来显示当前路径的文件夹以及文件列表
    3. 两个 edit_box  设置过滤,对文件列表有效,以及文件全路径
设置全局变量:
    *popup-Apath*  下拉列表框
    *floder-name*  文件夹列表
    *files-name*   文件列表
    *filter-txt*   过滤文本
    *select-file*  当前选中的文件
定义列表框事件:
    双击文件夹列表框,进入对应文件夹
    双击文件列表框,退出对话框,并调用打开文件函数
注意:
    如果不指定文件路径,在 CAD 2018 中 findfile 函数将不再搜索
***********************************************************|;
(vl-load-com)
(defun c:test( / dcl_id *f_dcl* UIreturn )
(setq *f_dcl* (strcat (getvar 'TEMPPREFIX) "xfilemanage.dcl"))
(or (findfile *f_dcl*)(Creat_fDCL))     ;;创建对话框
(while (progn
    (setq dcl_id (load_dialog *f_dcl*))  ;;加载对话框
    (if (not (new_dialog "mfiles" dcl_id))(exit)) ;;激活对话框
    (fillxlpath)    ;;填充下拉列表
    (FillFloderlist)
    (action_tile "F1" "(FillFloderlist)")       ;;下拉列表事件
    (action_tile "F2" "(dBFloderlist $reason)")    ;;文件夹列表事件
    (action_tile "F3" "(dBFileslist $reason)") ;;文件列表事件
    (action_tile "Y21" "(done_dialog 4)")
    (action_tile "Y22" "(done_dialog 3)")
    (setq UIreturn (start_dialog))
    (unload_dialog dcl_id)  ;;释放对话框
    (cond
        ((= UIreturn 4) (if (wcmatch (strcase *select-file*) (strcase "*.lsp")) (load *select-file*)) nil) ;;调用打开文件
        ((= UIreturn 3) nil)
        (nil)
    ))
)(princ)
)

;;返回盘符列表 c:\ d:\ e:\
(defun Get_disklist( / ss L n)
(setq n 67)
(while (< n 76)
    (setq ss (strcat (chr n) ":\\"))
    (if (vl-directory-files ss)(setq L (cons ss L)))
    (setq n (1+ n))
)(reverse L)
)

;;填充下拉列表盒
(defun fillxlpath()
(or *popup-Apath* (setq *popup-Apath* (Get_disklist)))
(start_list "F1")
(mapcar 'add_list *popup-Apath*)
(end_list)
(set_tile "F1" "0")
)

;;填充文件夹及文件列表
(defun FillFloderlist( / ss fit)
(setq ss (nth (atoi (get_tile "F1")) *popup-Apath*)
    fit (get_tile "F4"))
(if (= fit "")(setq fit nil))
(start_list "F2")
(mapcar 'add_list (setq *floder-name* (vl-directory-files ss nil -1)))
(end_list)
(start_list "F3")
(mapcar 'add_list (setq *files-name* (vl-directory-files ss fit 1)))
(end_list)
)

;;单击/双击文件夹列表事件
(defun dBFloderlist(n / ss1 ss2 ss3 fit)
(setq ss1 (nth (atoi (get_tile "F2")) *floder-name*)
    ss2 (nth (atoi (get_tile "F1")) *popup-Apath*)
    fit (get_tile "F4"))
(if (= fit "")(setq fit nil))
(set_tile "F5" "")
(start_list "F3")
(mapcar 'add_list (setq *files-name* (vl-directory-files (strcat ss2 ss1 "\\") fit 1)))
(end_list)
(if (= n 4)(progn
    (setq ss3 (strcat (vl-string-right-trim "\\" (findfile (strcat ss2 ss1))) "\\"))
    (if (null (member ss3 *popup-Apath*))(progn (setq *popup-Apath* (cons ss3 *popup-Apath*)) (fillxlpath))
        (set_tile "F1" (itoa (vl-position ss3 *popup-Apath*)))
    )
(FillFloderlist)
))
)

;;单击/双击文件列表事件
(defun dBFileslist(n / ss1 ss2 ss3)
(setq ss1 (nth (atoi (get_tile "F1")) *popup-Apath*)
    ss2 (nth (atoi (get_tile "F2")) *floder-name*)
    ss3 (nth (atoi (get_tile "F3")) *files-name*))
(or (setq *select-file* (findfile (strcat ss1 ss2 "\\" ss3)))(setq *select-file* ""))
(set_tile "F5" *select-file*)
(if (= n 4)(done_dialog 4))
)

;;创建 DCL 对话框
(defun Creat_fDCL( / xx f)
(setq xx '("mfiles: dialog{label=\"DCL文件管理示例\";"
    "spacer_1;:popup_list{key=\"F1\";width=50;}:list_box{key=\"F2\";}"
    ":edit_box{label=\"文件过滤:\";key=\"F4\";}:list_box{key=\"F3\";}:edit_box{key=\"F5\";}"
    "spacer_1;:row{:button{label=\"打开(&S)\";key=\"Y21\";}"
    ":button{label=\"关闭(&Q)\";key=\"Y22\";is_cancel=true;}}}")
    f (open *f_dcl* "w"))
(foreach x xx (write-line x f))
(close f)
)

这里写图片描述

  • 1
    点赞
  • 8
    收藏
    觉得还不错? 一键收藏
  • 打赏
    打赏
  • 0
    评论
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包

打赏作者

yxp_xa

你的鼓励将是我创作的最大动力

¥1 ¥2 ¥4 ¥6 ¥10 ¥20
扫码支付:¥1
获取中
扫码支付

您的余额不足,请更换扫码支付或充值

打赏作者

实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值