(XD::DCL:AddList)批量填充列表

Free-Lancer · 发表于 2014-10-6 08:52:18

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

本帖最后由 Free-Lancer 于 2014-10-11 08:39 编辑

(setq klst  '("k1" "k2" "k3" "k4") ;_key list
   lst1  '("0"  "1" "2" "3" "4")
   lst2  '("0"  "1" "2" "3" "4")
   lst3  '("0"  "1" "2" "3" "4")
   lst4  '("0"  "1" "2" "3" "4")
   itemL '("0"  "1" "2" "3")
)
单个列表控件填充， lst1 用变量形式可以在运行进行更改
(xd::dcl:addlist "k1" 'lst1 "0");项
(xd::dcl:addlist "k1" 'lst1 0) 索引形式，整数
(xd::dcl:addlist "k1" nil 0) 空表，不填充，索引值必须有，但无效
(xd::dcl:addlist "k1" 'lst1 nil) 填表，不设定默认索引
批量列表填充
(xd::dcl:addlist klst '(lst1 lst2 lst3 lst4) itemL)
(xd::dcl:addlist klst '(lst1 lst2 lst3) itemL) 仅填充与 klst 中对应的表
(xd::dcl:addlist klst '(lst1 lst2 lst3) nil)

;; 填充列表
(defun XD::DCL:AddList (_$klst _$val _$itemL / _addlist)
(defun _addlist (key val item / n _msettile)
(defun _msettile (item / ll)
(cond
((and (= (type item) 'INT) ;_整数时
(<= 0 item (1- (length (vl-symbol-value val))))
)
(set_tile key (itoa item))
)
((and (= (type item) 'STR)
(setq n (vl-position item (vl-symbol-value val)))
)
(set_tile key (itoa n))
)
((listp item) ;_ list_box multiple_select = true;
(setq ll (mapcar '(lambda (x)
(if (= (type x) 'STR)
(vl-position x (vl-symbol-value val))
x
)
)
item
)
)
(set_tile key
(vl-string-trim
" "
(vl-string-translate
"()"
" "
(vl-princ-to-string ll)
)
)
)
)
(t)
)
)
(if (eval val) ;_not nil
(progn
(start_list key)
(foreach n (vl-symbol-value val) (add_list n))
(end_list)
(if (eval (read key)) ;_如果 key 已有值
(_msettile (eval (read key)))
(if item ;_按给定设置默认索引
(_msettile item)
)
)
)
)
)
(if (listp _$klst)
(while _$klst ;_适应不等长表
(_addlist (car _$klst) (car _$val) (car _$itemL))
(setq _$klst (cdr _$klst)
_$val (cdr _$val)
_$itemL (cdr _$itemL)
)
)
(_addlist _$klst _$val _$itemL)
)
)

;; 填充列表 
(defun XD::DCL:AddList (_$klst _$val _$itemL / _addlist) 
  (defun _addlist (key val item / n _msettile) 
    (defun _msettile (item / ll) 
      (cond 
        ((and (= (type item) 'INT) ;_整数时 
              (<= 0 item (1- (length (vl-symbol-value val)))) 
         ) 
         (set_tile key (itoa item)) 
        ) 
        ((and (= (type item) 'STR) 
              (setq n (vl-position item (vl-symbol-value val))) 
         ) 
         (set_tile key (itoa n)) 
        ) 
        ((listp item) ;_ list_box multiple_select  = true; 
         (setq ll (mapcar '(lambda (x) 
                             (if (= (type x) 'STR) 
                               (vl-position x (vl-symbol-value val)) 
                               x 
                             ) 
                           ) 
                          item 
                  ) 
         ) 
         (set_tile key 
                   (vl-string-trim 
                     " " 
                     (vl-string-translate 
                       "()" 
                       "  " 
                       (vl-princ-to-string ll) 
                     ) 
                   ) 
         ) 
        ) 
        (t) 
      ) 
    ) 
    (if        (eval val) ;_not nil 
      (progn 
        (start_list key) 
        (foreach n (vl-symbol-value val) (add_list n)) 
        (end_list) 
        (if (eval (read key)) ;_如果 key 已有值 
          (_msettile (eval (read key))) 
          (if item ;_按给定设置默认索引 
            (_msettile item) 
          ) 
        ) 
      ) 
    ) 
  ) 
  (if (listp _$klst) 
    (while _$klst ;_适应不等长表 
      (_addlist (car _$klst) (car _$val) (car _$itemL)) 
      (setq _$klst  (cdr _$klst) 
            _$val   (cdr _$val) 
            _$itemL (cdr _$itemL) 
      ) 
    ) 
    (_addlist _$klst _$val _$itemL) 
  ) 
)

Free-Lancer · 发表于 2014-10-7 10:15:19

本帖最后由 Free-Lancer 于 2014-10-11 08:42 编辑

更新, 适应更复杂的批量填充, 测试代码

(defun c:tt2 (/ strl lyrlst fn id)
(setq strl '("temp:dialog {"
"label = \"List text\";"
":row {"
":list_box { key = \"lyr1\"; height = 16; width = 8;}"
":list_box { key = \"lyr2\"; height = 16; multiple_select = true; width = 8;}"
"}"
"ok_cancel;}"
)
lyrlst (fy:table "layer")
fn (xd::dcl:make strl)
id (xd::dcl:load fn "temp")
)
(xd::dcl:listaction
'("lyr1" "lyr2") ;_key list，单个列表时用 key string
'(lyrlst lyrlst) ;_引用的变量名，加 '，单个列表时 'lyrlst
'("0" ("1" 2 3)) ;_lyr1 lyr2 为全局变量, 指定初始索引
nil ;_ 不指定回调函数时记录索引值
)
(xd::dcl:accept nil) ;_不取值仅定义 ok cancel
(if (= (xd::dcl:start id fn) 1)
(progn
(and lyr1
(princ (strcat "\nListBox1 select " (vl-princ-to-string lyr1)))
)
(and lyr2
(princ (strcat "\nListBox2 select " (vl-princ-to-string lyr2)))
)
)
)
(princ)
)

(defun c:tt2 (/ strl lyrlst fn id) 
  (setq        strl   '("temp:dialog {" 
                 "label = \"List text\";" 
                 ":row  {" 
                 ":list_box { key = \"lyr1\"; height = 16; width = 8;}" 
                 ":list_box { key = \"lyr2\"; height = 16; multiple_select  = true; width = 8;}" 
                 "}" 
                 "ok_cancel;}" 
                ) 
        lyrlst (fy:table "layer") 
        fn     (xd::dcl:make strl) 
        id     (xd::dcl:load fn "temp") 
  ) 
  (xd::dcl:listaction 
    '("lyr1" "lyr2") ;_key list， 单个列表时用 key string 
    '(lyrlst lyrlst) ;_引用的变量名，加 '， 单个列表时 'lyrlst 
    '("0" ("1" 2 3)) ;_lyr1 lyr2 为全局变量, 指定初始索引 
    nil ;_ 不指定回调函数时记录索引值 
  ) 
  (xd::dcl:accept nil) ;_不取值仅定义 ok cancel 
  (if (= (xd::dcl:start id fn) 1) 
    (progn 
      (and lyr1 
           (princ (strcat "\nListBox1 select " (vl-princ-to-string lyr1))) 
      ) 
      (and lyr2 
           (princ (strcat "\nListBox2 select " (vl-princ-to-string lyr2))) 
      ) 
    ) 
  ) 
  (princ) 
)

Free-Lancer · 发表于 2014-10-10 17:26:26

2014.10.10更新

Free-Lancer · 发表于 2014-10-11 08:43:15

2014.10.11 更新多选时Bug

lucas3 · 发表于 2014-10-11 11:54:29

本帖最后由 lucas3 于 2014-10-11 12:08 编辑

Free-Lancer 发表于 2014-10-11 08:43
2014.10.11 更新多选时Bug

'("0" ("1" 2 3)) ;_lyr1 lyr2 为全局变量, 指定初始索引
大师，这又怎么理解啊？

另外这个示例看不出效果，默认的图层（即不选择）按确定后没有提示，能不能将这个示例完善，比如画两个同心圆，大圆用左边的图层，小圆用右边的图层……

Free-Lancer · 发表于 2014-10-11 14:39:16

lucas3 发表于 2014-10-11 11:54
'("0" ("1" 2 3)) ;_lyr1 lyr2 为全局变量, 指定初始索引
大师，这又怎么理解啊？

初始索引只是一个显示，当不进行选择时，在 xd::dcl:accept 中获取这个值，这样做只是为了前面少进行一些变量设置，这样说来 accept 还需要再改进一下，获取 List 时直接返回项名，现在是返回索引

(defun c:tt2 (/ strl lyrlst fn id result)
(setq strl '("temp:dialog {"
"label = \"List text\";"
":row {"
":list_box { key = \"lyr1\"; height = 16; width = 8;}"
":list_box { key = \"lyr2\"; height = 16; width = 8;}"
"}"
"ok_cancel;}"
)
lyrlst (mapcar 'car (xd::object:get "layer"))
fn (xd::dcl:make strl)
id (xd::dcl:load fn "temp")
result '("lyr1" "lyr2")
)
(xd::dcl:listaction
'("lyr1" "lyr2")
'(lyrlst lyrlst)
'("0" "1")
nil
)
(xd::dcl:accept 'result) ;_按确定后取出控件值,
(if (= (xd::dcl:start id fn) 1)
(progn
(if (not lyr1);_再不点击列表时虽然有默认索引但 lyr1 是不会赋值的
(setq lyr1 (nth (atoi (car result)) lyrlst))
)
(if (not lyr2)
(setq lyr1 (nth (atoi (cadr result)) lyrlst))
)
(and (setq p1 (getpoint "\nFirst Circle Center: "))
(entmakex (list '(0 . "circle")
(cons 8 lyr1)
(cons 10 p1)
'(40 . 100)
)
)
(setq p2 (getpoint p1 "\nSecond Circle Center: "))
(entmakex (list '(0 . "circle")
(cons 8 lyr2)
(cons 10 p2)
'(40 . 100)
)
)
)
)
)
(princ)
)

(defun c:tt2 (/ strl lyrlst fn id result) 
  (setq        strl   '("temp:dialog {" 
                 "label = \"List text\";" 
                 ":row  {" 
                 ":list_box { key = \"lyr1\"; height = 16; width = 8;}" 
                 ":list_box { key = \"lyr2\"; height = 16;  width = 8;}" 
                 "}" 
                 "ok_cancel;}" 
                ) 
        lyrlst (mapcar 'car (xd::object:get "layer")) 
        fn     (xd::dcl:make strl) 
        id     (xd::dcl:load fn "temp") 
        result '("lyr1" "lyr2") 
  ) 
  (xd::dcl:listaction 
    '("lyr1" "lyr2") 
    '(lyrlst lyrlst) 
    '("0" "1") 
    nil 
  ) 
  (xd::dcl:accept 'result) ;_按确定后取出控件值, 
  (if (= (xd::dcl:start id fn) 1) 
    (progn 
      (if (not lyr1);_再不点击列表时虽然有默认索引但 lyr1 是不会赋值的 
        (setq lyr1 (nth (atoi (car result)) lyrlst)) 
      ) 
      (if (not lyr2) 
        (setq lyr1 (nth (atoi (cadr result)) lyrlst)) 
      ) 
      (and (setq p1 (getpoint "\nFirst Circle Center: ")) 
           (entmakex (list '(0 . "circle") 
                           (cons 8 lyr1) 
                           (cons 10 p1) 
                           '(40 . 100) 
                     ) 
           ) 
           (setq p2 (getpoint p1 "\nSecond Circle Center: ")) 
           (entmakex (list '(0 . "circle") 
                           (cons 8 lyr2) 
                           (cons 10 p2) 
                           '(40 . 100) 
                     ) 
           ) 
      ) 
    ) 
  ) 
  (princ) 
)

炫翔 · 发表于 2014-11-5 14:50:19

  (xd::dcl:listaction
'("lyr1" "lyr2")
'(lyrlst lyrlst)
'("0" "1")
nil
  )

-->

  (xd::dcl:listaction
'("lyr1" "lyr2")
'(lyrlst lyrlst)
'(0 1)
nil
  )

Free-Lancer · 发表于 2014-11-6 09:57:31

炫翔发表于 2014-11-5 14:50
(xd::dcl:listaction
'("lyr1" "lyr2")
'(lyrlst lyrlst)

"0" 和 0 一样，函数里面用了 vl-princ-to-string

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

[对话框] (XD::DCL:AddList)批量填充列表

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

点评

点评

点评