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

@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.

@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.

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) )

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

I reversed all the polylines see if that does anything. -Edit Might fix it on the bottom but then mess it up on the top. Rervers Boundary.dwg

I exploded the polylines into lines. I also reduced the lineweight to 0, but in both cases the result remains the same. A colleague who still has an old PC with Autodesk Map 5 (= AutoCAD 2002) also confirmed that the same error occurs. If I’m not mistaken, AutoCAD 2002 is basically the same as AutoCAD 2000, so @SLW210’s statement that the "boundary" command works correctly in that version intrigues me.

Welcome aboard, post a sample dwg with your block, then people can have a look at what you have done.

DIVCURVES-INSERTING POINTS AS SPECIFIC DISTANCE.LSP I am so sorry for not giving more details about the code. Please read the following for more details: When executed, the utility launches an interactive keyword configuration: Menu: [1-Polylines/2-Lines/3-Arcs/4-Circles/5-Splines/6-FeatureLines/7-All] --- OPTION 1: Polylines --- - Target: Native 2D LWPolylines and 3D Heavy Polylines (*POLYLINE). - Sub-Prompts: Asks for both "Curve distance" and "Line distance". - Workflow Logic: Polylines frequently alternate between straight tangents and arced bulges. The engine runs through each sub-segment parameter, applying the Curve interval on loops returning a non-zero bulge and the Line interval on zero-bulge vectors. Critical for tracking centerlines. --- OPTION 2: Lines --- - Target: Standalone native LINE entities (completely ignores curves). - Sub-Prompts: Triggers only "Line distance [Middle/Vertices]". - Workflow Logic: * Absolute Number: Measures out fixed structural intervals from start. * "Middle": Drops a single layout node at exactly Total Length / 2. * "Vertices": Flags only the absolute start and endpoints, bypassing any segment division calculations. Perfect for boundary box indexing. --- OPTION 3: Arcs --- - Target: Standalone open circular ARC elements. - Sub-Prompts: Triggers only "Curve distance [Middle]". - Workflow Logic: Uses true structural arc-length path calculations (not straight-line chord spacing). Entering "Middle" isolates the exact apex mid-curve station node. Excellent for curb returns or radius layout. --- OPTION 4: Circles --- - Target: Full, closed 360-degree CIRCLE elements. - Sub-Prompts: 1. Circle Mode [Distance/Pieces] 2. Curve Distance (if Distance Mode) 3. Number of Slices (if Pieces Mode) - Workflow Logic: * Pieces Mode: Divides the 360° rim into perfectly equal pie sections. Ideal for setting layout coordinates for manholes or foundation piles. * Distance Mode: Steps linearly around the outer circumference. --- OPTION 5: Splines --- - Target: Non-uniform smooth organic SPLINE curve strings. - Sub-Prompts: Triggers "Curve distance" and "Line distance". - Workflow Logic: Utilizes Visual LISP curve projection vectors to step smoothly through changing multi-radius landscape or contour paths, automatically trapping and marking the true start/end index boundaries. --- OPTION 6: FeatureLines --- - Target: Native Autodesk Civil 3D Feature Lines (AECC_FEATURE_LINE). - Sub-Prompts: Triggers "Curve distance" and "Line distance". - Workflow Logic: Tailored for civil infrastructure models. The engine interrogates the 3D string, locks all critical grade breaks and site vertices, and overlays intermediate interval layout points that retain design model accuracy. --- OPTION 7: All --- - Target: Simultaneous mixed selection set of all supported geometries. - Sub-Prompts: Sequential configuration parameters for all curves/lines. - Workflow Logic: Scans the entire cross-window selection. For every object trapped, it reads its DXF Group 0 type, dynamically assigns your preset rules, avoids duplicate coordinate overlaps, and populates the entire site plan layer in a single execution click. SHORT SEGMENT OVERRIDE LOGIC: If an entity length or sub-segment is shorter than the interval distance specified, the script halts and prompts: [Middle/All/SkipAll] - "Middle": Drops a layout node exactly at the center of that specific short segment. - "All": Converts the current short vector and all subsequent short vectors discovered during the current command run into midpoints automatically. - "SkipAll": Ignores short segments entirely for the rest of the execution, leaving them clean and checking only major length spans. SHORT SEGMENT OVERRIDE LOGIC: If an entity length or sub-segment is shorter than the interval distance specified, the script halts and prompts: [Middle/All/SkipAll] - "Middle": Drops a layout node exactly at the center of that specific short segment. - "All": Converts the current short vector and all subsequent short vectors discovered during the current command run into midpoints automatically. - "SkipAll": Ignores short segments entirely for the rest of the execution, leaving them clean and checking only major length spans.

