[编程交流] list_box configuration

;***************************************(defun C:SHL ( / lg  fname       fn nu dcl_id         tx relst lstl oldcmd)(setq oldcmd (getvar "cmdecho"))(setvar "cmdecho" 0)(initax)  (createdcl)(my-layers)(my-all-layers-info)(my-show-layers)  (my-drop-list)(rundcl)  (add_info_all)(setvar "cmdecho" oldcmd)(princ));defun;***************************************(defun createdcl ()(gc)(setq fname (strcat (getvar "DWGPREFIX") "layer_list.dcl"))(setq tbl_list '("Layer"  "Layer on" "Freeze" "Lock"                "Color" "Linetype" "Lineweight")     nm_list '("alist1"  "alist2" "alist3"               "alist4" "alist5" "alist6" "alist7")     wid_list '(12 8 8 8 8 15 10)     adr_list nm_list)(setq fn (open fname "w"))(write-line "layerlist : dialog { label = "LAYER TABLE :";" fn)(write-line "spacer_1;" fn)(write-line ": row  {" fn)(repeat (length tbl_list)  (write-line ": list_box {" fn)(write-line (strcat "label = " """ (car tbl_list) """ ";")  fn)  (write-line (strcat "key = " """ (car nm_list) """ ";")  fn)(write-line (strcat "allow_accept = false" ";")  fn)(write-line "horizontal_margin = none;" fn)(write-line "vertical_margin = none;" fn)   (write-line (strcat "alignment = centered; width = "                   (itoa (car wid_list)) "; height = 12;}") fn)(setq tbl_list (cdr tbl_list)     nm_list (cdr nm_list)     wid_list (cdr wid_list)))(write-line "}" fn)(write-line "spacer;" fn)  (write-line "ok_cancel; " fn)(write-line ": text_part {" fn)(write-line (strcat "value = " """ "Designed by fixo" """ ";") fn)(write-line "alignment = left; }" fn)(write-line ": text_part {" fn)(write-line (strcat "value = " """ "From man to man" """ ";") fn)(write-line "alignment = left; }" fn)  (write-line "}" fn)  (close fn));***************************************(defun initax ()  (or acapp (setq acapp (vlax-get-acad-object)))(or adoc (setq adoc (vla-get-activedocument acapp)))(cond  ((= (getvar "TILEMODE") 1)(or mdsp (setq mdsp (vla-get-modelspace adoc))))      ((= (getvar "TILEMODE") 0)(or mdsp (setq mdsp (vla-get-paperspace adoc))))));***************************************(defun my-layers () (vlax-get-property adoc "Layers")) ;***************************************(defun my-getlayer (name)(vla-item (my-layers) name));;;(my-getlayer "0");***************************************(defun my-layer-info (name / lr lst_info)(setq lr (my-getlayer name)list_info (list (vla-get-name lr)(vla-get-layeron lr)(vla-get-freeze lr)(vla-get-lock lr)(vla-get-color lr)(vla-get-linetype lr)(vla-get-lineweight lr)(vla-get-layeron lr))))      ;***************************************(defun my-all-layers-info ( / lr lrs_info) (vlax-for l (my-layers)   (setq lrs_info          (cons (my-layer-info (vla-get-name l))                lrs_info))) (reverse lrs_info));***************************************(defun my-show-layers ()(mapcar (function (lambda (x)(mapcar (function (lambda (y)        (cond (( = y :vlax-true) "+")              (( = y :vlax-false) "-")              (( = (type y) 'int) (itoa y))              (T y)))) x)))       (my-all-layers-info)));***************************************(defun my-drop-list ( / )      (setq lrs_list nil tmp nil)(setq lst  (my-show-layers))      (repeat (length lst) (setq tmp (mapcar (function (lambda (x)(car x))) lst)) (setq lrs_list (append lrs_list (list tmp ))) (setq lst (mapcar 'cdr lst))) lrs_list );****************************************(defun rundcl ()(setq dcl_id (load_dialog "layer_list.dcl"))(if (not (new_dialog "layerlist" dcl_id))(exit)) (action_tile "accept""(progn(setq l1 (get_tile "alist1"))(setq l2 (get_tile "alist2"))(setq l3 (get_tile "alist3"))(setq l4 (get_tile "alist4"))(setq l5 (get_tile "alist5"))(setq l6 (get_tile "alist6"))(setq l7 (get_tile "alist7"))(add_info_all))")(start_dialog)(unload_dialog dcl_id)(vl-file-delete fname));defun;***********************************************(defun add_info_all ( /  load_list)(setq load_list (my-drop-list)) (repeat (length adr_list)    (start_list (car adr_list))     (mapcar 'add_list (car load_list))     (end_list)         (start_dialog)     (unload_dialog dcl_id)   (setq adr_list (cdr adr_list) load_list (cdr load_list))   )   )(prompt "\n\t\t***  Type SHL to show layers info...  ***")(princ)(vl-load-com);**************** end of code ******************