Leaderboard

;;; QSS - Quick String Search Rlx 5/'26 ;;; Just a basic string search engine, primarily meant for text based files like lsp & txt files + dwg files (dbx) ;;; Some files are read as stream so maybe it also works for other file types ... bucketlist material. ;;; On my home computer text search in total commander stopt working so decided to do it myself. ;;; Also Total commander was removed from my work computer. I allready lispify some other ;;; Total Commander functions like copy, move & rename but those live in my batch program. ;;; Main use for me is sometimes I remember making a lisp but not remembering how I named it or where I saved it. ;;; At moment of writing this app is still in beta. (defun C:QSS ( / ;;; globals OldErr regkey regvar sysvar-names sysvar-old-values total-file-list hit-list qss-open-dwg-on-your-way-out fn ;;; object dbx / RegExp actApp actDoc actDocs actLay actDbx AllOpen RegExp ;;; registry QSS-Search-Folder ;;; String - Folder where lisp files are placed QSS-Include-Subfolders ;;; Toggle - "0" scan only search folder, "1" also scan subfolders QSS-Filename-Extension-Filter ;;; String - delimited by , like "lsp,txt" QSS-Search-String-Filter ;;; String - delimited by | like "Rlx|Dragon" QSS-Case-Sensitive ;;; Toggle - "0" don't care, "1" case sensitive search QSS-Whole-Words-Only ;;; Toggle - "0" find every part, "1" only find whole words ;;; dialog QSS-Main-Dialog-fn QSS-Main-Dialog-fp QSS-Main-Dialog-id MainDialog-tl MainDialog-rd ) (QSS_init) (QSS_exit) (if (and qss-open-dwg-on-your-way-out (setq fn (findfile qss-open-dwg-on-your-way-out)))(_ShellOpen fn)) ) ;--- Init ------------------------------------------------- Begin Init Section --------------------------------------------------- Init --- (defun QSS_Init () ; initialize error handling (setq OldErr *error* *error* QSS_Err) ; backup & set system variables (not realy used here, just added for template purposes) (setq sysvar-names (list (cons 'cmdecho 0)) sysvar-old-values (mapcar '(lambda (x)(getvar (car x))) sysvar-names)) (mapcar '(lambda (x)(setvar (car x) (cdr x))) sysvar-names) ;;; init registry variables (InitDefaultRegistrySettings)(ReadSettingsFromRegistry) ;;; lets go girls (QSS_Main_Dialog_Start) ) (defun QSS_Err ($s) (princ $s)(QSS_Exit)(setq *error* OldErr)(princ)) (defun QSS_Exit () ; cleanup dialog(s) (I use list for future use in case of more dialogs) (mapcar '(lambda (x) (if (not (null x)) (unload_dialog x))) (list QSS-Main-Dialog-fn)) (mapcar '(lambda (x) (if (not (null x)) (close x))) (list QSS-Main-Dialog-fp)) (mapcar '(lambda (x) (if (and (not (null x)) (findfile x)) (vl-file-delete x))) (list QSS-Main-Dialog-fn)) ; reset system variables (not realy used here just for future / template purposes) (mapcar '(lambda (x y)(setvar (car x) y)) sysvar-names sysvar-old-values) (term_dialog) (gc) (princ "\nDone") (terpri) (princ) ; release actDbx & RegExp (foreach obj (list actDbx RegExp) (vl-catch-all-apply 'vlax-release-object (list obj))) ) ;;; ------------------------------------------------------ End of Init Section ------------------------------------------------------------ ;;; --- Registry Settings ------------------------------- Begin Registry Settings ------------------------------- Registry Settings --- ;;; (defun InitDefaultRegistrySettings () (setq regkey "HKEY_CURRENT_USER\\SOFTWARE\\QSS\\") ;;; regkeys must be strings ("variable name" "default value") (setq regvar (list '("QSS-Search-Folder" "") ;;; String - Folder where lisp files are placed '("QSS-Include-Subfolders" "0") ;;; Toggle - "0" scan only search folder, "1" also scan subfolders '("QSS-Filename-Extension-Filter" "lsp,txt,dwg") ;;; String - delimited by , (comma) like "lsp,dwg" '("QSS-Search-String-Filter" "") ;;; String - delimited by | (Pipe) like "Rlx|Dragon" '("QSS-Case-Sensitive" "0") ;;; Toggle - "0" don't care, "1" case sensitive search '("QSS-Whole-Words-Only" "0") ;;; Toggle - "0" nope , "1" jip ) ) (mapcar '(lambda (x)(set (read (car x)) (cadr x))) regVar) ) (defun ReadSettingsFromRegistry () (mapcar '(lambda (x / n v) (if (setq v (vl-registry-read regkey (setq n (car x)))) (set (read n) v) (vl-registry-write regkey n (cadr x)))) regvar)) (defun WriteSettingsToRegistry () (mapcar '(lambda (x) (vl-registry-write regkey (car x) (eval (read (car x))))) regvar)) ;;; --- Registry Settings -------------------------------- End Registry Settings -------------------------------- Registry Settings --- ;;; ;;; --- dialog section ----------------------------------- begin dialog section ------------------------------------ dialog section --- ;;; ; SaveDialogData evaluates all vars from %tl and returns them as a list, reset does the opposite (defun Save_Dialog_Data (%tl) (mapcar '(lambda (x) (eval (car x))) %tl)) (defun Reset_Dialog_Data (%tl %rd) (mapcar '(lambda (x y) (set (car x) y)) %tl %rd)) (defun Set_Dialog_Tiles (%tl) (mapcar '(lambda (x / v) (if (eq 'str (type (setq v (eval (car x))))) (set_tile (cadr x) v))) %tl)) (defun Main_Dialog_Cancel () (Reset_Dialog_Data MainDialog-tl MainDialog-rd) (WriteSettingsToRegistry)) (defun QSS_Main_Dialog_Create () (if (and (setq main-dialog-fn (vl-filename-mktemp "Main.dcl")) (setq main-dialog-fp (open main-dialog-fn "w"))) (mapcar '(lambda (x)(write-line x main-dialog-fp)) (list "QSS : dialog {label=\"QSS - Quick String Search (RLX May 2026)\";" ":boxed_column {label=\"Search folder :\";" ":row {:edit_box {key=\"eb_search_folder\";}" ":button {fixed_width=true;width=12;key=\"bt_select_search_folder\";label=\"Select\";}}" ":toggle {label=\"Include subfolders\";key=\"tg_include_subfolders\";}}" ":boxed_row {label=\"Filename Extension Filter [ , ]\"; :edit_box {key=\"eb_filename_extension_filter\";}}" ":boxed_column {label=\"Search string filter [ | ]\";" ":edit_box {key=\"eb_search_string_filter\";}" ":row {:toggle {label=\"Case sensitive\";key=\"tg_case_sensitive\";}" " :toggle {label=\"Whole words only\";key=\"tg_whole_words_only\";}}}" "spacer;" ":concatenation {gap; :image {height=1.5;width=91;key=\"the_bar\";color=dialog_background;}gap;}" "spacer;ok_cancel;spacer;" "}" "gap:image {fixed_width=true;width=0.001;color=dialog_background;}" ) ) ) (if main-dialog-fp (close main-dialog-fp))(gc) ) (defun QSS_Main_Dialog_Start ( / drv ) (if (null main-dialog-fn)(QSS_Main_Dialog_Create)) (if (and (setq main-dialog-dcl (load_dialog main-dialog-fn)) (new_dialog "QSS" main-dialog-dcl)) (progn (QSS_Main_Dialog_Update) (QSS_Main_Dialog_Action) (setq drv (start_dialog)) (cond ((= drv 0)(Main_Dialog_Cancel)) ((= drv 1)(WriteSettingsToRegistry)(QSS_DoIt)) ((= drv 2)(WriteSettingsToRegistry)(Show_Hit_List)) ) ) ) (if main-dialog-fn (vl-file-delete main-dialog-fn)) (setq main-dialog-fn nil) ) (defun QSS_Main_Dialog_Update () (setq MainDialog-tl '((QSS-Search-Folder "eb_search_folder") (QSS-Include-Subfolders "tg_include_subfolders") (QSS-Filename-Extension-Filter "eb_filename_extension_filter") (QSS-Search-String-Filter "eb_search_string_filter") (QSS-Case-Sensitive "tg_case_sensitive") (QSS-Whole-Words-Only "tg_whole_words_only") ) ) ;;; rd = reset data (val1 val2 ...) , in case of a cancel store original values before start of dialog (if (null MainDialog-rd) (setq MainDialog-rd (Save_Dialog_Data MainDialog-tl))) ;;; set edit boxes and toggle values (Set_Dialog_Tiles MainDialog-tl) ) (defun QSS_Main_Dialog_Action () (mapcar '(lambda (x)(action_tile (car x) (cadr x))) '(("cancel" "(done_dialog 0)") ;("accept" "(done_dialog 1)") ("accept" "(QSS_Pre_Scan)") ("eb_search_folder" "(setq QSS-Search-Folder $value)") ("bt_select_search_folder" "(QSS_select_search_folder)") ("tg_include_subfolders" "(setq QSS-Include-Subfolders $value)") ("eb_filename_extension_filter" "(setq QSS-Filename-Extension-Filter $value)") ("eb_search_string_filter" "(setq QSS-Search-String-Filter $value)") ("tg_case_sensitive" "(setq QSS-Case-Sensitive $value)") ("tg_whole_words_only" "(setq QSS-Whole-Words-Only $value)") ) ) ) (defun QSS_select_search_folder ( / f) (if (setq f (GetShellFolder "Select search folder"))(set_tile "eb_search_folder" (setq QSS-Search-Folder f)))) ;;; first handle the file & folder stuf side of things (defun QSS_Pre_Scan ( / subfolder-flag case-flag filename-extension-filter-list search-string-filter-list folder-list tmp-l) ;;; make sure include subfolders and case-sensitive flags are either T or nil (if (not (eq QSS-Include-Subfolders "1")) (setq subfolder-flag nil) (setq subfolder-flag T)) (if (not (eq QSS-Case-Sensitive "1")) (setq case-flag nil) (setq case-flag T)) ;;; check all parameters (cond ;;; verify search folder ((not (folder-p QSS-Search-Folder)) (alert (strcat "Invalid search folder : " (vl-princ-to-string QSS-Search-Folder)))) ;;; verify filename filter (like "lsp,dwg") -> pimpext -> ("*.lsp" "*.dwg") ((or (void QSS-Filename-Extension-Filter) (not (vl-consp (setq tmp-l (SplitStr QSS-Filename-Extension-Filter ",")))) (not (vl-every '(lambda (s) (wcmatch s "*`.*")) (setq filename-extension-filter-list (pimpex tmp-l))))) (alert (strcat "Bad filename filter : " (vl-princ-to-string QSS-Filename-Extension-Filter)))) ;;; verify search string filter ((or (void QSS-Search-String-Filter) (not (vl-consp (setq search-string-filter-list (SplitStr QSS-Search-String-Filter "|"))))) (alert (strcat "Invalid search string : " (vl-princ-to-string QSS-Search-String-Filter)))) ;;; maybe do file list check here (t ;;; show something wonderfull is about to happen (clear_bar)(set_tile "the_bar" " working...") (if (eq QSS-Include-Subfolders "1") (setq folder-list (QSS_FindSubfolders QSS-Search-Folder)) (setq folder-list (list QSS-Search-Folder))) ;;; just a little delay to enjoy the view, exterminate when it gets anoying (wait 1.5) (setq total-file-list (QSS_FindFiles folder-list filename-extension-filter-list)) (wait 1.5) (if (not (vl-consp total-file-list)) (alert (strcat "no files found :\nFolder : " (vl-princ-to-string QSS-Search-Folder) "\nFilter : " (vl-princ-to-string filename-extension-filter-list))) (QSS_Process_Total_File_List) ) );;; end t );;; end cond );;; end defun ;;; clear previous status (defun clear_bar () (start_image "the_bar")(fill_image 0 0 (dimx_tile "the_bar") (dimy_tile "the_bar") 141)(end_image)) (defun Show_Hit_List () (if (vl-consp hit-list) (dplm+ hit-list (strcat "Number of files found : " (itoa (length hit-list)))) (alert "Sorry search returned no results"))) (defun QSS_Process_Total_File_List ( / stream pattern file-count n l hit) (set_tile "the_bar" (strcat "Number of files to search : " (setq n (itoa (length total-file-list))))) (setq file-count 0 pattern QSS-Search-String-Filter) (if (eq QSS-Case-Sensitive "1")(setq ignoreCase nil)(setq ignoreCase T)) (foreach fn total-file-list ;;; split here for different types of extensions ;;; lisp & text files can be read by stream , dwg by odbx ;;; (strcase (last (fnsplitl "c:\\temp\lisp\acad.dwg")) t) -> ".dwg" (setq ext (strcase (last (fnsplitl fn)) t)) ;;; for now only *.lsp, *.txt & *.dwg, ;;; bucketlist xls/xlsx & pdf but they may need different approach or 3rd party software, so low priority (cond ((wcmatch ext "*`.lsp,*`.txt") (if (and (setq stream (_ReadStream fn 0)) (setq rtn (= (vlax-invoke (InitRegExp pattern ignoreCase nil) 'Test stream) -1)) (not (member fn hit-list))) (setq hit-list (cons fn hit-list)))) ;;; regex_string_search last parameter is for return as list ;;; if T -> return all strings in doc as list, if nil -> return nil or filename if pattern is found ((wcmatch ext "*`.dwg") (if (and (setq dbx-doc (odbx_open fn)) (setq hit (regex_string_search dbx-doc pattern nil))) (setq hit-list (cons fn hit-list)))) ) ;;; length of hit-list (setq l (itoa (length hit-list))) ;;; clear previous status (clear_bar) ;;; update status message (set_tile "the_bar" (strcat " ( " (setq *spin* (Spinbar *spin*)) " ) Scanning files [" (itoa file-count) " of " n "] - found " l)) ;;; increase file counter (setq file-count (1+ file-count)) ) (done_dialog 2) ) ;;; --- dialog section ------------------------------------ end dialog section ------------------------------------- dialog section --- ;;; ;--- + + + --------------------------------------------- Begin of tiny lisp section --------------------------------------------- + + + --- (defun void (x) (or (not x) (= "" x) (and (eq 'STR (type x)) (not (vl-remove 32 (vl-string->list x)))))) (defun wait (sec / stop)(setq stop (+ (getvar "DATE") (/ sec 86400.0)))(while (> stop (getvar "DATE")))) (defun string-p (s) (if (= (type s) 'str) t nil)) (defun folder-p (f) (if (and (= (type f) 'str) (vl-file-directory-p f)) t nil)) ;;; (Dos_Path (strcat (getvar "dwgprefix") (getvar "dwgname"))) -> "C:\\USERS\\ROB\\DOCUMENTS\\ACAD\\QUICKSTRINGSEARCH.DWG\\" (defun Dos_Path ($p) (if (= (type $p) 'STR) (strcase (strcat (vl-string-right-trim "\\" (vl-string-translate "/" "\\" $p)) "\\")) "")) ;;; (vl_path (strcat (getvar "dwgprefix") (getvar "dwgname"))) -> "c:/users/rob/documents/acad/quickstringsearch.dwg/" (defun vl_path ($p)(if (= (type $p) 'str) (strcat (vl-string-right-trim "\\/" (strcase (vl-string-translate "\\" "/" $p) t)) "/") "")) ; generic getfolder routine with possibility to create a new subfolder (GetShellFolder "select path") (defun GetShellFolder ( m / f s) (if (and (setq s (vlax-create-object "Shell.Application")) (setq f (vlax-invoke s 'browseforfolder 0 m 0 "")))(setq f (vlax-get-property (vlax-get-property f 'self) 'path)) (setq f nil))(vl-catch-all-apply 'vlax-release-object (list s)) (if f (strcat (vl-string-right-trim "\\" (vl-string-translate "/" "\\" f)) "\\"))) ; returns T if no errors occurred during program execution (defun _ShellOpen ( $f / it sh ) (if (and (not (void $f)) (setq $f (findfile $f)) (setq sh (vla-getInterfaceObject (vlax-get-acad-object) "Shell.Application"))) (progn (setq it (vl-catch-all-apply 'vlax-invoke (list sh 'open $f)))(vlax-release-object sh)(not (vl-catch-all-error-p it))) (progn (prompt "\nShell application was unable to open file")(setq it nil)))) ;;; d = directory , e = extension like "*.dwg" , f = flag include subfolders (any value or nil) ;;; test : (length (alf "d:/temp/lisp" "*.dwg" t)) (length (alf "d:/temp/lisp" "*.dwg" nil)) ;;; (setq l (alf "c:/temp/lisp" "*.xlsx" t)) (setq l (alf "c:\\temp\\lisp\\" "*.txt" t)) (defun alf (d e f) (setq d (vl-string-right-trim "/" (vl-string-translate "\\" "/" d))) (if f (apply 'append (cons (if (vl-directory-files d e)(mapcar '(lambda (x) (strcat d "/" x)) (vl-directory-files d e))) (mapcar '(lambda (x) (alf (strcat d "/" x) e f))(vl-remove ".." (vl-remove "." (vl-directory-files d nil -1)))))) (mapcar '(lambda (x) (strcat d "/" x))(vl-directory-files d e 1)))) ;;; (SplitStr "a,b,c" ",") -> ("a" "b" "c") (defun SplitStr (s d / p) (if (setq p (vl-string-search d s))(cons (substr s 1 p)(SplitStr (substr s (+ p 1 (strlen d))) d))(list s))) ;;; (lst->csv '("a" "b" "c") "|") -> "a|b|c" (defun lst->csv (%l $s) (apply 'strcat (cdr (apply 'append (mapcar (function (lambda (x) (list $s x))) %l))))) ;;; (sandwich '("a" "b" "c") "*") -> '("*a*" "*b*" "*c*") ;;; for whole word search each string in regex string has to begin and end with \\b (defun sandwich (%l %c) (mapcar '(lambda (s)(strcat %c s %c)) %l)) ;;; make sure each extension begin with *. (pimpex (splitstr "lsp,dwg" ",")) -> ("*.lsp" "*.dwg") (defun pimpex (%l) (mapcar '(lambda (s)(strcat "*." (vl-string-trim "*." s))) %l)) ; choose from list (cfl '("1" "2" "3")) (defun cfl (l / f p d r) (and (setq p (open (setq f (vl-filename-mktemp ".dcl")) "w")) (princ "cfl:dialog{label=\"Choose\";:list_box{key=\"lb\";width=40;}ok_cancel;}" p) (not (setq p (close p)))(< 0 (setq d (load_dialog f)))(new_dialog "cfl" d) (progn (start_list "lb")(mapcar 'add_list l)(end_list)(action_tile "lb" "(setq r (nth (atoi $value) l))(done_dialog 1)") (action_tile "accept" "(setq r (get_tile \"lb\"))(done_dialog 1)")(action_tile "cancel" "(setq r nil)(done_dialog 0)") (start_dialog)(unload_dialog d)(vl-file-delete f))) (cond ((= r "") nil)(r r)(t nil))) ;;; display list (plus message) (defun dplm (l m / f p d w) (and (vl-consp l) (setq l (mapcar 'vl-princ-to-string l)) (setq w (+ 5 (apply 'max (mapcar 'strlen l)))) (setq p (open (setq f (vl-filename-mktemp ".dcl")) "w")) (princ (strcat "cfl:dialog{label=\"" m "\";:list_box {key=\"lb\";" "width="(itoa w)";}ok_only;}") p)(not (setq p (close p)))(< 0 (setq d (load_dialog f)))(new_dialog "cfl" d)(progn (start_list "lb") (mapcar 'add_list l)(end_list)(action_tile "accept" "(done_dialog)")(start_dialog)(unload_dialog d)(vl-file-delete f)))) ;;; possibility to load / save the list and ShellOpen selection (defun dplm+ (l m / load_list save_list open_item f p d w pick) (defun load_list ()(alert "Under construction : Load List")) (defun save_list ()(alert "Under construction : Save List")) (defun open_item ( / i f)(if (and (vl-consp l)(not (null pick))(setq i (atoi pick))(setq f (nth i l))(setq f (findfile f))) (cond ((wcmatch (strcase (last (fnsplitl f)) t) "*.dwg")(setq qss-open-dwg-on-your-way-out f)(done_dialog))(t (_ShellOpen f))))) (if (not (vl-consp l)) (setq l (list "No results")) (setq l (mapcar 'vl-princ-to-string l))) ;;; make width dialog based on longest string in list (setq w (+ 5 (apply 'max (mapcar 'strlen l)))) (setq p (open (setq f (vl-filename-mktemp ".dcl")) "w")) (write-line (strcat "cfl:dialog{label=\"" m "\";") p) (write-line (strcat ":list_box {key=\"lb\";width=" (itoa w) ";height=25;}") p) (write-line (strcat ":column {:row {fixed_width=true;alignment=centered; :button {key=\"bt_load\";label=\"Load\";}" ":button {key=\"bt_save\";label=\"Save\";} :button {key=\"bt_open\";label=\"Open\";}}}") p) (write-line "ok_only;}" p) (if p (close p)) (if (and (< 0 (setq d (load_dialog f))) (new_dialog "cfl" d)) (progn (start_list "lb")(mapcar 'add_list l)(end_list) (action_tile "accept" "(done_dialog)") (action_tile "lb" "(setq pick $value)") (action_tile "bt_load" "(load_list)") (action_tile "bt_save" "(save_list)") (action_tile "bt_open" "(open_item)") (start_dialog) (unload_dialog d) (vl-file-delete f) ) ) ) ;--- + + + ---------------------------------------------- End of tiny lisp section ---------------------------------------------- + + + --- ;;; --- Odbx ---------------------------------------------- Begin Odbx Section ----------------------------------------------- Odbx --- ;;; (defun GetAllOpenDocs () (or actApp (setq actApp (vlax-get-acad-object))) (or actDoc (setq actDoc (vla-get-ActiveDocument actApp))) (or actDocs (setq actDocs (vla-get-documents actApp))) (vlax-for doc actDocs (if (= 1 (vlax-variant-value (vla-getvariable doc "DWGTITLED"))); no nameless drawings (setq AllOpen (cons (cons (strcase (vla-get-fullname doc)) doc) AllOpen)))) ) (defun _ReleaseAll () (mapcar '(lambda(x) (if (and (= 'vla-object (type x)) (not (vlax-object-released-p x))) (vlax-release-object x))(set (quote x) nil)) (list actLay actDoc actDocs actApp actDbx))(gc)) (defun _ReleaseAll () (mapcar '(lambda(x) (if (and (= 'vla-object (type x)) (not (vlax-object-released-p x))) (vlax-release-object x))(set x nil)) (list 'doc 'actLay 'actDoc 'actDocs 'actApp 'actDbx))(gc)) (defun _InitObjectDBX ()(or actApp (setq actApp (vlax-get-acad-object))) (or actDoc (setq actDoc (vla-get-ActiveDocument actApp)))(or AllOpen (setq AllOpen (GetAllOpenDocs))) (setq actDbx (vl-catch-all-apply 'vla-getinterfaceobject (list actApp (dbx_ver)))) (if (or (null actDbx)(vl-catch-all-error-p actDbx))(progn (princ "\nObjectDbx not available")(setq actDbx nil))) actDbx ) (defun odbx_open ( $dwg / _pimp doc) (or AllOpen (GetAllOpenDocs)) (defun _pimp (s) (strcase (vl-string-trim " ;\\" (vl-string-translate "/" "\\" s)))) (cond ((or (void $dwg) (not (findfile $dwg)))(princ "\nInvalid drawing")(setq doc nil)) ((not (or actDbx (_InitObjectDBX)))(princ "\nObjectDbx not available")(setq doc nil)) ((setq doc (cdr (assoc (_pimp $dwg) AllOpen)))) ((vl-catch-all-error-p (vl-catch-all-apply 'vla-Open (list actDbx (findfile $dwg)))) (princ "\nUnable to open drawing.")(setq doc nil)) (t (setq doc actDbx))) doc ) (defun odbx_close ( %doc ) (if (and (= 'vla-object (type %doc)) (not (vlax-object-released-p %doc)))(progn (vlax-release-object %doc))(setq %doc nil))) (defun dbx_ver ( / v) (strcat "objectdbx.axdbdocument" (if (< (setq v (atoi (getvar 'acadver))) 16) "" (strcat "." (itoa v))))) ;;; little test function to find all strings (txt/att etc) in all drawings in a folder (defun c:test1 ( / actDoc actDocs actApp actDbx RegExp dbx-doc write_result show_result search-folder dwg-list rtn result-list search-pattern result-list-fn) ;;; init vl functions, odbx & regexp (vl-load-com) (_InitObjectDBX) (or RegExp (setq RegExp (vlax-create-object "VBScript.RegExp"))) (defun write_result (lst fn / fp) (cond ((not (vl-consp lst)) (alert "Computer says no : empty result list, nothing to write")) ((or (not (= (type fn) 'STR)) (not (setq fp (open fn "w")))) (alert (strcat "unable to write to : " (vl-princ-to-string fn)))) ;;; format lst : ( ("dwgname1" . ("str1" "str2" ...)) ...) (t (write-line (strcat "Scanned " (itoa (length lst)) " drawings\n") fp) (foreach item lst (write-line (car item) fp) (foreach str (cdr item) (write-line (vl-princ-to-string str) fp)) (write-line "\n--\n" fp) ) ) ) (if fp (progn (close fp)(gc)(gc))) (princ) ) (defun show_result (fn) (if (and fn (setq fn (findfile fn))) (startapp "notepad" fn) (alert (strcat "Computer says no : unable to read from : " (vl-princ-to-string fn))) ) (princ) ) (setq search-pattern "*" result-list-fn "C:\\Temp\\QuickStringSearchResult.txt") (cond ;;; hard coded for test, could be replaced with something like : ;;; ((not (or (vl-file-directory-p (setq search-folder "C:\\Temp\\Lisp\\")) ;;; (setq search-folder (getfolder "Folder for string search"))))" ;;; (alert (strcat "computer says no : invalid folder : " search-folder))) ((not (vl-file-directory-p (setq search-folder "C:\\Temp\\Lisp\\"))) (alert (strcat "Folder " search-folder " does not exist - change folder"))) ((not (vl-consp (setq dwg-list (vl-directory-files search-folder "*.dwg")))) (alert (strcat "No dwg files in " search-folder))) (t ;;; if return-as-list is T regex_string_search returns all strings else T or nil if pattern is found (setq return-as-list T) (foreach dwg dwg-list (if (setq dbx-doc (odbx_open dwg)) (if (vl-consp (setq rtn (regex_string_search dbx-doc search-pattern return-as-list))) (setq result-list (cons (cons dwg rtn) result-list))) (princ (strcat "\nUnable to open " dwg)) ) ) (_ReleaseAll) ) ) ;;; release RegExp (if (= 'vla-object (type RegExp))(vlax-release-object RegExp)) (if (vl-consp result-list) (progn (write_result result-list result-list-fn) (show_result result-list-fn)) (princ (strcat "\nNo text was found in dwg files in " (vl-princ-to-string search-folder))) ) (princ) ) ;;; doc = duh , pat = duh , ral = return as list , if T return all strings , if nil test for pattern and return nil or T (defun regex_string_search (doc pat ral / pat-p pattern ingnoreCase global blocks objName textStr atts result s tableRow tableCol) ;;; not realy needed because als called in test function (or RegExp (setq RegExp (vlax-create-object "VBScript.RegExp"))) ;;; *** still to do create regex version, not sure pat-p is working as intended ;;; test if pattern is found in list of strings (RegExp needs to be initialized) (defun pat-p (p l) (vl-some (function (lambda (s)(= (vlax-invoke-method RegExp 'Test s) :vlax-true))) l)) ;;; *** still to do : apply ignore case / whole words only to pattern ;;; alternative : (lwcmatch "M-16427" '("As built K-16886.pdf" "As built M-16427.pdf" "As built N-16260.pdf")) (defun lwcmatch ( p l / r ) (foreach x l (if (vl-string-search p x)(setq r (cons x r)))) r) ;;; (re)init regex pattern (QSS-Search-String-Filter) is something like "Fikkie|Rlx" (setq pattern QSS-Search-String-Filter global T) (if (eq QSS-Case-Sensitive "1")(setq ignoreCase nil)(setq ignoreCase T)) (InitRegExp pattern ignoreCase global) ;;; go through all document objects and retrieve textstring, return as list or test with regex (pat-p) (setq blocks (vla-get-blocks doc)) (if (/= pat "") (progn (vlax-for block blocks (vlax-for obj block (setq objName (vlax-get-property obj 'ObjectName)) (setq textStr nil) ;;; Filter objects & get textString (cond ;; Text en MText ((vl-position objName '("AcDbText" "AcDbMText")) (setq textStr (vlax-get-property obj 'TextString))) ;; Old Leaders & Dimensions ((vl-position objName '("AcDbLeader" "AcDbDimension" "AcDbRotatedDimension" "AcDbAlignedDimension")) (if (vlax-property-available-p obj 'TextOverride) (setq textStr (vlax-get-property obj 'TextOverride)))) ;; Modern MultiLeaders (MLeader) ((= objName "AcDbMLeader") (if (= (vlax-get-property obj 'ContentType) 2) ; 2 = acMTextContent (setq textStr (vlax-get-property obj 'TextString)))) ;; Block Reference with Attributes ((= objName "AcDbBlockReference") (if (= (vlax-get-property obj 'HasAttributes) :vlax-true) (progn (setq atts (vlax-invoke obj 'GetAttributes)) (foreach attObj atts (setq s (vlax-get-property attObj 'TextString)) (if (and s (/= s "")) ;(= (vlax-invoke-method RegExp 'Test pat) :vlax-true)) (progn (setq textStr (cons (strcat "Block " (vlax-get-property obj 'Name) ", Tag : " (vlax-get-property attObj 'TagString) ", Text : " s) textStr)))) ) ) ) ) ;; Tabellen (Scant elke cel afzonderlijk) ((= objName "AcDbTable") (setq tableRow 0) (while (< tableRow (vlax-get-property obj 'Rows)) (setq tableCol 0) (while (< tableCol (vlax-get-property obj 'Columns)) (setq s (vlax-invoke obj 'GetText tableRow tableCol)) (if (and s (/= s "")); (= (vlax-invoke-method regex 'Test textStr) :vlax-true)) (setq textStr (cons (strcat "Table [Row " (itoa tableRow) ", Col " (itoa tableCol) "]: " s) textStr))) (setq tableCol (1+ tableCol)) ) (setq tableRow (1+ tableRow)) ) ) ) ;;; end cond ;;; put result in list (cond ((null textStr)) ((vl-consp textStr) (foreach x textStr (setq result (cons x result)))) (t (setq result (cons textStr result))) ) ) ;;; vlax-for block ) ;;; vlax-for blocks ) ;;; end progn ) ;;; end if (/= pat "") ;;; if ral = T return all strings as list else only return T if pattern is found in result list ;;; *** still to do replace lwcmatch with regex version (pat-p) ;(if ral result (lwcmatch pat result)) (if ral result (pat-p pattern result)) ) ;;; --- Odbx ---------------------------------------------- End Odbx Section ------------------------------------------------- Odbx --- ;;; ;;; --- RegExp -------------------------------------------------- RegExp --------------------------------------------------- RegExp --- ;;; ;;; Separate multiple patterns by pipe-operator | ;;; (vlax-put-property regexp "Pattern" "Rlx|CadTutor|Visual Lisp") ;;; Whole words only (not "Rlxie" when searching for "Rlx"): ;;; (vlax-put-property regexp "Pattern" "\\bRlx\\b|\\bCadTutor\\b|\\bVisual Lisp\\b") ;;; pattern : Pattern to search. ;;; ignoreCase : If non nil, the search is done ignoring the case. ;;; global : If non nil, search all occurences of the pattern, if nil, only searches the first occurence. (defun InitRegExp (pattern ignoreCase global) (or RegExp (setq RegExp (vlax-create-object "VBScript.RegExp"))) (vlax-put RegExp 'Pattern pattern) (if ignoreCase (vlax-put RegExp 'IgnoreCase acTrue)(vlax-put RegExp 'IgnoreCase acFalse)) (if global (vlax-put RegExp 'Global acTrue)(vlax-put RegExp 'Global acFalse)) RegExp ) ;;; len : Number of bytes to read. If non numeric, < 1 or greater than the number of bytes in file everything is returned. ;;; iomode : 1 = read, 2 = write, 8 = append , format : 0 = ascii, -1 = unicode, -2 = system default (defun _ReadStream ( path len / fso file stream result ) (vl-catch-all-apply '(lambda ( / iomode format size ) (setq iomode 1 format 0 fso (vlax-create-object "Scripting.FileSystemObject") file (vlax-invoke fso 'GetFile path) stream (vlax-invoke fso 'OpenTextFile path iomode format) size (vlax-get file 'Size) len (if (and (numberp len) (< 0 len size)) (fix len) size) result (vlax-invoke stream 'read len)) (vlax-invoke stream 'Close) ) ) (if stream (vlax-release-object stream))(if file (vlax-release-object file))(if fso (vlax-release-object fso)) result ) ;;; T if pattern is found else nil (defun c:test2 ( / fn pattern stream ignoreCase rtn) (setq fn "C:\\Temp\\Lisp\\RlxBatch.lsp") (setq ignoreCase T) (setq pattern "-publish") ;(setq pattern "dragon") (and (= (type fn) 'STR) (setq fn (findfile fn)) (setq stream (_ReadStream fn 0)) (setq rtn (= (vlax-invoke (InitRegExp pattern ignoreCase nil) 'Test stream) -1)) ) rtn ) ;;; --- RegExp -------------------------------------------------- RegExp --------------------------------------------------- RegExp --- ;;; ;;; -------------------------------------------------- Begin of Progress Bar Section ------------------------------------------------------ ; (setq lst (acad_strlsort (QSS_FindSubfolders "c:/temp/lisp"))) (defun QSS_FindSubfolders ( d / l r s msg ) (setq l (list d)) (while l (setq s nil)(foreach d l (setq s (append s (mapcar (function (lambda ( x ) (strcat d "/" x))) (vl-remove-if (function (lambda (x)(member x '("." ".."))))(vl-directory-files d nil -1))))))(setq r (append s r) l s) (start_image "the_bar")(fill_image 0 0 (dimx_tile "the_bar") (dimy_tile "the_bar") 131)(end_image) (setq msg (strcat " ( " (setq *spin* (Spinbar *spin*))" ) Scanning for subfolders : " (itoa (length r)))) (set_tile "the_bar" msg) ) ;;; make sure sourcefolder is part of result (cons d r) ) ;;; (setq rtn (QSS_FindFiles '("c:/temp/lisp") '("*.lsp" "*.txt"))) (defun QSS_FindFiles (folder-list extension-list / folder result result-list status) ;;; folder-list is list of all (sub)folders to scan , make sure all folders end with "/" (setq folder-list (acad_strlsort (mapcar 'vl_path folder-list))) (foreach folder folder-list (foreach ext extension-list (if (vl-consp (setq result (mapcar '(lambda (x) (strcat folder x))(vl-directory-files folder ext 1)))) (setq result-list (append result-list result)) ) ) ;;; clear previous status (start_image "the_bar")(fill_image 0 0 (dimx_tile "the_bar") (dimy_tile "the_bar") 141)(end_image) ;;; update status message (setq status (strcat " ( " (setq *spin* (Spinbar *spin*)) " ) Scanning for files : " (itoa (length result-list)))) (set_tile "the_bar" status) ) result-list ) ; funny little indicator found in StripMtext.lsp ;(princ (strcat "\r (" (setq s (Spinbar s)) ") Files : " (itoa (setq i (1+ i))) "\t\t")) (defun SpinBar (spin) (cond ((= spin "\\") "|") ((= spin "|") "/") ((= spin "/") "-") (t "\\"))) ;;; ---------------------------------------------------- End of Progress Bar Section -------------------------------------------------- ;;; (princ "\nRlx May'26 - Type QSS for main function or test1 for test function (all text from all dwgs in c:/temp/lisp/") Most info included in lisp file. Just a quick string search for lsp, txt & dwg files. App is still in beta and hasn’t been field tested yet. Still working on the ignore case & whole word options. IT killed my Total Commander so had to write my own search engine Start with QSS , select folder , extension like lsp,dwg and search string like Rlx Type in extensions like lsp,txt (with comma) and for text use pipe symbol like Rlx|Dragon for now only lsp,txt and dwg are supported , haven't been able to make it work on pdf Result is shown in list box. You can select item and open. If item is lsp or txt , notepad will start. If item is dwg , app stops and opens dwg (load and save buttons not working yet, not sure I need them.

