list_box configuration
In a dialog box ¿how I can divide a list_box in two columns and asign values to each one of them with Vlisp code? Here is from my oldiesHope this will helps
Not exactly what you need because of
the list_box do not support multicolumn
interface
And also you can look at TABS function
This one will be allows you to add in the
same row the several values, separated by tab
;***************************************(defun C:SHL ( / lgfname 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 ******************
~'J'~
Here is another method to skin cat
Just a simple example again
Lisp:
;;TableExample.lsp(defun get-key (key) (setvar "USERS1" (get_tile key)) )(defun set_values(lst_keys lst_values) (if (not (eq (length lst_keys) (length lst_values))) (progn (alert "Both lists must have identical length. Error...") (exit) ) (mapcar (function (lambda (x y) (set_tile x y))) lst_keys lst_values ) ) )(defun get_values(lst_keys) (mapcar (function (lambda (x) (atof (get_tile x)))) lst_keys ) )(defun read-table-dcl() (setq do 1) (while (not (zerop do)) (setq dcl_ex (load_dialog "TableExample.dcl")) (princ "\n0") (new_dialog "tablo" dcl_ex) (princ "\n1") (set_values (setq keys '("a0" "a1" "a2" "b0" "b1" "b2" "c0" "c1" "c2")) (mapcar 'rtos (apply 'append (list '(0.0 0.0 0.0);--> p1 '(100.0 100.0 0.0);--> p2 '(200.0 0.0 0.0);--> p3 )) ) )(princ "\n2") (action_tile "accept" (strcat "(setq coords (get_values keys))" "(setq do 0)(done_dialog)")) (action_tile "cancel" "(setq do 0)(done_dialog)") (princ "\n3") (start_dialog) ) (unload_dialog dcl_ex) );;Usage(defun c:TPL() (read-table-dcl) (vl-load-com) (setq pl (vlax-invoke (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) 'AddPolyline coords )) (vla-put-closed pl :vlax-true) (vla-put-color pl acred) (vlax-invoke (vlax-get-acad-object) 'Zoomwindow '(0.0 0.0 0.0) '(200.0 150.0 0.0)) (princ) )(prompt "\n\t\t\t>>>Type TPL to execute...
页:
[1]