Why the error occurs The PAUSE limitation: In AutoLISP, pause only stops the command to let the user interact (e.g., click a point). It does not return the string value to the command sequence. When you reach the attribute part, AutoCAD expects a string, but since pause doesn't provide one, the sequence breaks.Multiline Attribute Format: Multiline attributes in a command-line sequence require specific formatting. If there are line breaks, they must be represented by \P. In Lisp, you must escape the backslash: \\P .Command vs -Command: When using Lisp, it is safer to use the hyphenated version (e.g., -INSERT ) to force the command-line interface and bypass dialog boxes entirely. The Corrected Lisp Routine This routine replaces your DIESEL script. It captures the date automatically (matching your DIESEL format) and prompts for the initials and notes. (defun c:REVNOTE (/ insPt dateStr userInitials revNote) ;; Save current ATTDIA and turn it off (setq oldAttdia (getvar "ATTDIA")) (setvar "ATTDIA" 0) ;; 1. Get Insertion Point (setq insPt (getpoint "\nSpecify insertion point: ")) ;; 2. Get Date (Mimicking your Diesel formatting) ;; This uses a Lisp trick to call the Diesel 'edtime' function directly (setq dateStr (menucmd "M=(edtime,$(getvar,date),DD.MO.YYYY)")) ;; 3. Get User Initials (getstring T allows spaces) (setq userInitials (getstring T "\nEnter Initials: ")) ;; 4. Get Revision Note (for the multiline attribute) (setq revNote (getstring T "\nEnter Revision Note: ")) ;; 5. Execute the Insert command ;; Sequence: BlockName, Point, ScaleX, ScaleY, Rotation, Attr1, Attr2, Attr3, Attr4 (command "-INSERT" "REVNOTE" ; Block name insPt ; User picked point "1" "1" "0" ; Scale and Rotation "P01" ; Attribute 1: Rev Index dateStr ; Attribute 2: Date userInitials ; Attribute 3: Initials revNote ; Attribute 4: Multiline Note ) ;; Restore ATTDIA and Regen (setvar "ATTDIA" oldAttdia) (command "REGEN") (princ "\nRevision inserted successfully.") (princ) ) Key Differences & Improvements: menucmd: This is the best way to get the exact edtime format you used in DIESEL without writing a complex date-parsing routine in Lisp. getstring T: The T flag allows the user to enter spaces (e.g., if the user wants to type "First issue - revised"). Without it, pressing the Spacebar would finish the command. -INSERT: Using the hyphen ensures that AutoCAD doesn't try to pop up a browser window for the block file.Multiline Support: If your revNote contains multiple lines, make sure to type \P where you want the line break, or modify the code to join multiple strings with \\P.

Updated first post , added a few new options and killed a little bug in the get-subfolders routine.

I'll give it a test run when I get a chance. My current attitude with IT limits, is to not do it if IT deems it needs blocked. I can be lazy as well.

Yes but as I have had to do things working with the government or local municipalities isn't so cut and dry. just easier to do it the way they want it

I'm looking to make it kind of a side gig but nothing real major. Honestly, I have a love hate relationship with AutoCAD. Penn Foster really put a bad taste in my mouth for it with the lack of true instruction and having to lean on this forum for 90% of my problems while they were getting paid to "teach" me. However, the more I've used it the more I'm really starting to enjoy it. It's just little quirks like this that are aggravating. I messed around with TinkerCAD a little and I'm really trying to learn Fusion 360 but I just don't like fusion after using AutoCAD. It seems like everything is backwards from AutoCAD. I'm gonna take your advice and play with TinkerCAD some more

