Welcome on Cadtutor Dilan
quickly copied and pasted something together , just for fun and barely tested. But for file operations beautiful tools like Total Commander etc. exists.
Code:
; http://www.cadtutor.net/forum/showth...uter-using-Lsp
; written by RLX for Dilan 9 jan 2018
(defun c:Delete_Dilan ( / folder extension file file-list )
(vl-load-com)
(if (and (setq extension "*.txt" folder (GetFolder "Select folder with txt files"))
(vl-consp (setq file-list (vl-directory-files folder extension 1)))
(vl-consp (setq file-list (Tokkie folder extension file-list file-list)))
(vl-consp (setq file-list (mapcar '(lambda (x)(strcat folder "\\" x)) file-list))))
(foreach file file-list (vl-file-delete file))
)
(princ)
)
; test (setq fldr (GetFolder "Who , what , Where?"))
(defun GetFolder ( msg / sh objFolder objParentFolder strPath)
(setq sh (vla-getInterfaceObject (vlax-get-acad-object) "Shell.Application" ))
(setq objFolder (vlax-invoke sh 'BrowseForFolder 0 msg 0 ""))
(if objFolder
(and
(setq strTitle (vlax-get objFolder "Title"))
(setq objParentFolder (vlax-get objFolder 'ParentFolder))
(setq strPath (vlax-get (vlax-invoke objParentFolder "Parsename" strTitle) "Path"))
(vlax-release-object objParentFolder)
(vlax-release-object objFolder))
(vlax-release-object sh)
)
strPath
)
(defun pimp_list ( %lst / i imax slim)
; stringlimit (emperical), uppercase is bigger , but so are many M's or W's
(if (= #RlxBatch-ShowUpperCaseNames "1") (setq slim 82)(setq slim 95))
(if (or (void RlxBatch-UseTempProjectList) (= RlxBatch-UseTempProjectList "0"))
(progn
(setq i 0 imax (strlen (itoa (length %lst))))
(mapcar '(lambda (x) (setq i (1+ i)) (strcat (fixitoa i imax) " - " (limitstring x slim))) %lst)
)
; this option retains number of position in (main) project list for item in sub project list
(progn
(setq imax (strlen (itoa (length RlxBatch-ProjectList))))
(mapcar
'(lambda (x) (strcat (fixitoa (1+ (vl-position (strcase x t) RlxBatch-ProjectList)) imax) " - " (limitstring x slim)))
%lst
)
)
)
)
; s = string , n = max string length
(defun limitstring ( s n / l)
(setq l (strlen s)) (if (> l n) (strcat (substr s 1 (- (/ n 2) 7 )) " . . . " (substr s (- l (/ n 2)))) (strcat s "")))
;check if item is nil of empty string (5 spaces deep)
(defun void (x) (if (member x (list "" " " " " " " " " " " nil '())) t nil))
; make sure itoa has fixed length , i.e. (fixitoa 1 3) -> "001"
(defun fixitoa ( #i #n / s ) (setq s (itoa #i))(while (> #n (strlen s))(setq s (strcat "0" s))) s)
;--- Tokkie ------------------------------------------------------Tokkie ------------------------------------------------------- Tokkie ---
; alternative for listbox multiple selection, a lot of trouble (and not necessarily better) , just different
; $txt1 & 2 = header text 1 & 2 , %lst% list of strings, %plist = pre-selected list of strings (if any)
; (Tokkie "Block1" "Attributes for visibility2" '("a1" "a2" "a3") '("a2"))
; this means toggle for "a1" & "a3" are "0" (off) and "a2" is on ("1")
; if previous list is empty all toggles will have default "0" (this differs from my original smartlist routines)
; also different is pretty-list , designed to limit string length of members in the list
(defun Tokkie ( $txt1 $txt2 %lst %plist / err fn fp dcl nof-tog cur-tog pretty-list tokkie-list slider-index return)
(Tokkie_Init)
(Tokkie_Dialog)
(Tokkie_Exit)
(terpri)
(reverse return)
)
(defun Tokkie_Init ()
;(setq err *error* *error* Tokkie_err)
(cond
((not (setq fn (vl-filename-mktemp "Tokkie.dcl"))))
((not (setq fp (open fn "w"))))
((null %lst))
; tokkie-list keeps toggle value (default "1") for each member in %lst
(t (setq nof-tog (length %lst) pretty-list (pimp_list %lst)))
)
; tokkie list holds default for toggles - (chr 49) = "1" , (chr 48) = "0"
(if (and (not (null %lst)) (not (null %plist)))
; if item is found in both argument lists , set toggle on ("1") else off ("0")
(setq tokkie-list (mapcar '(lambda (x)(if (member x %plist)(chr 49)(chr 48))) %lst))
; if empty or no preset list was provided all tokkies are off
(setq tokkie-list (mapcar '(lambda (x) (chr 48)) %lst)))
(if (null %lst)
(progn (alert "Nothing to show")(Tokkie_Exit))
(progn
(Tokkie_write_header)
(if (<= nof-tog 10)(Tokkie_write_body1 pretty-list)(Tokkie_write_body2 pretty-list))
(Tokkie_write_footer)
)
)
(if fp (close fp))(gc)
(setq slider-index 0)
)
(defun Tokkie_err (s) (princ s)(Tokkie_Exit)(princ))
(defun Tokkie_Exit ()
;|(setq *error* err)|; (if fp (close fp)) (if dcl (unload_dialog dcl))(if (and fn (findfile fn))(vl-file-delete fn)))
(defun Tokkie_write_header ()
(write-line
(strcat
"Tokkie:dialog{label=\"Tokkie - Rlx(2017)\";spacer;spacer;"
":text_part {key=\"txt1\";width=100;fixed_width=true;}"
":text_part{key=\"txt2\";width=100;fixed_width=true;}spacer;") fp))
(defun Tokkie_write_body1 ( %l / i )
(write-line ":boxed_column{" fp)
(setq i 0)
(mapcar '(lambda (x)
(write-line
(strcat
":row{spacer;:toggle{key=\"tg" (itoa i) "\";width=2;fixed_width=true;}"
":text_part{key=\"tp" (itoa i) "\";label=\"" x "\";width=100;fixed_width=true;}}") fp)
(setq i (1+ i)))
%l
)
(repeat (- 10 i)(write-line ":row{height=1.5;}" fp))
(write-line "}spacer;" fp)
)
(defun Tokkie_write_body2 ( %l / i )
(write-line ":boxed_row {:column{" fp)
(setq i 0)
(repeat 10
(write-line
(strcat
":row { spacer; :toggle { key =\"tg" (itoa i) "\";width=2;fixed_width=true;}"
":text_part{key=\"tp" (itoa i) "\";label=\"" (nth i %l) "\";width=100;fixed_width=true;}}") fp)
(setq i (1+ i))
)
(write-line
(strcat "}:column{:slider{key=\"sldr\";layout=vertical;min_value="(itoa (- 0 nof-tog)) ";max_value=0"
";small_increment=1;big_increment=10;value=0;}}}spacer;") fp)
)
(defun Tokkie_write_footer ()
(write-line
(strcat
"spacer;"
": row {: button{label=\"Select All\";key=\"all\";}:button{label=\"Select None\";key=\"none\";}}"
"spacer;ok_cancel;}") fp))
(defun Tokkie_Dialog ( / n drv inp)
(if (and (setq n 0 dcl (load_dialog fn)) (new_dialog "Tokkie" dcl))
(progn
(Tokkie_DialogUpdate)
(Tokkie_DialogActions)
(setq drv (start_dialog))
(if (= drv 1)
(mapcar '(lambda (x y) (if (= x "1")(setq return (cons y return)))) tokkie-list %lst)
(setq return nil))
)
)
)
(defun Tokkie_DialogUpdate ( / i )
(if (= (type $txt1) 'STR)(set_tile "txt1" $txt1))
(if (= (type $txt2) 'STR)(set_tile "txt2" $txt2))
(set_tile "sldr" (itoa slider-index))
(update_tokkies)
)
(defun Tokkie_DialogActions ()
(repeat 10 (action_tile (strcat "tg" (itoa n)) (strcat "(toggle_me $value " (itoa n) ")" ))(setq n (1+ n)))
(action_tile "sldr" "(update_slider $value)")
(action_tile "all" "(Tokkie_SelectAll)")
(action_tile "none" "(Tokkie_SelectNone)")
(action_tile "ok" "(done_dialog 1)")
(action_tile "cancel" "(done_dialog 0)")
)
(defun update_slider ( #i ) (setq slider-index (atoi #i)) (Tokkie_DialogUpdate))
(defun update_tokkies (/ tokkie-index tokkie-name i)
;max number of toggles in dialog is 10
(if (> (abs slider-index) (- nof-tog 10))
(setq tokkie-index (- nof-tog 10))(setq tokkie-index (abs slider-index)))
(if (< tokkie-index 0)(setq tokkie-index 0))
(setq i 0)
(while (and (< i 10) (setq tokkie-name (nth tokkie-index pretty-list)))
(set_tile (strcat "tp" (itoa i)) tokkie-name)
(set_tile (strcat "tg" (itoa i)) (nth tokkie-index tokkie-list))
(setq i (1+ i) tokkie-index (1+ tokkie-index))
)
)
(defun toggle_me ( $v #i / idx )
(if (> (abs slider-index) (- nof-tog 10))(setq idx (- nof-tog 10))(setq idx (abs slider-index)))
(setq tokkie-list (nthSubst (+ #i (if (< idx 0) 0 idx)) $v tokkie-list))
)
(defun Tokkie_SelectAll ();reset all toggles to "1"
;(setq tokkie-list (mapcar '(lambda (x) (chr 49)) %lst))(Tokkie_DialogUpdate))
(setq tokkie-list (mapcar '(lambda (x) (chr 49)) pretty-list))(Tokkie_DialogUpdate))
(defun Tokkie_SelectNone ();reset all toggles to "0"
;(setq tokkie-list (mapcar '(lambda (x) (chr 48)) %lst))(Tokkie_DialogUpdate))
(setq tokkie-list (mapcar '(lambda (x) (chr 48)) pretty-list))(Tokkie_DialogUpdate))
(defun nthSubst (i x l / n) (setq n -1)(mapcar '(lambda (y) (if (eq i (setq n (1+ n))) x y )) l ))
;--- Tokkie ------------------------------------------------------Tokkie ------------------------------------------------------- Tokkie ---
(c:Delete_Dilan)
gr. Rlx
ps.pps. edited code to include subfuction limitstring, fixitoa & void , part of my lib with little subfunctions so I forgot it the first time , just noticed it after I posted
Bookmarks