gaomingabc456 发表于 2017-11-7 17:29:13

矩阵 按钮提示

; Buttons from assoc list (matrix):
; dlglbl - dialog's label
; size - list of '(width height) - must be numerical
; aL - assoc list of strings, each item defines a row, the strings must be unique (they are used as keys)
(defun PromptWithMatrixButtons ( dlglbl size aL / LM:Unique-p *error* dcl des dch dcf r )

;; Unique-p-Lee Mac ;; Returns T if the supplied list contains distinct items.
(defun LM:Unique-p ( l ) (vl-every (function (lambda ( x ) (not (member x (setq l (cdr l)))))) l) )

(defun *error* ( msg )
    (and (< 0 dch) (unload_dialog dch))
    (and (eq 'FILE (type des)) (close des))
    (and (eq 'STR (type dcl)) (findfile dcl) (vl-file-delete dcl))
    (and msg (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\nError: " msg)) ))
    (princ)
); defun *error*

(cond
    ( (not (vl-consp aL)) (princ "\n Invalid input - aL is not a list.") )
    ( (not (vl-every '(lambda (x) (and (vl-consp x) (vl-every '(lambda (s) (or (not s) (eq 'STR (type s)))) x))) aL))
      (princ "\nInvalid list, the format must be assoc list of strings")
    )
    ( (not (LM:Unique-p (mapcar '(lambda (x) (strcase x)) (vl-remove-if 'null (apply 'append aL)))))
      (princ "\n Invalid list, it contains duplicate keys.")
    )
    (
      (not
      (and (setq dcl (vl-filename-mktemp nil nil ".dcl")) (setq des (open dcl "w"))
          (mapcar (function (lambda (x) (princ (strcat "\n" x) des)))
            (list
            "PromptWithMatrixButtons : dialog"
            (strcat "{ label = \"" (if (eq 'STR (type dlglbl)) dlglbl "") "\"; children_alignment = centered; spacer;")
            (apply 'strcat
                (mapcar
                  '(lambda (x)
                  (strcat
                      "\n: row"
                      "\n{"
                      (apply 'strcat
                        (mapcar
                        (function
                            (lambda ( keylbl )
                              (if keylbl
                              (strcat
                                  "\n: button"
                                  "{ label = \"" keylbl "\"; key = \"" keylbl "\"; "
                                  (if (and (vl-consp size) (= 2 (length size)))
                                    (strcat
                                    (if (numberp (car size)) (strcat "width = "(vl-princ-to-string (car size))";") "")
                                    (if (numberp (cadr size)) (strcat "height = "(vl-princ-to-string (cadr size))";") "")
                                    ); strcat
                                    ""
                                  ); if
                                  "}"
                              ); strcat
                              (strcat
                                  "\n : button"
                                  "{"
                                  "is_enabled = false;"
                                  (if (and (vl-consp size) (= 2 (length size)))
                                    (strcat
                                    (if (numberp (car size)) (strcat "width = "(vl-princ-to-string (car size))";") "")
                                    (if (numberp (cadr size)) (strcat "height = "(vl-princ-to-string (cadr size))";") "")
                                    ); strcat
                                    ""
                                  ); if
                                  "}"
                              ); strcat
                              ); if keylbl
                            ); lambda (keylbl)
                        )
                        x
                        ); mapcar
                      ); apply 'strcat
                      "\n}"
                  ); strcat
                  ); lambda (x)
                  aL
                ); mapcar
            ); apply 'strcat
            "spacer; ok_only;"
            "}"
            ); list
          ); mapcar
          (not (setq des (close des))) (< 0 (setq dch (load_dialog dcl)))
      ); and
      ); not
      (princ "\n Unable to write or load the DCL file.")
    )
    ( (not (new_dialog "PromptWithMatrixButtons" dch)) (princ "\n Unable to display the dialog") )
    (
      (progn
      (mapcar '(lambda (k) (action_tile k (vl-prin1-to-string '(progn (setq r $key) (done_dialog 1))))) (vl-remove 'nil (apply 'append aL)))
      (action_tile "accept" (vl-prin1-to-string '(done_dialog 0)))
      (/= 1 (setq dcf (start_dialog)))
      ); progn
      (princ "\n User cancelled the dialog.")
    )
); cond
(*error* nil) r
); defun PromptWithMatrixButtons

(defun c:11()
(PromptWithMatrixButtons "Matrix Buttons Prompt" '(8 3)
'(
    ("A1" "B1" "C1" "D1" "E1" "F1" "G1" "H1" "I1" "J1" "K1" "L1" "M1" "N1") ; <- row
    ("A2" "B2" "C2" "D2" "E2" "F2" "G2" "H2" "I2" "J2" "K2" "L2" "M2" "N2")
    ("A3" "B3" "C3" "D3" "E3" "F3" "G3" "H3" "I3" "J3" "K3" "L3" "M3" "N3")
    ("A4" "B4" "C4" "D4" "E4" "F4" "G4" "H4" "I4" "J4" "K4" "L4" "M4" "N4")
    ("A5" "B5" "C5" "D5" "E5" "F5" "G5" "H5" "I5" "J5" "K5" "L5" "M5" "N5")
    ("A6" "B6" "C6" "D6" "E6" "F6" "G6" "H6" "I6" "J6" "K6" "L6" "M6" "N6")
    ("A7" "B7" "C7" "D7" "E7" "F7" "G7" "H7" "I7" "J7" "K7" "L7" "M7" "N7")
    ("A8" "B8" "C8" "D8" "E8" "F8" "G8" "H8" "I8" "J8" "K8" "L8" "M8" "N8")
    ("A9" "B9" "C9" "D9" "E9" "F9" "G9" "H9" "I9" "J9" "K9" "L9" "M9" "N9")
);^ column
)
(princ)
)

864643236 发表于 2017-11-7 20:05:07

太了,处处都是高!

USER2128 发表于 2017-11-10 08:34:29

(defun c:11() . . .(princ))中的(princ)语句应注释掉,不然,就不能返回你究竟是按了哪个按钮

renyonghua2014 发表于 2021-2-9 21:47:22

调用函数没整成功,版主能讲一下吗?
页: [1]
查看完整版本: 矩阵 按钮提示