Just 4 fun : Multiple Input Listbox Function

[rlx]

This (sub)function is part of a larger appie I'm currently working on (not sure how I'm gonna name the larger app yet , for now called it RlxBlockSync but also entertaining the idea to call RFD, redefine for dummies )

 

Anyways, this sub dynamically creates a dialog and takes 'commatized' strings for input. Few years ago I wrote Tokkie, this basically does the same , just a little different and with less code. I was inspired by a similar function master L created and later Grrr made something like that.

 

The reason I use commatized / csv strings is so I can save the output of this function as a string in the registry. Added little test function which generates 3 list boxes but you can have as many LB's as you like, the only limitations are your imagination and the width of your monitor. I hope by analyzing the test function (c:t1) you understand how you can use this function.

 

; multiple input listbox function : mlist = ( ( description1 (labels1) (defaults1) ) ...)
(defun milf ( mlist / get_lb_width commatize de-commatize _ufo toggle fn fp dcl lb-width old-props new-props plist tmp out)
  ; get max strlen from list arguments for milf
  (defun get_lb_width (l) (apply 'max (mapcar 'strlen (apply 'append (mapcar 'de-commatize (mapcar 'cadr l))))))
  ; (commatize '("a" "b" "c"))  ->  "a,b,c"
  (defun commatize (l) (apply 'strcat (cdr (apply 'append (mapcar '(lambda (x) (list "," x)) l)))))
  ; (de-commatize "a,b,c")  ->   ("a" "b" "c")
  (defun de-commatize (s / p)(if (setq p (vl-string-search "," s))(cons (substr s 1 p)(de-commatize (substr s (+ p 2))))(list s)))
  ; use filter on : (_ufo "*" '("door" "table" "floor")) (_ufo "o" '("door" "table" "floor"))
  (defun _ufo ( f l ) (if (and (= (type f) 'STR) (/= f ""))
    (vl-remove-if '(lambda (s)(not (or (eq f "*") (vl-string-search (strcase f)(strcase s))))) l)))
  ; adds / removes [0] or [X] before each item in listboxes
  (defun toggle (k v / lst r s)
    (if (eq (substr (setq r (nth (atoi v) (setq lst (cdr (assoc k plist))))) 2 1) "X") (setq s "[O] ") (setq s "[X] "))
      (setq plist (subst (cons k (setq lst (subst (strcat s (substr r 5)) r lst))) (assoc k plist)  plist))
        (start_list k)(mapcar 'add_list lst)(end_list)(set_tile k v))
  ; calculated width of list boxes by finding longest string
  (setq lb-width (+ (get_lb_width mlist) 5))
  (if (not (setq fp (open (setq fn (vl-filename-mktemp ".dcl")) "w")))
    (princ "\nUnable to create temporary dcl file")
    (progn
      (write-line "milf:dialog {label=\"Multiple Input Listbox Function (RLX 5/'20)\";:row {" fp)
      (setq lb 0)
      (foreach item mlist (write-line (strcat ":column {label=\"" (car item)
         "\";:list_box{height=16;width=" (itoa lb-width)  ";key=\"lb" (itoa (setq lb (1+ lb))) "\";}}") fp))
      (write-line "}ok_cancel;}" fp)(if fp (progn (close fp)(gc)))
      (if (not (and (< 0 (setq dcl (load_dialog fn))) (new_dialog "milf" dcl)))
        (princ "\nUnable to start dialog milf")
        (progn
          (setq lb 0)
          (foreach item mlist
            (setq old-props (de-commatize (cadr item)) new-props (de-commatize (caddr item)))
            (setq l (mapcar '(lambda (x)(if (member x new-props)(strcat "[X] " x)(strcat "[O] " x))) old-props))
            (setq lb-id (strcat "lb" (itoa (setq lb (1+ lb))))  plist (cons (cons lb-id l) plist))
            (start_list lb-id) (mapcar 'add_list l) (end_list)
            (action_tile (strcat "lb" (itoa lb)) "(toggle $key $value)")
          )
          (action_tile "accept" "(done_dialog 1)")
          (action_tile "cancel" "(done_dialog 0)")
          (setq drv (start_dialog)) (unload_dialog dcl)(vl-file-delete fn)
        )
      )
    )
  )
  (if (= drv 1) (mapcar '(lambda (x)(commatize (mapcar '(lambda (y)(substr y 5)) x)))
                   (mapcar '(lambda (x)(_ufo "[X]" x))(mapcar 'cdr (reverse plist)))) nil)
)

(defun c:t1 ( / result-list animals breakfast music)
  (setq animals "Aardvark,Baboon,Camel,Dragons,Easterbunny,Firebird,Godzilla,Hobbit,Idiot,Phoenix")
  (setq breakfast "Anna Nicole,Beyoncé Knowles,Carmen Electra,Daenerys Targaryen,Ella Enchanted,Gal Gadot,Sophie Turner")
  (setq music "Andrea Bocelli,Electric Light Orchestra,Earth Wind & Fire,George Michael,Lara Fabian,Queen")
  (setq result-list
         (milf
           (list
             (list "Animals" animals "Dragons,Phoenix")
             (list "Breakfast" breakfast "Gal Gadot,Sophie Turner")
             (list "Music" music "Electric Light Orchestra,Lara Fabian")
             ;;; add as many list as you want limited only by the size of the screen
           )
         )
  )
  (princ "\n\nYou made the following selections : ")
  (mapcar '(lambda (label value) (princ (strcat "\n\n" label "\nvalue : " value)))
          '("Animals :" "Breakfast :" "Music :" ) result-list)
  (princ "\n\n")
  (princ)
)

 

I can show you how other app looks , but that's not finished yet (if ever) so will get back to that later

 

 

Awell... hope I didn't forget any sub functions that are allways loaded automatically on my own pc (autoload & forget) but if so let me know (wouldn't be the first time I forgot something and probably not the last time)

 

happy coding

 

 

[BIGAL]

Like the multiple list box dcl. This is something needed by "will find post, its here"

 

I made the multi toggle dcl "look in downloads". Its just a single column version of what you have done but using toggles again limited to screen depth. May be worth adding the toggles option.

[rlx]

Still use the multi toggle for very long list's like for all files in a folder , but you need to keep track of the index for each toggle belonging to each var / label. In case of code posted above, each text in the listbox is its own toggle although you still need to know its position in the source list of course. But for short list's that represent a limited number of options , in my case all the properties for blocks and all properties for attributes I want to retain when redefining a block like color , layer , rotation, scale ... stuf like that you know, this app works just fine. Had a one listbox version up and running for some time , but now I needed 2 listboxes , so I thought , why not 3 or 4 or more.

 

App I'm working on at the moment is a sort of light version of my RlxBlk program which can replace one block for another with total control of which blocks are selected and what props are copied or changed and even visibility control and cross linked attributes and objectdbx for processing an entire folder, hell , even the entire network haha. But its a relatively complicated app and it only does one block at the time.

 

So decided to make another , friendlier app,  to be able to redefine / sync multiple blocks for multiple files , all open documents or a folder , also do all layouts so both model and paperspace. But  I wont give it the abillity to cross link attributes because such al list would be monstrous. I am allmost finished were it not for the fact that I'm never finished cause when I've finished one option I'm always already thinking about the next.

Edited May 16, 2020 by rlx

[BIGAL]

Using the toggles I end up with (1 0 0 1 …) the toggle setting on/off, its interesting to how I could reflect that in as you say multiple columns, it may be knowing length of lists so make 1 great big list from every key so it would be like (10 7 6) = animals breakfast music 

 

; maybe change the length ahbutlst to total of all lists
(defun mkv_lst ( / )
(setq v_lst '())
(setq x 1)
(repeat (- (length ahbutlst) 1)
(setq val (strcat "Tb" (rtos x 2 0)))
(setq v_lst (cons (get_tile val) v_lst))
(setq x (+ x 1))
)
)

(action_tile "accept" "(mkv_lst)(done_dialog)")

 

[rlx]

yeah I understand where you're going with the (1 0 0 1 ...) , for a moment considered going that path to , but then you would still need to link the zero's and one's to whatever they represent so dicided to input "a,b,c,d" and function returns "a,d" and this I can write directly to registry and use again for next time I start app. Not saying one way is better than another , just a choise, sticking with it and see if it works...

 

well, its late (early actually) , so in a few hours the sun will come up so time for me to hit the wife , oh , sorry , I meant , hit the sack

[BIGAL]

I thought post was here but was at forums/Autodesk should help do what they are after.

 

https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/inserting-text-into-an-existing-table-with-autolisp/m-p/9515848/highlight/false#M399798

[rlx]

Quote

 

I can show you how other app looks , but that's not finished yet (if ever) so will get back to that later

 



 

 

 

Promised to come back to this later... well, later is now... i have NOT field tested this , not enough hours in a day. This routine was never meant to have much practical use , just a test how to be able to redefine blocks under different situations , using Lisp/Objectdbx , script or using core console (single & multiple). The 'Lisp/Objectdbx' mode works by first renaming the block in the target drawing(s) , then insert the new one on top, do some identity theft (copy propies from old block) and finally delete the old block. Was hoping I would be finished here but sometimes can be a bit slow. So I decided to also try the old school way by using -insert myblock=c:\temp\myblock.dwg. Very boring so decided to have the option to use a standard script , use core console script single mode (.bat file) and multi culti core console (multiple cores at the same time). This works by first wblocking all selected blocks in source document to a temporal wblock folder and insert/redefine them from there.

 

Don't think I will be using this routine much ... just wrote this to fill a few idle hours between projects. Oh , allmost forgot , not sure the [match] button works as intended because as I said earlier , untested because so far haven't got to it. Visibility for example doesn't work yet. Also , even if it works , this only works when routine is running in Lisp/objectdbx mode obviously (duh) because all the other modes uses script and -insert command. The wb-all button wblocks a complete folder. Got a load of drawings one day from a vendor and wanted to wblock all blocks from all drawings from all (sub)folders to a special wblock folder so I would have a library of all used blocks.

 

And yes I know about AutoCad built in design center but that's not what this routine is all about.

 

So maybe someone says , thanx , nice , can use this (assuming it works) and else ... you can thrashcan...yes you can

 

 

 

RlxBlockSyncTest.zip

 

 

RlxBlockSync.lsp

Edited October 16, 2020 by rlx
added copy dynamic props like visibility and distance but still a work in progress

[mhupp]

Hope some day ill be on your level rlx. you helped me out a few months back with a lisp + dcl file to check for spread sheets and compared to this is child's play. went another direction with that lisp using the getfiled that allowed me to navigate folders.

;;----------------------------------------------------------------------;;
;; Open Existing Change Log or Copies Template Log to Folder
(defun C:CLOG (/ path fn fp fs r)
  (vl-load-com)
  (setq path (strcat (getvar 'DWGPREFIX) "\\Select Change Log or Hit Save to Import"))
  (setq fp (getfiled "Change Log:" path "" 33))
  (if (= fp nil)
    (progn
      (prompt "Change Log Cancled")
      (quit)
    )
  )
  (setq r (vl-string-search ".xls" fp))
  (if (/= r nil)
    (LM:Open fp)
    (progn
      (setq path (vl-filename-directory fp))
      (setq fn (vl-filename-base (getvar 'dwgname)))
      (setq fs (strcat (getenv "userprofile") "\\folder\\Template.xlsx"))
      (vl-file-copy fs (strcat path "\\Change Log - " fn ".xlsx"))
      (setq fp (strcat path "\\Change Log - " fn ".xlsx"))
      (LM:Open fp)
    )
  )
  (princ)
)

unfortunately I was falsely flagged for spam that locked me out from posting and deleted all my posts.  I need to use that make temp dcl command that was in your lisp. If you have that lying around mind posting that here?

[rlx]

you mean this ol' thing?

mhupp.lsp

[mhupp]

that`s it you da ma....Dragon.

[rlx]

Glad to be able to help you out mhupp. Also uploaded newer version of blocksync but its still a work in progress.