Ok I've sussed it now. I had to drag it to the bar/area to the right of the model and paper space tabs, not the bottom of the drawing area where it also snaps to, leading me to believe this was the correct position. Thanks for your response SLW210.

Looks like you need to "dock" the commandline. > Click and drag the command line window to the top or bottom edge of the application window until it snaps into place. This also fixes the F2 issue, should be a separate window when commandline is docked.

I think you just need to practice creating 3d objects more, you need to look at how Extrude, Union, Subtract, Presspull work. one thing you need to do in this task is take advantage of extrude in -ve direction. so the base goes down, but all the rest get extruded up with correct height. Anyway you have something now so can scale a character and use presspull to change its height. Make sure your in a 3d view when using presspull to change height as must pick top face edge. Just a comment I did every character one at a time to make sure I did them correct.

Like I stated, I still like leaning on AutoCAD for making things for the 3D printer, but also learning Blender and playing with TinkerCAD, etc. The main goal is getting nice 3D Prints, I can tell you from experience, the stuff you get from online, supposedly ready to print, sometimes needs a little tweaking or outright re-modeled. I also have been learning to work in the 3D printer software, in my case, Bambu Studio, it's a lot easier cleaning up, scaling, adding text, etc. right before slicing. Like anyone that uses tools to do a job, learning what tools to use, how to use them, when to use what, etc. is usually the best way to go forward, it's a learning process. By all means start with AutoCAD and improve, we are here to help. Do you know how to export to STL and import that into your slicer?

I messed around a little with tinker cad but figured since I already had some knowledge of AutoCAD that it would probably be more useful to stick with AutoCAD. as I mentioned above, I just started learning AutoCAD in November of last year through Penn Foster (don't hold that against me. I'm basically teaching myself at this point with the help of you fellas).

Well, I just started learning AutoCAD in November of last year through Penn Foster (don't hold that against me. I'm basically teaching myself at this point with the help of you fellas). I didn't realize you could set the text height BEFORE you press pull. I just started the press/pull then typed the number I want. As far as architectural, I'll be honest, that's all we used when I was in college so that's all I really know

Did you try doing these in TinkerCAD? Not sure why your have issues with exploding the text in AutoCAD, I'll look when I get back to work tomorrow. Even as you describe it "When I tried txtexp it shot the text way off to the left and made it huge", you just have to move it and scale it. What you really want to do is learn to do this with the 3D Printer tools. https://www.youtube.com/watch?v=9McpK4nNf2k

Thank you very much sir, works perfect. I have compared the modified text file to the original and my brain just melted.... i can see some text that makes sense but the rest is just gobldee goop to me.... I'm just not programmed to understand it... Thank you once again.

3PS.LSP

Sorry it took so long to get back. I never got notifications that there were any replies. OK, so maybe I'm missing something here and ChatGPT and Gemini are of zero help so far. I have this drawing. I'm trying to make a 3d printed ATV number plate. Extrude absolutely won't work for me, not sure why. I was able to use the "presspull" command to punch out the holes (which I don't believe is the correct way) and I can raise the plate up the 3mm I want and the support around the holes the additional 1mm I want but it absolutely won't do anything with the text. I tried MTEXT and single line text. Neither works My printer is a FlashForge AD5X Mark Macey Rear Plate.dwg

What 3D printer do you have? I just recalled, there used to be an APP at the Autodesk APP store, but no longer there, works on older AutoCAD, but it is also posted here at CADTutor and the Swamp. I use Bambu Labs and it comes with Bambu Studio which has a 3D Text that is very easy, I can do a custom name plate with text directly on the machine.

Another way to get the text from a pdf is the AI option 'OCR text & table from Microsoft PC manager, normally just available in the US store. But if you have VPN or are a really good singer (Queen : Oh...yes , I'm the great pretender lalala.. applause , oh thank you , you're so kind) you should be able to get it. Open pdf , use button et voila... but its still manual labor

