Leaderboard

;;; QSS - Quick String Search Rlx June'26 ;;; Just a basic string search engine, first 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. ;;; App can skip (error-catch) files its unable to open because they were saved with higher version. ;;; Sometimes files can be corrupt and AutoCad crashes and you would loose all search results fo far. ;;; Thats why I created shadow mode and recovery mode. ;;; Shadow mode writes a file (QSS-Shadow-List.txt) on your desktop in 'QuickStringSearch' folder where the name of each file is saved. ;;; Each line begins with <num> | status | filename. You can save this file as csv and split on pipesymbol |. ;;; Status can be 0 - corrupt , 1 - unable to open , 2 - no hit , 3 - hit (search string was found) ;;; I created this because I was searching little over one hundred thousand drawings and just before it was finished ;;; it crashed AutoCad because of a corrupt drawing. With shadow mode you can now see how far it came. ;;; To be able to get past this , I also created recovery mode. ;;; First all filenames are saved to file (QSS-Recovery-List.txt) , then this list is compared to the shadow list. ;;; With this info , app can tell which file caused the crash , sent it to my naughty list , and resume with the rest. ;;; Normal operation , no corrupt files is simple click and go. You can allways leave on Shadow mode. ;;; When however AutoCad crashed because of corrupt file , switch on recovery mode and app will be able to ;;; skip corrupt file and resume with the rest. ;;; ;;; Last update : 2026-05-18 - added eror catch for read excel values ;;; : 2026-05-30 - added Shadow Mode, save results do desktop (QSS-Shadow-Mode.txt) ;;; : 2026-06-01 - added Recovery Mode, resume search after crash & find everything (defun C:QSS ( / ;;; globals OldErr regkey regvar sysvar-names sysvar-old-values total-file-list hit-list open-at-the-end fn no-show ;;; debug / crash & recovery QSS-Program-Folder QSS-Shadow-List-fn QSS-Shadow-List-fp shadow-list QSS-Recovery-List-fn QSS-Recovery-List-fp recovery-list QSS-Naughty-List-fn QSS-Naughty-List-fp naughty-list ;;; object dbx / RegExp actApp actDoc actDocs actLay dbxObj AllOpen RegExp ;;; Excel xlApp xlWorkbooks xlWorkbook xlSheets ;;; 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-Get-Everything ;;; Toggle - Get every string form every drawwing 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 QSS-Shadow-Mode ;;; Toggle - save all search hits directly to desktop QSS-Recovery-Mode ;;; Toggle - Resume after crash and put guilty file on naughty lisy ;;; dialog QSS-Main-Dialog-fn QSS-Main-Dialog-fp QSS-Main-Dialog-id MainDialog-tl MainDialog-rd ) (QSS_init) (QSS_exit) (QSS_end_it) ) ;--- 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) ;;; for direct saving results to desktop (QSS_Init_Shadow_and_Recovery_Mode) ;;; lets go girls (QSS_Main_Dialog_Start) ) (defun QSS_Err ($s) (princ $s)(QSS_Exit)(setq *error* OldErr)(princ)) ;;; save search results also to desktop in case computer crashes during search (defun QSS_Init_Shadow_and_Recovery_Mode () (setq QSS-Program-Folder (mk_desktop_dir "QuickStringSearch")) (setq QSS-Shadow-List-fn (strcat QSS-Program-Folder "\\QSS-Shadow-List.txt")) (setq QSS-Recovery-List-fn (strcat QSS-Program-Folder "\\QSS-Recovery-List.txt")) (setq QSS-Naughty-List-fn (strcat QSS-Program-Folder "\\QSS-Naughty-List.txt")) ;;; if recovery mode is activated preload recovery-list (QSS_Check_For_Recovery_Mode) ) (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 QSS-Shadow-List-fp shadow-fp-2 QSS-Recovery-List-fp QSS-Naughty-List-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 dbxObj & RegExp (foreach obj (list dbxObj RegExp) (vl-catch-all-apply 'vlax-release-object (list obj))) ;;; release Excel (Exit_Excel) ) ;;; check for unfinished business... (defun QSS_End_it ( / fn ) ;;; in shadow mode , each search hit (filename) is saved to desktop (QSS-Shadow-List.txt) (if (and (null no-show) (= QSS-Shadow-Mode "1") (setq fn (findfile QSS-Shadow-List-fn))) (startapp "notepad" fn)) ;;; user clicked on open drawing from result list, aint gonna happen until dialog was terminated first (if (and open-at-the-end (setq fn (findfile open-at-the-end)))(_ShellOpen fn)) ) ;;; file and mode are verified in QSS_Init (defun QSS_Check_For_Recovery_Mode ( / inp l) (if (and (= QSS-Recovery-Mode "1") (findfile QSS-Recovery-List-fn) (setq QSS-Recovery-List-fp (open QSS-Recovery-List-fn "r"))) (progn (while (setq inp (read-line QSS-Recovery-List-fp)) (setq l (cons inp l)))(close QSS-Recovery-List-fp) (setq recovery-list (reverse l))))) ;;; ------------------------------------------------------ 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-Get-Everything" "0") ;;; Toggle - Get every string form every drawwing '("QSS-Case-Sensitive" "0") ;;; Toggle - "0" don't care, "1" case sensitive search '("QSS-Whole-Words-Only" "0") ;;; Toggle - "0" nope , "1" jip '("QSS-Shadow-Mode" "0") ;;; Toggle - if on save all results to desktop '("QSS-Recovery-Mode" "0") ;;; Toggle - resume after crash (corrupt file or something) ) ) (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 June 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_column {label=\"Filename Extension Filter [ , ]\";" " :row {:edit_box {key=\"eb_filename_extension_filter\";}" " :button {fixed_width=true;width=12;key=\"bt_filename_extension_filter\";label=\"Select\";}}}" ":boxed_column {label=\"Search String Filter [ | ]\";" " :concatenation {:edit_box {edit_width=80;key=\"eb_search_string_filter\";}" " :toggle {key=\"tg_everything\";label=\"Everything\";}}" " :row {:toggle {label=\"Case Sensitive\";key=\"tg_case_sensitive\";}" " :toggle {label=\"Whole Words Only\";key=\"tg_whole_words_only\";}" " :toggle {label=\"Shadow Mode\";key=\"tg_shadow_mode\";}" " :toggle {label=\"Recovery Mode\";key=\"tg_recovery_mode\";}}}" "spacer;:row {gap;:image {key=\"im_mode\";height=0.2;}gap;}spacer;" ":concatenation {gap; :image {height=1.5;width=91;key=\"the_bar\";color=dialog_background;}gap;}" ":column {:concatenation {alignment=centered;" " :bt_16 {key=\"bt_clear_lists\";label=\"Clear Lists\";} spacer;spacer; ok_cancel;}}" "spacer;spacer;" "}" "gap:image {fixed_width=true;width=0.001;color=dialog_background;}" "bt_16 :button {width=18;fixed_width=true;}" ) ) ) (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)(setq no-show T)); no-show to prevent showing shawdow-list after cancel ;;; disabled accept (ok / done dialog 1) to be able to show progress bar ;;; ok action replaced by : ("accept" "(WriteSettingsToRegistry)(QSS_Pre_Scan)") ((= drv 1)(WriteSettingsToRegistry)) ((= 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-Get-Everything "tg_everything") (QSS-Case-Sensitive "tg_case_sensitive") (QSS-Whole-Words-Only "tg_whole_words_only") (QSS-Shadow-Mode "tg_shadow_mode") (QSS-Recovery-Mode "tg_recovery_mode") ) ) ;;; 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) ;;; show mode in color (show_program_mode) ) (defun QSS_Main_Dialog_Action () (mapcar '(lambda (x)(action_tile (car x) (cadr x))) '(("cancel" "(done_dialog 0)") ;;; stay in dialog for progress bar ;;; ("accept" "(done_dialog 1)") ("accept" "(WriteSettingsToRegistry)(if (eq QSS-Get-Everything \"1\")(QSS_Get_Everything)(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)") ("bt_filename_extension_filter" "(QSS_Select_Filename_Extension_Filter)") ("eb_search_string_filter" "(setq QSS-Search-String-Filter $value)") ("tg_everything" "(setq QSS-Get-Everything $value)") ("tg_case_sensitive" "(setq QSS-Case-Sensitive $value)") ("tg_whole_words_only" "(setq QSS-Whole-Words-Only $value)") ("tg_shadow_mode" "(setq QSS-Shadow-Mode $value)(show_program_mode)") ("tg_recovery_mode" "(setq QSS-Recovery-Mode $value)(show_program_mode)") ("bt_clear_lists" "(QSS_Clear_Lists)") ) ) ) (defun show_program_mode ( / col ) (setq col (cond ((= QSS-Recovery-Mode "1") 1) ((= QSS-Shadow-Mode "1") 3)(t 7))) (start_image "im_mode") (fill_image 0 0 (dimx_tile "im_mode") (dimy_tile "im_mode") col)(end_image) ) (defun QSS_select_search_folder ( / f) (if (setq f (GetShellFolder "Select search folder"))(set_tile "eb_search_folder" (setq QSS-Search-Folder f)))) (defun QSS_Clear_Lists ( / l) (if (and (folder-p QSS-Program-Folder) (vl-consp (setq l (vl-directory-files QSS-Program-Folder "*.*" 1))) (yesno "Realy want to clear all lists in QuickStringSearch folder?")) (foreach f l (vl-file-delete (strcat QSS-Program-Folder "\\" f))))) ;;; QSS-Filename-Extension-Filter / eb_filename_extension_filter (defun QSS_Select_Filename_Extension_Filter ( / tl dl rtn) ;;; total list with (future) supported extensions (doc & pdf untested / too slow at this moment) ;;; (setq tl '("doc" "docx" "dwg" "dxf" "lsp" "pdf" "txt" "xls" "xlsx")) (setq tl '("dwg" "dxf" "lsp" "txt" "xls" "xlsx")) ;;; get current list from edit box and use as default for multiple select routine ;;; also make sure all extentions are in lowercase (setq dl (SplitStr (strcase (get_tile "eb_filename_extension_filter") t) ",")) (if (setq rtn (mfl tl dl)) (progn (set_tile "eb_filename_extension_filter" (setq QSS-Filename-Extension-Filter (strcase (commatize rtn) t))) (WriteSettingsToRegistry) ) ) ) ;;; 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 ;;; fire-up proress bar (clear_bar)(set_tile "the_bar" " working...") ;;; if recovery mode is active no need to scan again for subfolders and files (if (and (= QSS-Recovery-Mode "1") (vl-consp recovery-list)) (setq total-file-list recovery-list) ;;; at this moment either recovery mode is not activated or (pre-loaded) recovery-list is empty ;;; so we have to perform a full (sub)folder / file scan (progn (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)) ;;; [QSS_FindFiles line 747] ;;; recovery mode may be active but recovery-list is empty (if (and (= QSS-Recovery-Mode "1") (not (vl-consp recovery-list))) (QSS_Save_Recovery_List (setq recovery-list total-file-list))) ) ) ) );;; end cond ;;; determine whether to process recovery or total-file-list (if (and (= QSS-Recovery-Mode "1") (vl-consp recovery-list) (findfile QSS-Shadow-List-fn)) (QSS_Start_Recovery)) ;;; ready to proceed with total-file list (clear_bar) (if (not (vl-consp total-file-list)) (alert "No (more) files to process") (QSS_Process_Total_File_List) ) );;; end defun ;;; little explanation : Recovery list contains all filenames from original search operation (in my case 105.000) ;;; With shadow mode enabled every result is saved to a file (QSS-Shadow-Mode-fn) ;;; If AutoCad crashed because of a corrupt file , count the number of lines in shadow file, say 5000. ;;; This means that file 5001 in the Recovery list gets a seat on my naughty list and app should resume from 5002. ;;; In order to keep lists in sync file 5001 has to be added to shadow list and tagged as corrupt / unable to read ;;; (setq l1 '(0 1 2 3 4 5) l2 '(0 1 2)) -> 3 = err -> resume search from 4 (defun QSS_Start_Recovery ( / fn shadow-count ) (cond ((not (vl-consp recovery-list)) (alert "Recovery unavailable : recovery-list empty")) ((not (and (setq fn (findfile (vl-princ-to-string QSS-Shadow-List-fn))) (setq QSS-Shadow-List-fp (open fn "r")))) (alert "Recovery unavailable : recovery-list empty")) (t (setq shadow-count 0) (while (setq inp (read-line QSS-Shadow-List-fp))(setq shadow-count (1+ shadow-count)))(close QSS-Shadow-List-fp) ;;; (sublst (reverse '(10 9 8 7 6 5 4 3 2 1)) (1+ (length '(1 2 3))) nil) -> (4 5 6 7 8 9 10) (setq total-file-list (sublst (reverse recovery-list) (1+ shadow-count) nil)) ;;; first item in total list is the naughty one so bag & tag (QSS_Save_To_Naughty_List (car total-file-list)) ;;; put item also on hit-list with remark that app was unable to open it (QSS_Save_To_Shadow_List (strcat "0|error|" (vl-princ-to-string (car total-file-list)))) ;;; now process rest of total-list (setq total-file-list (cdr total-file-list)) ) ) ) ;;; 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 shadow-fn-1 shadow-fp-1 shadow-fn-2 shadow-fp-2) (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)) ;;; save all results to file on desktop for later valuation ;;; the reason I wrote this was I had to scan 104.987 files and around no. 86.000 AutoCad crashed and all results poof ;;; after I created Shadow Mode it happened again so now I first save every filename to a dat file and ;;; in the loop I do the same with prefix [Y], (string was found) or [N], (string was not found) ;;; Now if AutoCad crashes again at least I can see which file I have to kick of this planet (if (and (= QSS-Shadow-Mode "1") (not (= QSS-Recovery-Mode "1"))) (progn ;;; clear old shadow file first because inside next loop this shadow file is appended (\\Desktop\\QSS-Shadow-Mode.txt) (if (setq shadow-fn-1 (findfile QSS-Shadow-List-fn))(vl-file-delete shadow-fn-1)) ;;; write all filenames to dat file (if (and (setq shadow-fn-2 (strcat (getenv "USERPROFILE") "\\Desktop\\QSS-Shadow-Mode.dat")) (vl-consp total-file-list)(setq shadow-fp-2 (open shadow-fn-2 "w"))) (progn (foreach x total-file-list (write-line x shadow-fp-2))(close shadow-fp-2)(gc)(gc))) ) ) ;;; now do the actual scanning (foreach fn total-file-list (setq hit nil) ;;; 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" (if (setq ext (vl-filename-extension fn)) (setq ext (strcase ext t)) (setq ext "")) ;(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 ;;; on this moment untested / too slow ((wcmatch ext "*`.doc,*`.docx,*`.rtf") (if (SearchInWord fn pattern) (setq hit fn hit-list (cons hit hit-list)))) ;;; on this moment untested / too slow ((wcmatch ext "*`.pdf") (if (SearchInPDF fn pattern) (setq hit fn hit-list (cons hit hit-list)))) ((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 fn hit-list (cons hit 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") (setq dbx-doc (vl-catch-all-apply 'odbx_open (list fn))) (if (or (= dbx-doc nil) (vl-catch-all-error-p dbx-doc)) ;;; one reasonthis can happen is when trying to open drawing with higher AutoCad version (setq hit nil fn (strcat "1|unable to open|" fn)) (if (setq hit (regex_string_search dbx-doc pattern nil)) (setq hit fn hit-list (cons hit hit-list)))) ;(odbx_close dbx-doc) ) ;;; excel : Scan_Excel returns T or nil if regex pattern is found ((wcmatch ext "*`.xls,*`.xlsx") (if (and (Scan_Excel fn) (not (member fn hit-list))) (setq hit fn hit-list (cons hit hit-list)))) ) ;;; Shadow Mode (save search hits directly to file on desktop ;(if (and hit (= QSS-Shadow-Mode "1")) (QSS-Execute-Shadow-Protocol hit)) (if (= QSS-Shadow-Mode "1") (if hit (QSS_Save_To_Shadow_List (strcat "3|found|" hit)) (QSS_Save_To_Shadow_List (strcat "2|none|" fn)) ) ) ;;; 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) ) (defun QSS_Save_To_Shadow_List (s) (if (setq QSS-Shadow-List-fp (open QSS-Shadow-List-fn "a")) (progn (write-line s QSS-Shadow-List-fp)(close QSS-Shadow-List-fp)(gc)) (princ (strcat "Unable to save to Shadow-List : " (vl-princ-to-string s))) ) ) (defun QSS_Save_To_Naughty_List (s) (if (setq QSS-Naughty-List-fp (open QSS-Naughty-List-fn "a")) (progn (write-line s QSS-Naughty-List-fp)(close QSS-Naughty-List-fp)(gc)) (princ (strcat "Unable to save to Naughty-List : " (vl-princ-to-string s))) ) ) (defun QSS_Save_Recovery_List (lst) (if (setq QSS-Recovery-List-fp (open QSS-Recovery-List-fn "w")) (progn (foreach x lst (write-line x QSS-Recovery-List-fp)) (close QSS-Recovery-List-fp) (gc)) (alert "Unable to save recovery list") ) ) ;;; --- 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)) ;;; (mk_desktop_dir "QuickStringSearch") (defun mk_desktop_dir ( $d / d ) (setq $d (vl-princ-to-string $d)) (setq d (strcat (getenv "USERPROFILE") "\\Desktop\\" $d)) (if (vl-file-directory-p d) d (progn (vl-mkdir d) d))) ; test : (commatize '("a" "b" "c")) (defun commatize (l) (apply 'strcat (cdr (apply 'append (mapcar (function (lambda (x) (list "," x))) l))))) ; 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) ;;; (sublst '(1 2 3 4 5 6 7 8 9 10) 5 2) -> (5 6) / (sublst '(1 2 3 4 5 6 7 8 9 10) 8 8) -> (8 9 10) ;;; (sublst '(1 2 3 4 5 6 7 8 9 10) 3 nil) -> (3 4 5 6 7 8 9 10) (defun sublst (lst i l / r) (if (not (<= 1 l (- (length l) i))) (setq l (- (length lst) (1- i))))(repeat l (setq r (cons (nth (1- i) lst) r) i (1+ i))) (reverse r)) ;;; (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)) "/") "")) (defun IsFileReadable (fn / fp inp) (if (setq fileHandle (open fn "r")) (progn (setq inp (read-line fp)) ;|like AC1032|; (close fp) (and inp (= (substr inp 1 2) "AC")) ;|T if valid header|; ) nil ;|corrupt or locked|; )) ; 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)) ;;; (yesno "Are you a dragon?") (defun yesno ( m / n p i r ) (and (= (type m) 'STR) (setq n (vl-filename-mktemp "yesno.dcl")) (setq p (open n "w")) (princ (strcat"yesno :dialog{label=\"" m "?\";ok_cancel;}") p)(progn (close p)(gc) t) (setq i (load_dialog n)) (new_dialog "yesno" i) (progn(action_tile "accept" "(done_dialog 1)")(action_tile "cancel" "(done_dialog 0)") (setq r (start_dialog))(unload_dialog i)(vl-file-delete n) t)(if (= r 1) t nil))) ; 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))) ;;; multiple from list (setq inp (mfl '("bak" "dwg" "pdf" "tif") '("dwg"))) (defun mfl (%l %df / toggle set_all l f p d r) (setq l (mapcar '(lambda (x)(if (member x %df)(strcat "[X] " x)(strcat "[O] " x))) %l)) (defun toggle (v / s r)(if (eq (substr (setq r (nth (atoi v) l)) 2 1) "X")(setq s "[O] ")(setq s "[X] ")) (setq l (subst (strcat s (substr r 5)) r l))(start_list "lb")(mapcar 'add_list l)(end_list)) (defun set_all (i)(setq l (mapcar '(lambda (x)(if (eq i "1") (strcat "[X] " x) (strcat "[O] " x))) %l)) (start_list "lb")(mapcar 'add_list l)(end_list)) (and (setq p (open (setq f (vl-filename-mktemp ".dcl")) "w")) (princ (strcat "cfl:dialog{label=\"Choose\";:list_box {height=12;key=\"lb\";}" ":button{label=\"All\";key=\"bt_all\";}:button{label=\"None\";key=\"bt_none\";}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" "(toggle $value)") (action_tile "accept" "(setq r (get_tile \"lb\"))(done_dialog 1)") (action_tile "cancel" "(setq r nil)(done_dialog 0)") (action_tile "bt_all" "(set_all \"1\")")(action_tile "bt_none" "(set_all \"0\")") (start_dialog)(unload_dialog d)(vl-file-delete f))) (if r (mapcar '(lambda (y)(substr y 5)) (vl-remove-if '(lambda (x)(eq (substr x 2 1) "O")) l))) ) ;;; 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) ;;; results are saved in user\desktop\quickstringsearch\QSS-Shadow-List.txt (QSS-Shadow-List-fn) ;;; each line begins with 0|error| , 1|unable to open| , 2|no hit| or 3|hit| (defun load_list ( / result-list) (if (and (findfile QSS-Shadow-List-fn)(setq QSS-Shadow-List-fp (open QSS-Shadow-List-fn "r"))) (progn (while (setq inp (read-line QSS-Shadow-List-fp)) (if (= (car (setq inp (SplitStr inp "|"))) "3") (setq result-list (cons (last inp) result-list)))) (if (vl-consp result-list)(setq l (reverse result-list)) (setq l '("No results"))) (start_list "lb")(mapcar 'add_list l)(end_list) ) (alert "Unable to load list") ) ) ;;; very basic file save routine (defun save_list ( / f p) (if (and (vl-consp l) (setq f (vl-filename-mktemp "QuickStringSearch.txt")) (setq p (open f "w"))) (progn (mapcar '(lambda (x)(write-line x p)) l) (close p) (gc) (startapp "notepad" f)))) (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 open-at-the-end f)(done_dialog))(t (_ShellOpen f))))) (defun list_box_action ($r $v) (cond ((= $r 1) (setq pick $v)) ((= $r 4) ;|double click|; (setq pick $v)(open_item)))) (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" "(list_box_action $reason $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 dbxObj))(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 'dbxObj))(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 dbxObj (vl-catch-all-apply 'vla-getinterfaceobject (list actApp (dbx_ver)))) (if (or (null dbxObj)(vl-catch-all-error-p dbxObj))(progn (princ "\nObjectDbx not available")(setq dbxObj nil))) dbxObj ) (defun odbx_open ( $dwg / _pimp doc) (or AllOpen (GetAllOpenDocs)) (or dbxObj (_InitObjectDBX)) (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 dbxObj (_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 dbxObj (findfile $dwg)))) (princ "\nUnable to open drawing.")(setq doc nil)) (t (setq doc dbxObj))) 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))))) ;;; function to find all strings (txt/att etc) in all drawings in a folder ;;; QSS-Search-Folder QSS-Include-Subfolders QSS-Filename-Extension-Filter QSS-Search-String-Filter ;;; QSS-Get-Everything QSS-Case-Sensitive QSS-Whole-Words-Only ;;; alf : d = directory , e = extension like "*.dwg" , f = flag include subfolders (any value or nil) ;;; test : (length (alf "d:/temp/lisp" "*.dwg" t)) (defun QSS_Get_Everything ( / actDoc actDocs actApp dbxObj RegExp dbx-doc write_result show_result search-folder dwg-list rtn result-list search-pattern result-list-fn folder-list file-count l ) ;;; 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 d (vl-string-right-trim "\\/" d)) (setq search-pattern "*" result-list-fn (strcat (vl-string-right-trim "\\/" QSS-Search-Folder) "\\QuickStringSearchResult.txt")) ;;; fire-up process bar (clear_bar)(set_tile "the_bar" " working...") (cond ((not (vl-file-directory-p QSS-Search-Folder)) (alert (strcat "Folder " QSS-Search-Folder " does not exist - change folder"))) ;((not (vl-consp (setq dwg-list (alf QSS-Search-Folder "*.dwg" (if (eq QSS-Include-Subfolders "1") T nil))))) ; (alert (strcat "No dwg files in " QSS-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 file-count 1) ;;; first scan for subfolder (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 dwg-list (QSS_FindFiles folder-list (list "*.dwg"))) (clear_bar) (set_tile "the_bar" (strcat "Number of files to search : " (setq n (itoa (length dwg-list))))) (foreach dwg dwg-list (if (setq dbx-doc (odbx_open dwg)) (progn (if (vl-consp (setq rtn (regex_string_search dbx-doc search-pattern return-as-list))) (setq result-list (cons (cons dwg rtn) result-list))) ;;; release doc to prevent dbx memory leak ;(odbx_close dbx-doc) ) (princ (strcat "\nUnable to open " dwg)) ) ;;; clear previous status (clear_bar) ;;; update status message (set_tile "the_bar" (strcat " ( " (setq *spin* (Spinbar *spin*)) " ) Scanning files [" (itoa file-count) " of " n)) ;;; increase file counter (setq file-count (1+ file-count)) ) (_ReleaseAll) ) ) ;;; (vlax-release-object dbxObj) ;;; 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)) ;;; **** test 2026-06-01 on request Percy **** (if (eq QSS-Get-Everything "1") (setq pattern "*")) (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 ) (defun _ReadStream-n ( path len n / fso file stream result lst) (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)) (repeat n (setq result (vlax-invoke stream 'read len)) (setq lst (cons result lst)) ) (vlax-invoke stream 'Close) ) ) (if stream (vlax-release-object stream))(if file (vlax-release-object file))(if fso (vlax-release-object fso)) lst ) ;;; 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 --- ;;; ;;; --- Excel ---------------------------------------------------- Excel ---------------------------------------------------- Excel --- ;;; (defun Init_Excel () (or xlApp (setq xlApp (vlax-get-or-create-object "Excel.Application"))) (vla-put-visible xlApp :vlax-false)) (defun Exit_Excel () (if xlApp (progn (vl-catch-all-apply 'vlax-invoke-method (list xlWorkbook 'Close :vlax-false)) (vlax-release-object xlSheets) (vlax-release-object xlWorkbook) (vlax-release-object xlApp)))) ;;; retrieve all values from Excel workbook (defun Scan_Excel (fn / f xlUsedRange rows xlValue _safearray tmp-lst result excel-range excel-used-range excel-max-row excel-max-column excel-max-range excel-variant excel-value excel-to-list l2 l3 pattern ignoreCase global) ;;; just to make sure regex is up and running (or RegExp (setq RegExp (vlax-create-object "VBScript.RegExp"))) ;;; 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)) ;;; (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) (if (and fn (string-p fn) (setq f (findfile fn))) (progn (Init_Excel) (setq xlWorkbooks (vlax-get-property xlApp 'Workbooks)) (setq xlWorkbook (vlax-invoke-method xlWorkbooks 'Open f)) (setq xlSheets (vlax-get-property xlWorkbook 'Sheets)) (vlax-for xlSheet xlSheets (setq xlUsedRange (vlax-get-property xlSheet 'UsedRange)) ;;; Set limits on number of rows, not sure what size would be to much for AutoCad to handle (setq rows (vlax-get-property (vlax-get-property xlUsedRange 'Rows) 'Count)) (if (< rows 500000) (progn (and (setq excel-variant (vlax-get-property xlUsedRange 'Value)) (setq excel-value (vlax-variant-value excel-variant)) (setq excel-to-list (vlax-safearray->list excel-value)) (setq tmp-lst (vl-remove nil (mapcar '(lambda (x) (vl-remove nil (mapcar '(lambda (y / val) (setq val (vl-catch-all-apply 'vlax-variant-value (list y))) (if (vl-catch-all-error-p val) nil val)) x))) excel-to-list))) (setq result (append result tmp-lst)) ) ) (princ (strcat "\nSkipped " (vl-filename-base fn) " Tab '" (vlax-get-property xlSheet 'Name) "' : to many rows (" (itoa rows) ").")) ) (vlax-release-object xlUsedRange) (vlax-release-object xlSheet) ) (vlax-invoke-method xlWorkbook 'Close :vlax-false) ) ) ;;; test if pattern is found in result list , returns T or nil (if (vl-consp result) (pat-p pattern (mapcar 'vl-princ-to-string (apply 'append result)))) ) ;;; --- Excel -------------------------------------------- End of Excel Section --------------------------------------------- Excel --- ;;; ;;; --- Word --------------------------------------------- Begin of Word Section --------------------------------------------- Word --- ;;; (defun SearchInWord (filePath openText / wordApp docCollection wordDoc wordSelect found) (vl-load-com) (setq found nil) ;; 1. Start Word in de achtergrond (onzichtbaar) (if (setq wordApp (vlax-get-or-create-object "Word.Application")) (progn (vla-put-visible wordApp :vlax-false) ; Zorg dat Word onzichtbaar blijft (setq docCollection (vla-get-documents wordApp)) ;; 2. Open het document (Alleen-lezen = :vlax-true, Onzichtbaar) (setq wordDoc (vlax-invoke-method docCollection 'Open filePath :vlax-false :vlax-true)) (if wordDoc (progn ;; 3. Gebruik de Find-methode van de documentinhoud (setq wordSelect (vlax-get-property wordDoc 'Content)) (setq wordFind (vlax-get-property wordSelect 'Find)) ;; Voer de zoekopdracht uit (parameters: tekst, matchCase, matchWholeWord, etc.) (setq found (vlax-invoke-method wordFind 'Execute openText :vlax-false :vlax-false)) ;; 4. Sluit het document zonder wijzigingen op te slaan (vlax-invoke-method wordDoc 'Close :vlax-false) ) ) ;; 5. Sluit de Word-applicatie af en reinig het geheugen (vlax-invoke-method wordApp 'Quit) (vlax-release-object wordFind) (vlax-release-object wordSelect) (vlax-release-object wordDoc) (vlax-release-object docCollection) (vlax-release-object wordApp) ) ) ;; Geeft :vlax-true terug als de tekst is gevonden, anders :vlax-false of nil found ) ;;; ------------------------------------------------------- End of Word Section ------------------------------------------------------- ;;; ;;; powershell ;;;powershell -Command "$w=New-Object -ComObject Word.Application; $w.Visible=$false; $d=$w.Documents.Open('C:\Pad\Naam.pdf',+ ;;; $false, $true); if($d.Content.Find.Execute('ZOEKTERM')) { 'GEVONDEN' | Out-File 'C:\Users\Naam\Desktop\result.txt' };+ ;;; $d.Close($false); $w.Quit()" ;;; (SearchInPDF "c:\\temp\\test.pdf" "Rlx") (defun SearchInPDF (pdfPath openText / shApp txtResult resFile found) (vl-load-com) (setq resFile (strcat (getenv "USERPROFILE") "\\Desktop\\pdf_result.txt")) ;; 1. Verwijder een eventueel oud resultaatbestand op de desktop (if (findfile resFile) (vl-file-delete resFile)) ;; 2. Bouw het PowerShell-commando op (alles op 1 regel) ;; Dit opent de PDF via de Word-engine op de achtergrond en zoekt naar de tekst. (setq psCmd (strcat "powershell -WindowStyle Hidden -Command " "\"$w=New-Object -ComObject Word.Application; $w.Visible=$false; " "$d=$w.Documents.Open('" pdfPath "', $false, $true); " "if($d.Content.Find.Execute('" openText "')) { 'JA' | Out-File '" resFile "' }; " "$d.Close($false); $w.Quit();\"" )) ;; 3. Voer het commando onzichtbaar uit via de Windows Shell (setq shApp (vlax-get-or-create-object "WScript.Shell")) (vlax-invoke-method shApp 'Run psCmd 0 :vlax-true) ; 0 = onzichtbaar venster, :vlax-true = wacht tot klaar (vlax-release-object shApp) ;; 4. Controleer of het tekstbestand is aangemaakt (tekst is gevonden!) (if (findfile resFile) (progn (setq found t) (vl-file-delete resFile) ; Netjes opruimen ) (setq found nil) ) found ; Geeft T terug als de tekst in de PDF staat, anders nil ) ;;; powershell ;;; -------------------------------------------------- Begin of Progress Bar Section -------------------------------------------------- ;;; ; (setq lst (acad_strlsort (QSS_FindSubfolders "c:/temp/lisp"))) (defun QSS_FindSubfolders ( d / l r s msg ) (setq d (vl-string-right-trim "\\/" d)) (setq l (list d)) trim (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) ) ;;; called from QSS_Pre_Scan line 201 ;;; (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 "\nQuick String Search - Rlx Jun'26 - Type QSS") ;(c:qss) Most info included in lisp file. Just a quick string search for lsp, txt & dwg files. 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 I have added a couple of toggles , Shadow mode , Recovery & Everything. Shadow mode writes a log file for every file that is searched. Next to it is Recovery. When searching oh lets say 100.000+ files and one of the files is corrupt AutoCad crashes and all previous results are poof... When this happens start AutoCad again , select Recovery , and app will continue the search by comparing the complete file-list with the shadow list and can work out from where to continue and put corrupt drawing on the naughty list. These files are saved on desktop in QuickSearchFolder. If a drawing was saved with a higher version I can error-catch that but when a file is corrupt lisp can't handle that so hence the recovery option. When multiple drawings are corrupt you have to repeat this process as many times until app reaches the finish line. When the list pops up you only see the matches found from the last successful run, click on the load button and shadow list is read again et voila. When 'Everything' is selected all text from all files (drawings) are saved to a text file. Button Clear Lists in main dialog deletes all files from desktop folder so you can start as fresh as a baby's butt (after a bath of course) Also corrected a little bug in the get-subfolders routine. Within the code I was working on doc/docx & pdf support but they are so slow I removed them from extension filter , but if you want to try uncomment line 285 and comment line 286

As usual this was born out of necessity. Had a 46Mb pdf , no tools on work laptop to convert it because also no adobe (reader only). PdF was all images so AutoCad pdf attach / import won't work either. Have a (legal) tool on my own computer but pdf wouldn't fit through the mail because of IT limitations. We used to have something like One-drive / Sharepoint but also blocked now , so I wrote this app. It chops up pdf in to 10MB pieces (or any size you want) , it can also email them at the same time and at the other end of the line you can put the pieces back again with the same app. So if your IT department tries to make your life a living hell , hell , maybe this app can give you some relief. RlxSplit.lsp

@PaulyPHI Give this a try.SetPlineZ_Updated.lsp

This has been talked before if I understood the problem correctly: https://www.cadtutor.net/forum/topic/61468-boundary-precision/ To create a boundary you have to have the whole area visible in your model, everything needs to be visible in display area So it has to do something with your "viewing resolution" (zoom), that's how command works. What is the limit I don't know, I never did tests like they did in topic mentioned above. But I also had the same problems with large areas like you posted, when I have one short line, or polyline segment, one of the boundary vertices would be wrong (bad precision). The solution for me was to create lisp working with regions, then convert region to polyline. When creating regions you don't need to see the whole area on your screen, you select the lines and its just pure math from there

@darshjalal Thanks for your program contribution. I don't want to take away for your obvious hard work, but I somewhat agree with @BIGAL. I have read the extensive comments that are very detailed and technical, but there is no summary of what it is used for, or how it is useful. For the casual LISP user, they would not understand the value in such a program. I think a simple paragraph would be help instead of blindly evaluating it. Your title does explain the purpose of the program, but it's too vague and some plain language on how the features are helpful would be nice - just a friendly critique

Before I used this : (defun GetFolder ( m / f s) (if (and (setq s (vlax-create-object "Shell.Application")) (setq f (vlax-invoke s 'browseforfolder 0 m 65536 "")))(setq f (vlax-get-property (vlax-get-property f 'self) 'path)) (setq f nil))(vl-catch-all-apply 'vlax-release-object (list s)) f) (defun wait (sec / stop)(setq stop (+ (getvar "DATE") (/ sec 86400.0)))(while (> stop (getvar "DATE")))) (defun findstring ( / a b c d e) (setq a (GetFolder "Select folder for string search")) (setq b (getstring "\nEnter string to search for : " T)) (setq c (getstring "\nFile extension (lsp) : ")) (if (eq c "") (setq c "lsp")) (setq d (strcat a "\\result.txt")) (setq e (strcat "findstr /i /s \"" b "\" " a "\\*." c " > " d)) (command "shell" e) (gc)(gc) ;;; natural delay for system to clear cache and write file to disk (alert "search completed") (startapp "notepad" d) (princ) ) (defun c:dfs ()(findstring)) (defun c:t1 ()(findstring)(princ)) This code only works for text based files. Have updated code in my first post with Excel support. Valid extensions are now lsp , txt , dwg , xls and xlsx I have a license for able2extract on my home computer and also written something that uses pdfattach and import for readable pdf's. Though I can take that route, it's not like shoot & forget , often more than one step is needed. But it is what it is... most pdf's I get are pretty poor quality , some by accident and some not because a 3rd party wants you as a returning client if you know what I mean.

It's supposed to use the HPGAPTOL as far as I know. This has been an issue for sometime, now that I looked back into from a few years ago, this problem also occurs with Hatch command. I just tried Boundary and Hatch on a closed polyline object at Zoom Extents and got ... And despite the first instruction, Zooming In resolved the issue. I normally resolve this with Hatch by using Select Object, maybe Hatch, Select Object, delete the Hatch and keep the Boundary could work for the OP. @lastknownuser's post brought it back to my memory. There is a thread around from a while back on this issue and needing to use Select Object option for Hatch.

There was a post a couple of years ago now, if it is a closed shape without crossing lines, hatching the area then recreate the boundary and delete the hatch leaves the boundary... as a last resort since it is long winded way to go. I haven't had time this week to look at this properly - you're in safe hands with the other posters though... (The post I am thinking about was using LISP to do something, click in the area to get boundary, might have been to measure area, perimeter or something but that was the idea behind it, LISP is ok if it is a bit long winded, fractions of a second longer process)

@Danielm103, I'm on rev. 8.9.3 so does not apply to me. Thanks for the warning nonetheless. ymg

if Nothing else it would show up in peoples searches. just posting a file even tho it has great documentation will not show up in searches. if you take all the time to write things up and share here make it so people can find your lisp files. or just copy all the ;; lines. someone in 6 months to a year will post looking for a divide lisp with points and I won't be able to find this post. -Edit like you did here

If your offering something a good idea is to provide images or a movie about what the program does, else the "Why bother" will occur. Just attaching a lisp is not really describing why you should download the program. Think of it as if I was selling the program how would I get people interested.

@rlx Your Kung-Fu is Strong! Nice work!

Haven't checked in a while, but we can't receive any .zip, .rar, etc. in emails here, but can send them, which is useless if sending internally. They had some ridiculously low email attachment file sizes when I first came here, I got them to go to 10MB, that's most likely what it is now. I put large files to share on the network and send a link (which IT has it where it cannot be clicked on), either they figure out how to get it or they don't. Being retirement age has it's perks.

Reminds me of when I had to move a file before networking or USB drives. had to use winrar and split up the zip file between 12 floppy disks! Was curious and it only took 17 lines of code in python lol minus the emailing and join parts.

@darshjalal Nice work! Your added Automatic mode, and the code to strip numbers out of the text is over and above!

@PaulyPHI Here is a quick walk-though: This uses Visual LISP to pull the text string from the selected object and convert it to a real number. See the added comments below. (if (and ;; Logical AND = All conditions must be met. ;; 1) an object must be selected. (setq es (entsel "\nSelect Text Object: ")) ;; 2) The selected object must have a text string property, i.e. TEXT, MTEXT, ATTRIBUTE, MLEADER, etc. (vlax-property-available-p (vlax-ename->vla-object (car es)) 'TextString) ;; 3) Retrieve the textsting value if the above conditions are met. (setq newZ (vla-get-textstring (vlax-ename->vla-object (car es)))) ;; 4) The textstring value must evaluate to greater than 0 when converted to a real number. This only works if the text is numerical. (> (setq newZ (distof newZ)) 0.0) ) ;; if all conditions are met, then continue to the (progn) block that performs the changes.

Welcome. To make a cleaner look I would make a master Chart (or multiple BH SW MW or by area with a box around them) with all the relative call outs. this would allow a larger view of the area. eliminate the use/need of leaders that aren't really doing anything but cluttering the drawing. -edit Then updating would be adding borehole location and adding to the chart.

Don't know what is going on about Textexp but here is a favour for you. I just made A-Z 0-9 exploded. Convert to correct plines then can extrude into a solid say 1 unit high, will need to check the 36 shapes. The sample dwg really needs more thought say text size =1 and height equal say 0.1. It took about 10 minutes to make these. With a bit of practice much faster and use other fonts. You can use presspull to change height. BUT SET TEXT HEIGHT CORRECT BEFORE EXTRUDE. Oh yeah why do you have units set to Architectural when your talking mm ? new block.dwg

Ok I used Txtexp on "MACEY", then went to a 3d view so could see what was going on VPOINT -1,-1,-1. You have to check that all the objects that appear are plines I had to join the little "A" triangle. Ok extruded the base 1.5 Extruded the circles 2.5, then unionid both, to base, subtracted the inner circle from the new solid. Extruded the ""M" 4.5 then did a union again. Extruded the two parts of the "A" unioned together with base then subtracted the inner triangle, You can see the progress. What you want is not a single step but rather multiple steps, lastly can export the STL file. Once you get the hang of extruding, subtrcat and union you can do multiple objects at one time. This is a bit rough as a solid and can be done better, by moving the text to a Z matching base height before you start.

PETA-INSERT ELEVATIONS FROM TEXTS INSIDE THE CLOSED OR OPEN POLYINE.LSP Try this one too

The equal linetype as supplied is just a dashed linetype that has a length of one unit and a gap of one unit. By setting its LTSCALE to the length of a pipe you can get an idea of the number of pipes involved. I have somewhere also convert an existing line to two lines as per right hand image, The GIS used to dump out a single line on a size layer so we wanted 2 dashed lines to imply existing drainage. Will try to find I think that is what you want.

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

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.

ah yes. https://www.cadtutor.net/forum/topic/98598-just-a-funny-basic-toolbar/

Try this also. Seemed to work and makes a vector list code of objects. VECTORIZE.lsp

That would be The Dragon, RLX maybe? He had a menu but not sure if that is the one you're thinking off? (I was impressed but been too busy this year to get into using it)

Didn't someone have a lisp that created a menu system in model space ? on the right side of the current view.

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

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

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.

From HERE. Also mentioned in that post was Terry Millers GetVectors, but he has a new site now. AutoLISP Code

You could try these, the first one, test, will return lists for each line with the 4 values for the 2 end points (x1, y1, x2, y2). You need to also select a reference point to measure these points to. I tend to draw the thumbnail in a 75x75 square, reference point is top left corner and all the thumbnail entities are lines - nothing else - function name test The second one I haven't adjusted, copied straight from my library, blockthumbrecord, select the lines, select the reference point and it will return some results in a new notepad window... so not been adjusted you might need to add a function in there (LM: functions from Lee Macs website). Also the notepad will add in other stuff that is handy for me - a good learning exercise to look at the code and adjust it so it works for you. Both will give you sets of points for each line in a selection which you can copy and paste for your needs. Note that the vector graphics cannot do fractions, so maybe best set your snaps and grid to '1' and to get a smooth curve, a few short lines and make sure that the ends all touch. (defun c:test ( / ) (defun LM:round ( n ) (fix (+ n (if (minusp n) -0.5 0.5))) ) (princ "\nSelect LINES for thumbnail: ") ;;Get entities (setq ss (ssget '((0 . "LINE")))) (if (not ss) ;check for nil selection set (progn (princ "Nothing selected.") (exit) ) ;end progn ) ;end if ;;get list of entities (setq LinesList (list)) (setq acount 0) (setq BasePoint (getpoint "\Select Top Left Corner of Tumbnail (75x75 square)")) (setq BasePoint (reverse (cdr (reverse BasePoint)))) (while (< acount (sslength ss)) ;loop for every entity in the set (setq en (ssname ss acount)) ;get entity name (setq ed (entget en)) ;get entity definition (setq pt1 (reverse (cdr (reverse (cdr (assoc 10 ed)))))) ;; X and Y only (setq pt1 (mapcar '- BasePoint pt1)) ;; Shift by basepoint (setq pt1 (mapcar 'LM:round (mapcar 'abs pt1))) ;; Absolute value rounded to nearest 1 (setq pt1 (list (rtos (car pt1) 2 0) (rtos (cadr pt1) 2 0) )) ;; List items to strings (setq pt2 (reverse (cdr (reverse (cdr (assoc 11 ed)))))) ;; X and y Only (setq pt2 (mapcar '- BasePoint pt2)) ;; Shift by basepoint (setq pt2 (mapcar 'LM:round (mapcar 'abs pt2))) ;; Absolute value rounded to nearest 1 (setq pt2 (list (rtos (car pt2) 2 0) (rtos (cadr pt2) 2 0) )) ;; List items to strings (setq pt1 (append pt1 pt2)) ;; Create thumbnail definition line (setq LinesList (append LinesList (list pt1)) ) ;; Add definition line to thumb. definition (setq acount (+ acount 1)) ) ;;end while LinesList ) (defun c:blockThumbrecord ( / ss LinesList acount en ed pt1 pt2 tempblock f ) ;;Opens notepad wth lines coordinates (defun LM:lst->str ( lst del / str ) (setq str (car lst)) (foreach itm (cdr lst) (setq str (strcat str del itm))) str ) ;;Get entities (setq ss (ssget '((0 . "LINE")))) (if (not ss) ;check for nil selection set (progn (princ "Nothing selected.") (exit) ) ;end progn ) ;end if ;;get list of entities (setq LinesList (list)) (setq acount 0) (while (< acount (sslength ss)) ;loop for every entity in the set (setq en (ssname ss acount)) ;get entity name (setq ed (entget en)) ;get entity definition (setq pt1 (cdr (assoc 10 ed))) (setq pt1 (list "list" (rtos (abs (car pt1)) 2 0) (rtos (abs (cadr pt1)) 2 0) )) (setq pt2 (cdr (assoc 11 ed))) (setq pt1 (append pt1 (list (rtos (abs (car pt2)) 2 0) (rtos (abs (cadr pt2)) 2 0) "TxCol"))) (setq LinesList (append LinesList (list pt1)) ) (setq acount (+ acount 1)) ) ;;end while ;;write to a temp file (if (strcat (getvar "TEMPPREFIX") "Thumbnail.txt")(vl-file-delete (strcat (getvar "TEMPPREFIX") "Thumbnail.txt"))) (setq tempblock (strcat (getvar "TEMPPREFIX") "Thumbnail.txt")) ;;add check if this exists (setq f (open tempblock "w")) ;;open file (write-line " (Defun Sel--**FUNCTIONNAME**-- ( origin BgCol TxCol ImgTile Control / BlkList return) " f) (write-line " (if (= Control \"Vector\") " f) (write-line " (progn " f) (write-line " (start_image ImgTile) " f) (write-line " (fill_image (- origin 0) 0 (+ origin 85) 85 BgCol) " f) (write-line " (setq BlkList (list " f) (setq acount 0) (while (< acount (length LinesList)) (write-line (strcat "(" (LM:lst->str (nth acount LinesList) " ") ")" ) f) (setq acount (+ acount 1)) ) (write-line " )) ; end setq end list" f) (write-line " (setq Xoff 0)(setq YOff 0)" f) (write-line " (CreateVector BlkList XOff YOff TxCol)" f) (write-line " (end_image)" f) (write-line " ); end progn" f) (write-line " (setq Return \"--**FUNCTION NAME TO INSERT BLOCK**--\")" f) (write-line " ) ; end if" f) (write-line " )" f) (write-line "" f) (write-line "; -OK- ;" f) (close f) ;;open notepad & file ;; (startapp "c:/windows/notepad.exe" tempblock) (vl-catch-all-apply (function (lambda () (setq obj (vlax-get-or-create-object "WScript.Shell")) (vlax-invoke obj 'Run (strcat "c:/windows/notepad.exe \"" tempblock "\"")) ;; or notepad++ if that is used. (setvar 'cmdecho 0) (vlax-invoke obj 'AppActivate "Notepad") ; Title bar name of application. ++ for notepad++ but still works? ) ) ) (if obj (vlax-release-object obj)) (princ) ) These should make it possible to easily get the coordinates to make something like this as a thumbnail: (The Engineers keep asking me to add a legend.... so I do) The second LISP makes up the code I need for my block selection routine, thumbnail graphic, saved in the code, see the image I like, click and paste

As far as I remember the numbers are pairs of points, in your '(' 18 ad 17, 16 and 15..... with the X coordinate to the left and Y to the TOP (unlike usual CAD where Y is counted from the bottom) So your code has an odd number of numbers - I think they need an even number. CAD is off for the evening now, but that might help. You could also post the link to Lees code - usually there is an explanation in there, and also perhaps a screen shot of what you are getting or any errors.

@Tsuky works as well, not sure what @sd2006 is struggling with. The one I posted works the same as the OP's in first post for horizontal align, I just added the vertical align and some error checking. Home today, so also tested in AutoCAD 2000i.

Still starting from the mhupp code, I think this corresponds to your request: align all the blocks to the position of a block. Same for text or mtext. (defun C:ABC ( / vars vals ss ssref pt_ref pt2 vector mode ent ed pt newpt) (vl-load-com) (setq vars '(OSMODE ORTHOMODE) vals (mapcar 'getvar vars) ) (mapcar 'setvar vars '(0 1)) (princ "\nSelect Block or Texte.") (while (null (setq ss (ssget '((0 . "*TEXT,INSERT")))))) (princ "\nSelect ONE texte or block to align selection") (while (null (setq ssref (ssget "_+.:E:S" '((0 . "*TEXT,INSERT")))))) (setq pt_ref (cdr (assoc 10 (entget (ssname ssref 0))))) (setq pt2 (getpoint pt_ref "\nSelect Horozontal or Vertical:")) (setq vector (mapcar '- pt2 pt_ref)) (if (eq (car Vector) 0.0) (setq mode 'V) (setq mode 'H)) (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS))) (setq ed (entget ent) pt (cdr (assoc 10 ed)) newpt (if (eq mode 'V) (list (car pt_ref) (cadr pt) (caddr pt)) (list (car pt) (cadr pt_ref) (caddr pt))) ) (vla-Move (vlax-ename->vla-object ent) (vlax-3d-point pt) (vlax-3d-point newpt)) ) (mapcar 'setvar vars vals) (princ) )

@mhupp's LISP works for me, but I took a stab at it anyway. I just tweaked the original abc.lsp, I would prefer if you would post a link to the original so I can properly credit the author. For more information, Kent Cooper has quite a few LISPs for aligning blocks for certain and probably (M)Text, etc. (as well as sorting spacing etc.) on the Autodesk Forums, they should be easy to locate. This worked on your provided drawing as well as one I made for test with Polylines, Lines, Blocks, Mtext, Text and Attributes. ;;; Align selected objects in X or Y direction with reference object. | ;;; | ;;; https://www.cadtutor.net/forum/topic/99091-i-need-a-lisp-to-align-blocks-and-texts-vertically/ | ;;; | ;;; Modified from the provided abc.lsp (author unknown) by SLW210 (a.k.a. Steve Wilson) | ;;; | ;;; Was horizontal only, added vertical align option, error and undo. | ;;; | ;;; *****************************************************************************************************| (defun c:AlignXY (/ *error* OS mode ss albl alpt alptx alpty ctr ename inpt inptx inpty newpt olderr ) ;; Error handler (setq olderr *error*) (defun *error* (msg) (if (/= msg "Function cancelled") (princ (strcat "\nError: " msg)) ) (if OS (setvar "OSMODE" OS) ) (command "_.UNDO" "_End") (setq *error* olderr) (princ) ) ;; Save and set system vars (setq OS (getvar "OSMODE")) (setvar "OSMODE" 0) ;; Start UNDO group (command "_.UNDO" "_Begin") ;; Ask user for alignment direction (initget "Horizontal Vertical") (setq mode (getkword "\nAlign [Horizontal/Vertical] <Horizontal>: ")) (if (null mode) (setq mode "Horizontal") ) ;; Select objects (princ "\nSelect blocks or text to align evenly: ") (if (not (setq ss (ssget))) (progn (princ "\nNothing selected.") (*error* "Function cancelled") (exit) ) ) ;; Select reference object (if (not (setq albl (entsel "\nSelect reference text or block: ")) ) (progn (princ "\nNo reference selected.") (*error* "Function cancelled") (exit) ) ) (setq albl (car albl)) (setq alpt (cdr (assoc 10 (entget albl)))) (if (not alpt) (progn (princ "\nInvalid reference object.") (*error* "Function cancelled") (exit) ) ) (setq alptx (car alpt)) (setq alpty (cadr alpt)) ;; Loop through selection (setq ctr 0) (while (setq ename (ssname ss ctr)) (setq inpt (cdr (assoc 10 (entget ename)))) (if inpt (progn (setq inptx (car inpt)) (setq inpty (cadr inpt)) ;; Decide new point (cond ((= mode "Horizontal") (setq newpt (list inptx alpty)) ) ((= mode "Vertical") (setq newpt (list alptx inpty)) ) ) (command "move" ename "" inpt newpt) ) ) (setq ctr (+ ctr 1)) ) ;; End UNDO group cleanly (command "_.UNDO" "_End") ;; Restore vars and error handler (setvar "OSMODE" OS) (setq *error* olderr) (prompt "\nAlignment complete.") (princ) )

Thank you so much. This has been annoying me for decades. Pity I only found out how to fix it right on my retirement.

AutoCAD has PDFSHXTEXT to convert the vector lines/arcs that once were SHX texts back to texts. Post the converted PDF file from ZWCAD. Sounds like you need to use something better than ZWCAD if it isn't capable of doing what you need. This still goes back to you need to use TTFs.

A version also for closed polylines. Minimally tested... centerPline_v2.LSP

;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

Thanks, will check that out later.