选项打勾

dcl1214 · 发表于 2021-7-9 19:34:38

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

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

×

本帖最后由 dcl1214 于 2021-7-9 19:36 编辑

(defun $op-check$ (tiles dclname lst / *error*
dcl_id dcl-f dialog f keys
rows startnum tiles-key tmp_f
tmp_lst
)
;选项打钩，选项勾选
;调用示例：
;(setq tiles(list (list(cons "编码" "1")(cons "名称" "0")(cons "供应商" "1")(cons "CAD前视图祖玛" "0"))(list(cons "孔位数" "1")(cons "颜色" "0")(cons "尺寸" "0")(cons "备注" "0"))))
;($op-check$ tiles nil nil)
(defun *error* (s)
(if (and (= dialog 1) (< dialog 2))
(repeat 10
(print
"可能是因为传入的列表行数列数没整理好导致界面超出显示器分辨率"
)
)
(print s)
)
)
(cond ((and tiles
(= (type tiles) 'list)
(= (type (car tiles)) 'list)
(= (type (car (car tiles))) 'list)
(member (cdr (car (car tiles))) (list '"0" '"1"))
)
nil
)
((and tiles
(= (type tiles) 'list)
(= (type (car tiles)) 'list)
(= (type (car (car tiles))) 'str)
(member (cdr (car tiles)) (list '"0" '"1"))
)
(setq tiles (list tiles))
)
((and tiles
(= (type tiles) 'list)
(= (type (car tiles)) 'str)
)
(setq tiles
(mapcar (function
(lambda (a)
(mapcar (function (lambda (b) (cons b "0"))) a)
)
)
(list tiles)
)
)
)
(t (setq tiles nil))
)
(setq tiles-key
(mapcar
(function
(lambda (r ir)
(mapcar
(function
(lambda (a ic / k str)
(setq k (strcat "r" (vl-princ-to-string ir)))
(setq k (strcat k "c" (vl-princ-to-string ic)))
(setq
str (strcat ":toggle {"
(strcat "key = \"" k "\" ;")
(strcat "label = \"" (car a) "\" ;")
(strcat "value = " (cdr a) " ;")
"width = 20 ;"
"vertical_margin = none ;"
"horizontal_margin = none ;"
"}"
)
)
(list (cons "字段" (car a))
(cons "key" k)
(cons "str" str)
)
)
)
r
(mapcar '1+ (wire:range (length r)))
)
)
)
tiles
(mapcar '1+ (wire:range (length tiles)))
)
)
(setq
keys
(mapcar
(function
(lambda (a)
(mapcar (function (lambda (b) (cdr (assoc "key" b)))) a)
)
)
tiles-key
)
)
(setq keys (apply 'append keys))
(setq
rows
(mapcar
(function
(lambda (a)
(mapcar (function (lambda (b) (cdr (assoc "str" b)))) a)
)
)
tiles-key
)
)
(setq
rows (mapcar
(function
(lambda (a / str)
(setq str (apply 'strcat a))
(setq str (strcat ":concatenation {" str "}"))
(setq str
(strcat
str
":spacer {fixed_height = true ;height = 0.25 ;vertical_margin = none ;horizontal_margin = none ;}"
)
)
str
)
)
rows
)
)
(setq rows
(append
(list "op:dialog {key = \"op\" ;label = \"请选择\" ;")
(list
":spacer {fixed_height = true ;height = 0.2 ;vertical_margin = none ;horizontal_margin = none ;}"
)
rows
(list
":button {is_cancel = true ;key = \"tc\" ;label = \"确定\" ;vertical_margin = none ;horizontal_margin = none ;}"
)
(list "vertical_margin = none ;horizontal_margin = none ;}")
)
)
(setq tmp_lst rows)
(or dclname (setq dclname "op"))
(if (and dclname tiles)
(progn
(setq
f (strcat (vl-filename-directory (vl-filename-mktemp)) "\\")
)
(and (setq tmp_f (strcat f dclname ".dcl")))
(if (and tmp_f (findfile tmp_f))
(vl-file-delete tmp_f)
)
(setq dcl-f (_sensor:lst->dat tmp_f tmp_lst T NIL))
(and dcl-f (setq dcl_id (load_dialog dcl-f)))
(if dcl_id
(progn
(setq dialog 1)
(and dcl_id (new_dialog "op" dcl_id))
(setq dialog 2)
(ACTION_TILE
"tc"
"(PROGN(setq keys-gou(mapcar(function(lambda(a)(cons a(get_tile a))))keys))(done_dialog 0))"
)
(setq startNum (start_dialog))
(and dcl_id (unload_dialog dcl_id))
)
)
)
)
(mapcar
(function
(lambda (a)
(mapcar
(function (lambda (b / tag key v)
(setq tag (cdr (assoc "字段" b)))
(setq key (cdr (assoc "key" b)))
(setq v (vl-some (function (lambda (c)
(if (= (car c) key)
(cdr c)
)
)
)
keys-gou
)
)
(or v (setq v "0"))
(cons tag v)
)
)
a
)
)
)
tiles-key
)
)(defun _sensor:lst->dat (filename data extension lst / file)
;写对话框文件
(if (not filename)
(setq filename (getfiled "Create Output File" "" extension 1))
)
(if (setq file (open filename "w"))
(progn
(cond ((= (type data) 'STR)
(write-line data file)
)
((= (type data) 'LIST)
(foreach line data
(write-line line file)
)
)
)
(close file)
filename
)
nil
)
)

(defun $op-check$ (tiles    dclname  lst      /         *error* 
       dcl_id   dcl-f    dialog   f         keys 
       rows      startnum tiles-key         tmp_f 
       tmp_lst 
      ) 
          ;选项打钩，选项勾选 
          ;调用示例： 
          ;(setq tiles(list (list(cons "编码" "1")(cons "名称" "0")(cons "供应商" "1")(cons "CAD前视图祖玛" "0"))(list(cons "孔位数" "1")(cons "颜色" "0")(cons "尺寸" "0")(cons "备注" "0")))) 
          ;($op-check$ tiles nil nil) 
  (defun *error* (s) 
    (if  (and (= dialog 1) (< dialog 2)) 
      (repeat 10 
  (print 
    "可能是因为传入的列表行数列数没整理好导致界面超出显示器分辨率" 
  ) 
      ) 
      (print s) 
    ) 
  ) 
  (cond  ((and tiles 
        (= (type tiles) 'list) 
        (= (type (car tiles)) 'list) 
        (= (type (car (car tiles))) 'list) 
        (member (cdr (car (car tiles))) (list '"0" '"1")) 
   ) 
   nil 
  ) 
  ((and tiles 
        (= (type tiles) 'list) 
        (= (type (car tiles)) 'list) 
        (= (type (car (car tiles))) 'str) 
        (member (cdr (car tiles)) (list '"0" '"1")) 
   ) 
   (setq tiles (list tiles)) 
  ) 
  ((and tiles 
        (= (type tiles) 'list) 
        (= (type (car tiles)) 'str) 
   ) 
   (setq tiles 
    (mapcar  (function 
        (lambda (a) 
          (mapcar (function (lambda (b) (cons b "0"))) a) 
        ) 
      ) 
      (list tiles) 
    ) 
   ) 
  ) 
  (t (setq tiles nil)) 
  ) 
  (setq  tiles-key 
   (mapcar 
     (function 
       (lambda (r ir) 
         (mapcar 
     (function 
       (lambda (a ic / k str) 
         (setq k (strcat "r" (vl-princ-to-string ir))) 
         (setq k (strcat k "c" (vl-princ-to-string ic))) 
         (setq 
           str (strcat ":toggle {" 
           (strcat "key = \"" k "\" ;") 
           (strcat "label = \"" (car a) "\" ;") 
           (strcat "value = " (cdr a) " ;") 
           "width = 20 ;" 
           "vertical_margin = none ;" 
           "horizontal_margin = none ;" 
           "}" 
         ) 
         ) 
         (list (cons "字段" (car a)) 
         (cons "key" k) 
         (cons "str" str) 
         ) 
       ) 
     ) 
     r 
     (mapcar '1+ (wire:range (length r))) 
         ) 
       ) 
     ) 
     tiles 
     (mapcar '1+ (wire:range (length tiles))) 
   ) 
  ) 
  (setq 
    keys 
     (mapcar 
       (function 
   (lambda (a) 
     (mapcar (function (lambda (b) (cdr (assoc "key" b)))) a) 
   ) 
       ) 
       tiles-key 
     ) 
  ) 
  (setq keys (apply 'append keys)) 
  (setq 
    rows 
     (mapcar 
       (function 
   (lambda (a) 
     (mapcar (function (lambda (b) (cdr (assoc "str" b)))) a) 
   ) 
       ) 
       tiles-key 
     ) 
  ) 
  (setq 
    rows (mapcar 
     (function 
       (lambda (a / str) 
         (setq str (apply 'strcat a)) 
         (setq str (strcat ":concatenation {" str "}")) 
         (setq str 
          (strcat 
      str 
      ":spacer {fixed_height = true ;height = 0.25 ;vertical_margin = none ;horizontal_margin = none ;}" 
          ) 
         ) 
         str 
       ) 
     ) 
     rows 
   ) 
  ) 
  (setq  rows 
   (append 
     (list "op:dialog {key = \"op\" ;label = \"请选择\" ;") 
     (list 
       ":spacer {fixed_height = true ;height = 0.2 ;vertical_margin = none ;horizontal_margin = none ;}" 
     ) 
     rows 
     (list 
       ":button {is_cancel = true ;key = \"tc\" ;label = \"确定\" ;vertical_margin = none ;horizontal_margin = none ;}" 
     ) 
     (list "vertical_margin = none ;horizontal_margin = none ;}") 
   ) 
  ) 
  (setq tmp_lst rows) 
  (or dclname (setq dclname "op")) 
  (if (and dclname tiles) 
    (progn 
      (setq 
  f (strcat (vl-filename-directory (vl-filename-mktemp)) "\\") 
      ) 
      (and (setq tmp_f (strcat f dclname ".dcl"))) 
      (if (and tmp_f (findfile tmp_f)) 
  (vl-file-delete tmp_f) 
      ) 
      (setq dcl-f (_sensor:lst->dat tmp_f tmp_lst T NIL)) 
      (and dcl-f (setq dcl_id (load_dialog dcl-f))) 
      (if dcl_id 
  (progn 
    (setq dialog 1) 
    (and dcl_id (new_dialog "op" dcl_id)) 
    (setq dialog 2) 
    (ACTION_TILE 
      "tc" 
      "(PROGN(setq keys-gou(mapcar(function(lambda(a)(cons a(get_tile a))))keys))(done_dialog 0))" 
    ) 
    (setq startNum (start_dialog)) 
    (and dcl_id (unload_dialog dcl_id)) 
  ) 
      ) 
    ) 
  ) 
  (mapcar 
    (function 
      (lambda (a) 
  (mapcar 
    (function (lambda (b / tag key v) 
          (setq tag (cdr (assoc "字段" b))) 
          (setq key (cdr (assoc "key" b))) 
          (setq v (vl-some (function (lambda (c) 
               (if (= (car c) key) 
                 (cdr c) 
               ) 
             ) 
               ) 
               keys-gou 
            ) 
          ) 
          (or v (setq v "0")) 
          (cons tag v) 
        ) 
    ) 
    a 
  ) 
      ) 
    ) 
    tiles-key 
  ) 
)(defun _sensor:lst->dat (filename data extension lst / file) 
  ;写对话框文件 
      (if (not filename) 
        (setq filename (getfiled "Create Output File" "" extension 1)) 
      ) 
      (if (setq file (open filename "w")) 
        (progn 
          (cond        ((= (type data) 'STR) 
                 (write-line data file) 
                ) 
                ((= (type data) 'LIST) 
                 (foreach line data 
                   (write-line line file) 
                 ) 
                ) 
          ) 
          (close file) 
          filename 
        ) 
        nil 
      ) 
    )

yoyoho · 发表于 2021-7-10 12:22:29

指令: (setq tiles(list (list(cons "编码" "1")(cons "名称" "0")(cons "供应商" "1")(cons
"CAD前视图祖玛" "0"))(list(cons "孔位数" "1")(cons "颜色" "0")(cons "尺寸" "0")(cons "备注"
"0"))))
((("编码" . "1") ("名称" . "0") ("供应商" . "1") ("CAD前视图祖玛" . "0")) (("孔位数" . "1")
("颜色" . "0") ("尺寸" . "0") ("备注" . "0")))

指令: (op-check tiles nil nil)

"no function definition: WIRE:RANGE"

dcl1214 · 发表于 2021-7-10 14:04:58

yoyoho 发表于 2021-7-10 12:22
指令: (setq tiles(list (list(cons "编码" "1")(cons "名称" "0")(cons "供应商" "1")(cons
"CAD前视图 ...

其他帖子里面有这个函数

yangjian001 · 发表于 2021-7-11 09:31:47

做一个热心并受欢迎的人

Michael527 · 发表于 2021-7-12 19:45:21

收藏，有时间研究研究

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

[原创] 选项打勾

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

点评