Can you post a .dwg? You might give the FREE Autodesk TinkerCAD, I barley have looked at it lately, but IIRC it does a great job with 3D Text creation. But, like you I tend to use AutoCAD and Blender to make objects for the 3D Printer.

"Why Use TXTEXP? 3D Extrusion: Converts text into line/polyline paths that you can use the EXTRUDE command on." So to use extrude you must have closed shapes it can take a few minutes to properly close the exploded text. When using extrude you should set a height that you want.

I used SSX to select all objects on the layer "SURVEY NO BOUNDARY". As long as "Optimize segments within polylines" is checked Overkill will fix the existing polylines. As Eldon said "If you run Overkill first, then Extrim will work. But it will only trim the lines crossing the rectangle." It's a routine for trimming not erasing. I use EraseOutsideBoundary to both trim & erase outside: ;| Function to trim objects inside selected boundaries (allows for multiple boundaries) Boundaries can be "Circle, Ellipse, LWPolyline and Polyline" Entities Written By: Peter Jamtgaard Copyright 2015 All Rights Reserved ^C^C^P(or C:BoundaryTrim (load "BoundaryTrim.lsp"));BoundaryTrim EraseOutsideBoundary added by Tom Beauford ^C^C^P(or C:EraseOutsideBoundary (load "BoundaryTrim.lsp"));EraseOutsideBoundary ==============================================================================|; ;(defun C:BT ()(c:BoundaryTrim)) (defun C:BoundaryTrim (/ acDoc intCount ssBoundaries) (if (setq ssBoundaries (ssget (list (cons 0 "Circle,Ellipse,LWPolyline,Polyline")))) (progn (vla-startundomark (setq acDoc (vla-get-activedocument (vlax-get-acad-object)))) (repeat (setq intCount (sslength ssBoundaries)) (setq intCount (1- intCount)) (BoundaryTrim (ssname ssBoundaries intCount)) (BoundaryWindowErase (ssname ssBoundaries intCount)); <-Erase objects inside boundary optional ) ) ) (if acDoc (vla-endundomark acDoc)) ) ; Command line function to select objects that are windowed by a selected circle. (defun C:BoundarySelect (/ lstPoints objBoundary ssBoundary) (if (and (setq ssBoundary (ssget ":E:S" (list (cons 0 "Circle,Ellipse,LWPolyline,Polyline")))) (setq objBoundary (vlax-ename->vla-object (ssname ssBoundary 0))) (setq lstPoints (SegmentPoints objBoundary 360)) ) (and (setq ssSelections (ssget "_WP" lstPoints)) ) ) ) ; Function to trim linework inside a boundary entity (defun BoundaryTrim (entBoundary1 / lstPoints entBoundary1 entBoundary2 lstCenter lstPoints1 lstPoints2 objBoundary1 objBoundary2 ssBoundary *Error*) (defun *Error* () (setvar "cmdecho" intCMDEcho) ) (setq intCMDEcho (getvar "cmdecho")) (setvar "cmdecho" 0) (if (and (setq objBoundary1 (vlax-ename->vla-object entBoundary1)) (setq lstPoints1 (SegmentPoints objBoundary1 360)) (setq lstCenter (mapcar '(lambda (X)(/ (apply '+ X) (length lstPoints1)))(transposematrix lstPoints1))) (vl-cmdf "offset" (/ (distance (car lstPoints1) lstCenter) 36.0) entBoundary1 lstCenter "") (setq entBoundary2 (entlast)) (setq objBoundary2 (vlax-ename->vla-object entBoundary2)) (setq lstPoints2 (SegmentPoints objBoundary2 360)) ) (progn (vl-cmdf "trim" entBoundary1 "" "f") (foreach lstPoint lstPoints2 (vl-cmdf lstPoint)) (vl-cmdf "" "") (entdel entBoundary2) (vl-cmdf "redraw") (setvar "cmdecho" intCMDEcho) ) ) ) ; Function to trim linework outside a boundary entity (defun TrimOutsideBoundary (entBoundary1 / lstPoints entBoundary1 entBoundary2 lstCenter maxpt lstPoints1 lstPoints2 objBoundary1 objBoundary2 ssBoundary *Error*) (defun *Error* () (setvar "cmdecho" intCMDEcho) ) (setq intCMDEcho (getvar "cmdecho")) (setvar "cmdecho" 0) (if (and (setq objBoundary1 (vlax-ename->vla-object entBoundary1)) (setq lstPoints1 (SegmentPoints objBoundary1 360)) (setq lstCenter (mapcar '(lambda (X)(/ (apply '+ X) (length lstPoints1)))(transposematrix lstPoints1))) (setq maxpt (list (1+ (car (getvar 'extmax)))(1+ (cadr (getvar 'extmax)))(1+ (caddr (getvar 'extmax))))) (vl-cmdf "offset" (/ (distance (car lstPoints1) lstCenter) 200.0) entBoundary1 maxpt "") (setq entBoundary2 (entlast)) (setq objBoundary2 (vlax-ename->vla-object entBoundary2)) (setq lstPoints2 (SegmentPoints objBoundary2 360)) ) (progn (vl-cmdf "trim" entBoundary1 "" "f") (foreach lstPoint lstPoints2 (vl-cmdf lstPoint)) (vl-cmdf "" "") (entdel entBoundary2) (vl-cmdf "redraw") (setvar "cmdecho" intCMDEcho) ) ) ) ; Function to erase linework inside a boundary entity (defun BoundaryWindowErase (entBoundary / lstPoints objBoundary ssSelections) (if (and (setq objBoundary (vlax-ename->vla-object entBoundary)) (setq lstPoints (SegmentPoints objBoundary 360)) (setq ssSelections (ssget "_WP" lstPoints)) ) (and (setq ssSelections (ssget "_WP" lstPoints)) (vl-cmdf "erase" ssSelections "") ) ) ) ; Function to determine the points along a curve dividing it intSegments number of times (defun SegmentPoints (objCurve intSegments / sngSegment intCount lstPoint lstPoints sngLength sngSegment) (if (and (setq sngLength (vlax-curve-getdistatparam objCurve (vlax-curve-getendparam objCurve))) (setq sngSegment (/ sngLength intSegments)) (setq intCount 0) ) (progn (repeat (1+ intSegments) (setq lstPoint (vlax-curve-getpointatdist objCurve (* intCount sngSegment))) (setq lstPoints (cons lstPoint lstPoints)) (setq intCount (1+ intCount)) ) lstPoints ) ) ) ; Function to Transpose a matrix (defun TransposeMatrix (lstMatrix) (if (car lstMatrix) (cons (mapcar 'car lstMatrix) (TransposeMatrix (mapcar 'cdr lstMatrix)) ) ) ) ; Function to erase linework outside a boundary entity (defun C:EraseOutsideBoundary ( / ss1 n ssBoundary objBoundary lstPoints ssSelections entSelection) (vla-startundomark (setq acDoc (vla-get-activedocument (vlax-get-acad-object)))) (setq ss1 (ssget "_X" '((67 . 0))) n -1) (if (and (setq ssBoundary (ssget ":E:S" (list (cons 0 "Circle,Ellipse,LWPolyline,Polyline")))) (setq entBoundary (ssname ssBoundary 0)) (ssdel entBoundary ss1) (TrimOutsideBoundary entBoundary) (setq objBoundary (vlax-ename->vla-object entBoundary)) (setq lstPoints (SegmentPoints objBoundary 360)) ) (and (setq ssSelections (ssget "_CP" lstPoints)) (repeat (sslength ssSelections) (setq entSelection (ssname ssSelections (setq n (1+ n)))) (if(ssmemb entSelection ssSelections)(ssdel entSelection ss1)) ) (command "erase" ss1 "") ) ) (if acDoc (vla-endundomark acDoc)) )