I meant to mention adding the (\U+200A). IIRC it's called a nonbreaking space. "Hairspace" sounds better IMO. I didn't try this, but one article mentioned to "Save As" or "Export to" PDF to kill the hyperlinks. My AutoCAD 2026 has the option to check Include Hyperlinks under PDF Options on the plot manager.

This code is so helpful to convert texts or mtexts to mleader. In the attachments the lisp file and cad file that has the problem I tied to solve. The cad file contains a huge amounts of elevations as texts and leaders that are exploded for landscape work , therefore this lisp can help with case like this Regards TBC- JOIN TEXT AND POLYLINES AND CONVERT THEM TO MLEADER OR MAKE IT MANUALLY.lsp BR FIN LVLS-1.dwg

The work flow makes the copying of the texts to attribute block so quick> Regards CONVERT TEXTS TO ATTRIBUTE WORK FLOW-COMP.mp4 GTTB-BATCH-COPY ANY NUMBER OF TEXTS TO ATTRIB BLOCKS.LSP rec2txt-placing a specific object (like a .lsp H B2 FINISHS - ATT-2.dwg

Need a link https://autolispprograms.wordpress.com/water-supply-2/

See if this program by @Tharwat is suitable for you...

I can't get your examples to show as hyperlinks in Acrobat Pro or opening with MS Edge at work. If I create a hyperlink in AutoCAD, it shows as hyperlink in Adobe Pro and MS Edge, so not being blocked by Adobe Pro or AutoCAD. See if these show as hyperlinks on your reader. PDF_Hyperlink 3.pdf PDF_Hyperlink 2.pdf PDF_Hyperlink.pdf

Is this text in a TTF font or SHX? AutoCAD exports SHX fonts to searchable comments. If you turn that off (set PDFSHX system variable to 0), maybe the links will turn off too. SLW seems to be on the right track with PDF Options, try that first.

I'll try that shortly and see if that works. PDF options didn't do much - mostly I think it is a PDF viewer thing (got into a whole word of space names yesterday, EM-space, EN-space, half EM, quarter EM... and so on depends on the website, never knew there were so many 'spaces')

I have coded a dcl as per image but I can not get the list box answer I get the radio buttons as a list which is what I want. If ran as source code the listbox lsp works fine returning the items selected as a list. I am sure it is something very simple I am doing wrong. It will also help with a possible other post to know the answer. ; Big thanks to Alan J. Thompson, 09.23.08 / 05.17.10 (rewrite) ; For the original list box Listslect.lsp ; Modified by AlanH May 2026 to also have edit boxes (defun AH:xxxxxx1 ( / anslst1 anslts2 dcl_id key_lst keynum num x y) (setq fo (open (setq fn "D:\\acadtemp\\xxxxxx.dcl") "W")) (foreach x (list "roslist_select : dialog { " "label = \"Layout choice\" ; " ": row { " ": column { " ": list_box { " "label = \"Please choose\" ;" "key = \"lst1\" ;" "allow_accept = false ; " "height = 15 ; " "width = 25 ; " "multiple_select = true ; }" "}" " : boxed_column {" (strcat " label =" (chr 34) (nth 0 lst2) (chr 34) " ;") " width =25 ;" ) (write-line x fo) ) (setq num (/ (- (length lst2) 1) 4)) (setq x 0) (setq y 0) (repeat num (write-line "spacer_1 ;" fo) (write-line ": edit_box {" fo) (setq keynum (strcat "key" (rtos (setq y (+ Y 1)) 2 0))) (write-line (strcat " key = " (chr 34) keynum (chr 34) ";") fo) (write-line (strcat " label = " (chr 34) (nth (+ x 1) lst2) (chr 34) ";") fo) (write-line (strcat " edit_width = " (rtos (nth (+ x 2) lst2) 2 0) ";") fo) (write-line (strcat " edit_limit = " (rtos (nth (+ x 3) lst2) 2 0) ";") fo) (write-line " is_enabled = true ;" fo) (write-line " allow_accept=false ;" fo) (write-line " }" fo) (setq x (+ x 4)) ) (write-line "spacer ; " fo) (write-line "ok_cancel ;" fo) (write-line "}" fo) (write-line "}" fo) (write-line "}" fo) (close fo) (setq dcl_id (load_dialog fn)) (if (not (new_dialog "roslist_select" dcl_id)) (exit) ) (start_list "lst1") (mapcar (function add_list) lst1) (end_list) (set_tile "lst1" "0") (setq x 0) (setq y 0) (setq anslst2 '()) (repeat num (setq keynum (strcat "key" (rtos (setq y (+ Y 1)) 2 0))) (setq key_lst (cons keynum key_lst)) (set_tile keynum (nth (setq x (+ x 4)) lst2)) ) ; (mode_tile "key1" 2) (action_tile "accept" "(mapcar '(lambda (x) (setq anslst2 (cons (get_tile x) anslst2))) key_lst)(done_dialog)") (action_tile "lst1" "(setq anslst1 $value)") (action_tile "cancel" "(done_dialog)") (start_dialog) (unload_dialog dcl_id) ; (vla-file-delete fn) ) (setq lst1 (cons "New layout" (layoutlist))) (setq lst2 (list "Enter values " "Date to add" 15 14 "" "Drawn by" 15 14 "" "Checked by" 15 14 "" "Approved by" 15 14 "")) (AH:xxxxxx1) (if (= anslst1 nil)(alert "anslst1 is nil")(princ anslst1)) (princ "\n") (princ anslst2) ; anslst1 holds lst1 select values ; anslst2 holds the getval values

you have no action_tile assigned to your edit_boxes key1 ... key4 also anslst1 anslts2 have been declared local in your defun so values are not exposed outside your defun ; For the original list box Listslect.lsp ; Modified by AlanH May 2026 to also have edit boxes (defun AH:xxxxxx1 ( / fo fn dcl_id key_lst keynum num x y) ;; anslst1 anslts2 ;(setq fo (open (setq fn "D:\\acadtemp\\xxxxxx.dcl") "W")) (setq fo (open (setq fn "C:\\temp\\xxxxxx.dcl") "W")) (foreach x (list "roslist_select : dialog {label=\"Layout choice\";" ": row { " " : column { " " : list_box {label=\"Please choose\";" " key=\"lst1\";allow_accept=false;height=15;width=25;ultiple_select=true;}" "}" " : boxed_column {" (strcat "label=" (chr 34) (nth 0 lst2) (chr 34) " ;") " width =25;" ) (write-line x fo) ) (setq num (/ (- (length lst2) 1) 4)) (setq x 0) (setq y 0) (repeat num (write-line "spacer_1 ;" fo) (write-line ": edit_box {" fo) (setq keynum (strcat "key" (rtos (setq y (+ Y 1)) 2 0))) (write-line (strcat " key = " (chr 34) keynum (chr 34) ";") fo) (write-line (strcat " label = " (chr 34) (nth (+ x 1) lst2) (chr 34) ";") fo) (write-line (strcat " edit_width = " (rtos (nth (+ x 2) lst2) 2 0) ";") fo) (write-line (strcat " edit_limit = " (rtos (nth (+ x 3) lst2) 2 0) ";") fo) (write-line " is_enabled = true ;" fo) (write-line " allow_accept=false ;" fo) (write-line " }" fo) (setq x (+ x 4)) ) (write-line "spacer ; " fo) (write-line "ok_cancel ;" fo) (write-line "}" fo) (write-line "}" fo) (write-line "}" fo) (close fo) (setq dcl_id (load_dialog fn)) (if (not (new_dialog "roslist_select" dcl_id))(exit)) (start_list "lst1") (mapcar (function add_list) lst1) (end_list) (set_tile "lst1" "0") (setq x 0) (setq y 0) (setq anslst2 '()) (repeat num (setq keynum (strcat "key" (rtos (setq y (+ Y 1)) 2 0))) (setq key_lst (cons keynum key_lst)) (set_tile keynum (nth (setq x (+ x 4)) lst2)) ) ; (mode_tile "key1" 2) ;(action_tile "accept" "(mapcar '(lambda (x) (setq anslst2 (cons (get_tile x) anslst2))) key_lst)(done_dialog)") (action_tile "accept" "(read_tiles key_lst)(done_dialog)") (action_tile "lst1" "(setq anslst1 $value)") (action_tile "cancel" "(done_dialog)") (start_dialog) (unload_dialog dcl_id) ; (if (setq fn (findfile fn)) (startapp "notepad" fn)) ; (vla-file-delete fn) (princ) ) ;;; end defun (defun read_tiles (key_lst) (foreach key key_lst (setq anslst2 (cons (cons key (get_tile key)) anslst2)))) ;;; hit & run (setq lst1 (cons "New layout" (layoutlist))) (setq lst2 (list "Enter values " "Date to add" 15 14 "" "Drawn by" 15 14 "" "Checked by" 15 14 "" "Approved by" 15 14 "")) (AH:xxxxxx1) (if (= anslst1 nil)(alert "anslst1 is nil")(princ anslst1)) (princ "\n") (princ anslst2) ; anslst1 holds lst1 select values ; anslst2 holds the getval values

Thanks SLW210 for looking for me, a font of all knowledge

The project specifications are limiting us to Arial font, and a set format for the text strings. It isn't a CAD issue but a PDF reader issue - and we cannot control what others use to look at files. So not a lot we can actually do with the plotting to make it behave as it should unfortunately. So many texts that start with the format qwe.rty.uio..... are seen as hyperlinks in the PDF. Our work around - for anyone following this - is to use 'hairspace' after the '.' (\U+200A) which you can see is there if you know it is there else so far works.

What reader do you use? Should be an option to turn off automatic link detection. Post a sample PDF and DWG. You may need to use brackets, parenthesis, different font, etc. for the file names, I do believe that is the way it works with the "." in the word. P.S. I just checked Adobe sight, supposedly certain fonts should make them work. Monospaced Fonts? Which ones have you tried?

Good day I would like to share this lisp for anyone need it Regards extcoord-extract_coords of anything -REV20.lsp

Yes Ai is being used more, but sometimes does not work, that's when you need lisp experience to work out what is wrong. But paste that you wrote it using AI still put your name to it. I would build a big DCL. Oops should have been 4 columns but you get the idea. Yes can use the list box instead of toggle buttons. Just pasted each option into one image as a guide to how it should look. Oh yeah if your using object point numbers then should include a function that finds the last object number used if your selecting single objects at a time.

A few comments. You have not put your name and date to code, say add at that start. You can write direct to Excel rather than opening a csv. Can help with that. You can replace the Initget with the attached. Multi radio buttons.lsp Other methods available also. Same with the "point markers" Multi toggles.lsp Also for input values strings or numbers Multi GETVALS.lsp if (not AH:Butts)(load "Multi radio buttons.lsp")) ; loads the program if not loaded already (if (= but nil)(setq but 1)) ; this is needed to set default button (setq lst (list "Please choose" "1-Pts" "2-Pl" "3-3DPl" "4-Cir" "5-Arc" "6-Blk" "7-Ln" "8-Spl" "9-FL" "10-All")) (setq ans (ah:butts but "V" lst)) All 3 options can be made into a single DCL.

;list select dialog ;create a temp DCL multi-select list dialog from provided list ;value is returned in list form, DCL file is deleted when finished ;example: (setq the_list (AT:listselect "This is my list title" "Select items to make a list" "25" "30" "true" (list "object 1" "object 2" "object 3")) ;if mytitle is longer than defined width, the width will be ignored and it will fit to title string ;if mylabel is longer than defined width, mylabel will be truncated ;myheight and mywidth must be strings, not numbers ;mymultiselect must either be "true" or "false" (true for multi, false for single) ;created by: alan thompson, 9.23.08 ;some coding borrowed from http://www.jefferypsanders.com (thanks for the DCL examples) (defun AT:ListSelect ( mytitle ;title for dialog box mylabel ;label right above list box myheight ;height of dialog box !!*MUST BE STRING*!! mywidth ;width of dialog box !!*MUST BE STRING*!! mymultiselect ;"true" for multiselect, "false" for single select mylist ;list to display in list box / retlist readlist count item savevars fn fo valuestr dcl_id ) (defun saveVars(/ readlist count item) (setq retList(list)) (setq readlist(get_tile "mylist")) (setq count 1) (while (setq item (read readlist)) (setq retlist(append retList (list (nth item myList)))) (while (and (/= " " (substr readlist count 1)) (/= "" (substr readlist count 1)) ) (setq count (1+ count)) ) (setq readlist (substr readlist count)) ) );defun (setq fn (vl-filename-mktemp "" "" ".dcl")) (setq fo (open fn "w")) (setq valuestr (strcat "value = \"" mytitle "\";")) (write-line (strcat "list_select : dialog { label = \"" mytitle "\";") fo) (write-line (strcat " : column { : row { : boxed_column { : list_box { label =\"" mylabel "\"; key = \"mylist\"; allow_accept = true; height = " myheight "; width = " mywidth "; multiple_select = " mymultiselect "; fixed_width_font = false; value = \"0\"; } } } : row { : boxed_row { : button { key = \"accept\"; label = \" Okay \"; is_default = true; } : button { key = \"cancel\"; label = \" Cancel \"; is_default = false; is_cancel = true; } } } } }") fo) (close fo) (setq dcl_id (load_dialog fn)) (new_dialog "list_select" dcl_id) (start_list "mylist" 3) (mapcar 'add_list myList) (end_list) (action_tile "cancel" "(setq ddiag 1)(done_dialog)") (action_tile "accept" "(setq ddiag 2)(saveVars)(done_dialog)") (start_dialog) (if (= ddiag 1) (setq retlist nil) ) (unload_dialog dcl_id) (vl-file-delete fn) retlist );defun