All Activity

If the text is Searchable in the PDF. Windows Explorer will work. if the PDF is just an image then it wont work and have to use Adobe's OCR to convert them to be searchable. -Edit Tho not 100% some stuff come in weird like fractions or text between white space and pictures.

Yeah , well , I'm afraid to tempt 'the Gods' how much worse it can get haha. Big reorganization on its way and we hope things can only get better , but that's maybe tempting fate In the mean while got it working (I think) for excel workbooks too , but gonna have to post that later when I get home tonight. Clippy (the AI) told me without external programs like Adobe or pdf2text , its very unlikely I'm gonna be able to directly retrieve strings from a pdf. Since I cant install any software other than provided by the company that's not gonna happen. Only way would be pdfimport and pdfshx but that would defeat the purpose of this appie.

Nice work IT! They got you to spend hours trying to circumvent the limitations they forced upon their employees just to make it workable.

I have moved your post to a new thread ARES Commander LISP not Working in the AutoLISP, Visual LISP & DCL Forum. Please use Code Tags for posted code in the future. (<> in the editor toolbar) Where did you get the LISP and what does it do? Do other LISPs run in your Ares Commander? What does not work? Do you have the Visual Studio Code and the Graebert LISP Extension for troubleshooting the LISP?

Have they locked Powershell also ? I use it at times. Converting the lisp code to .net would speed up searching the txt & lsp files, in lisp directory I have 1500+ lsp files. But chances are your admin has that locked.

eh sorry i forgot to put the link

I also used to use theDOS thing , but its not nearly as sexy : (sorry , <> has been disabled by my work , file upload as well and if I try to use a bat file admin locks me down) Will post tonight

can anyone help me with this, this lisp work in autocad perfectly but i want to use this to ares but it doesn't work (defun c:KKK ( / TBName TBTemp s flag ctr SheetSize chk PrjName LaynName i n e x 1p 2p o1p o2p y1p y2p s1 i1 n1 e1 x1 s2 i2 n2 e2 x2 Psize Size file tempViewName DwgTitle ) (setvar "CMDECHO" 0) (setq TBName "Title Block_R2.R") (setq TBTemp "FT NEW TEMPLATE 2.0") (setq s nil) (setq flag 1) (setq ctr 1) (setq SheetSize nil) (setq chk nil) (setq LaynName (car (layoutlist))) (setq DwgTitle "Title_info") (setq tempViewName "_TEMP_ORIGINAL_VIEW") (if (setq s (ssget (list '(0 . "INSERT") ))) (progn (command "-VIEW" "S" tempViewName) (setq chk T) (setq i 0 n (sslength s) ) (while (< i n) (setq e (ssname s i) x (cdr (assoc 2 (entget e))) i (1+ i) ) ;(print x) (if (= (LM:name->effectivename x) TBName ) (progn (command "_zoom" "_object" (cdr(car(entget e))) "") (setq 1P (car(LM:boundingbox (vlax-ename->vla-object (cdr(car(entget e))))))) (setq 2P (nth 2 (LM:boundingbox (vlax-ename->vla-object (cdr(car(entget e))))))) (setq o1P 1P) (setq o2P 2P) (setq y1p (strcat (rtos (car 1P) 2 0) "," (rtos (car (cdr 2P)) 2 0))) (setq y2p y1p) (setq s1 (ssget "W" 1P 2P (list '(0 . "INSERT") ))) (setq i1 0 n1 (sslength s1) ) (while (< i1 n1) (setq e1 (ssname s1 i1) x1 (cdr (assoc 2 (entget e1))) i1 (1+ i1) ) (if (= (cdr (assoc 0 (entget e1))) "INSERT") (cond ((= (LM:getvisibilitystate (vlax-ename->vla-object (cdr (car (entget e1))))) "NESTED") (setq SheetSize (LM:assoc++ (setq Size (strcat (LM:getattributevalue (cdr (car(entget e1))) "SHEET_WIDTH") "X" (LM:getattributevalue (cdr (car(entget e1))) "SHEET_HEIGHT"))) SheetSize)) (setq PSize (assoc Size SheetSize)) (setq Psize (strcat (car Psize)"-" (fixitoa (cdr Psize) 2))) ) ((= (LM:getvisibilitystate (vlax-ename->vla-object (cdr (car (entget e1))))) "SINGLE PANEL") (setq s2 (ssget "W" (subst (- (car 1p) 450) (car 1p) 1p) 2P (list '(0 . "INSERT") ))) (setq i2 0 n2 (sslength s2) ) (while (< i2 n2) (setq e2 (ssname s2 i2) x2 (cdr (assoc 0 (entget e2))) i2 (1+ i2) ) (if (= (LM:name->effectivename (cdr (assoc 2 (entget e2)))) "NestedPanelTitle") (setq Psize (LM:getattributevalue (cdr (car(entget e2))) "PANELNAME")) ) (if (= (LM:name->effectivename (cdr (assoc 2 (entget e2)))) "AWC") (LM:setattributevalue e2 "RUN_PROGRAM" "-") ) ) ) ((= (LM:getvisibilitystate (vlax-ename->vla-object (cdr (car (entget e1))))) "NESTED (OFFCUT)") (setq SheetSize (LM:assoc++ "OFFCUT" SheetSize)) (setq PSize (assoc "OFFCUT" SheetSize)) (setq Psize (strcat (car Psize)"-" (fixitoa (cdr Psize) 2))) ) ((= x1 DwgTitle) (setq PrjName (vl-string-trim "Model" (LM:getattributevalue e1 "PROGRAM_NAME:"))) ) );cond );if );while );progn );if ) (if (= PSIZE nil) (setq flag 0) (progn (CreateScript) ) ) ) (progn (setq flag 0) (setq ctr 0) ) );if (princ) (while (= flag 1) (while (= ctr 1) (setq 1P (list (car 1P)(- (car(cdr 1P)) 4127 ))) (setq 2P (list (car 2P)(- (car(cdr 2P)) 4127 ))) (setq y1p (strcat (rtos (car 1P) 2 0) "," (rtos (car (cdr 2P)) 2 0))) (command "._zoom" "non" 1P "non" 2P) (if (setq s (ssget "_W" 1P 2P)) (progn (setq i 0 n (sslength s) ) (while (< i n) (setq e (ssname s i) x (cdr (assoc 0 (entget e))) i (1+ i) ) (if (= x "INSERT") (cond ((= (LM:getvisibilitystate (vlax-ename->vla-object (cdr (car (entget e))))) "NESTED") (setq SheetSize (LM:assoc++ (setq Size (strcat (LM:getattributevalue (cdr (car(entget e))) "SHEET_WIDTH") "X" (LM:getattributevalue (cdr (car(entget e))) "SHEET_HEIGHT"))) SheetSize)) (setq PSize (assoc Size SheetSize)) (setq Psize (strcat (car Psize)"-" (fixitoa (cdr Psize) 2))) (WriteScript) (setq ctr 1) ) ((= (LM:getvisibilitystate (vlax-ename->vla-object (cdr (car (entget e))))) "SINGLE PANEL") (setq s2 (ssget "W" (subst (- (car 1p) 450) (car 1p) 1p) 2P (list '(0 . "INSERT") ))) (setq i2 0 n2 (sslength s2) ) (while (< i2 n2) (setq e2 (ssname s2 i2) x2 (cdr (assoc 0 (entget e2))) i2 (1+ i2) ) (if (= (LM:name->effectivename (cdr (assoc 2 (entget e2)))) "NestedPanelTitle") (setq Psize (LM:getattributevalue (cdr (car(entget e2))) "PANELNAME")) ) (if (= (LM:name->effectivename (cdr (assoc 2 (entget e2)))) "AWC") (LM:setattributevalue e2 "RUN_PROGRAM" "-") ) ) (WriteScript) (setq ctr 1) ) ((= (LM:getvisibilitystate (vlax-ename->vla-object (cdr (car (entget e))))) "NESTED (OFFCUT)") (setq SheetSize (LM:assoc++ "OFFCUT" SheetSize)) (setq PSize (assoc "OFFCUT" SheetSize)) (setq Psize (strcat (car Psize)"-" (fixitoa (cdr Psize) 2))) (WriteScript) (setq ctr 1) ) );cond ) );WHILE );PROGN );IF (if (= s nil) (setq ctr 0)) (princ) );while (setq 1P (list (+ (car o1P) 6830 )(car(cdr o1P)))) (setq 2P (list (+ (car o2P) 6830 )(car(cdr o2P)))) (setq y1p (strcat (rtos (car 1P) 2 0) "," (rtos (car (cdr 2P)) 2 0))) (setq o1P 1P) (setq o2P 2P) (command "_zoom" 1P 2P) (if (setq s (ssget "_W" 1P 2P)) (progn (setq i 0 n (sslength s) ) (while (< i n) (setq e (ssname s i) x (cdr (assoc 0 (entget e))) i (1+ i) ) (if (= x "INSERT") (cond ((= (LM:getvisibilitystate (vlax-ename->vla-object (cdr (car (entget e))))) "NESTED") (setq SheetSize (LM:assoc++ (setq Size (strcat (LM:getattributevalue (cdr (car(entget e))) "SHEET_WIDTH") "X" (LM:getattributevalue (cdr (car(entget e))) "SHEET_HEIGHT"))) SheetSize)) (setq PSize (assoc Size SheetSize)) (setq Psize (strcat (car Psize)"-" (fixitoa (cdr Psize) 2))) (WriteNextScript) (setq ctr 1) ) ((= (LM:getvisibilitystate (vlax-ename->vla-object (cdr (car (entget e))))) "SINGLE PANEL") (setq s2 (ssget "W" (subst (- (car 1p) 450) (car 1p) 1p) 2P (list '(0 . "INSERT") ))) (setq i2 0 n2 (sslength s2) ) (while (< i2 n2) (setq e2 (ssname s2 i2) x2 (cdr (assoc 0 (entget e2))) i2 (1+ i2) ) (if (= (LM:name->effectivename (cdr (assoc 2 (entget e2)))) "NestedPanelTitle") (setq Psize (LM:getattributevalue (cdr (car(entget e2))) "PANELNAME")) ) (if (= (LM:name->effectivename (cdr (assoc 2 (entget e2)))) "AWC") (LM:setattributevalue e2 "RUN_PROGRAM" "-") ) ) (WriteNextScript) (setq ctr 1) ) ((= (LM:getvisibilitystate (vlax-ename->vla-object (cdr (car (entget e))))) "NESTED (OFFCUT)") (setq SheetSize (LM:assoc++ "OFFCUT" SheetSize)) (setq PSize (assoc "OFFCUT" SheetSize)) (setq Psize (strcat (car Psize)"-" (fixitoa (cdr Psize) 2))) (WriteNextScript) (setq ctr 1) ) );cond ) );WHILE );PROGN );IF (if (= nil s)(setq flag 0)) );while (DelAllLayout) (if (= chk nil) (princ "\nInvalid Object") (progn (setq file (open (strcat (getvar "dwgprefix") "CreateScript.scr") "A")) (write-line "LockAllVp" file) (write-line "MODEL" file) (write-line (strcat "-VIEW\tR " tempViewName "\n ") file) (write-line (strcat "-VIEW\tD " tempViewName "\n ") file) (write-line "REGENALL" file) (close file) (command "_.Layout" "Set" (car (layoutlist))) (command "_.script" (strcat (getvar "dwgprefix") "CreateScript.scr")) ) ) (setvar "CMDECHO" 1) (princ) );defun ;========================================================================= (defun LM:name->effectivename ( blk / rep ) (if (and (wcmatch blk "`**") (setq rep (cdadr (assoc -3 (entget (cdr (assoc 330 (entget (tblobjname "block" blk)))) '("AcDbBlockRepBTag") ) ) ) ) (setq rep (handent (cdr (assoc 1005 rep)))) ) (cdr (assoc 2 (entget rep))) blk ) ) ;========================================================================= (defun LM:boundingbox ( obj / a b lst ) (if (and (vlax-method-applicable-p obj 'getboundingbox) (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list obj 'a 'b)))) (setq lst (mapcar 'vlax-safearray->list (list a b))) ) (mapcar '(lambda ( a ) (mapcar '(lambda ( b ) ((eval b) lst)) a)) '( (caar cadar) (caadr cadar) (caadr cadadr) (caar cadadr) ) ) ) ) ;========================================================================= (defun LM:getattributevalue ( blk tag / enx ) (if (and (setq blk (entnext blk)) (= "ATTRIB" (cdr (assoc 0 (setq enx (entget blk)))))) (if (= (strcase tag) (strcase (cdr (assoc 2 enx)))) (cdr (assoc 1 (reverse enx))) (LM:getattributevalue blk tag) ) ) ) ;========================================================================= (defun LM:setattributevalue ( blk tag val / enx ) (if (and (setq blk (entnext blk)) (= "ATTRIB" (cdr (assoc 0 (setq enx (entget blk)))))) (if (= (strcase tag) (strcase (cdr (assoc 2 enx)))) (if (entmod (subst (cons 1 val) (assoc 1 (reverse enx)) enx)) (progn (entupd blk) val ) ) (LM:setattributevalue blk tag val) ) ) ) ;========================================================================= (defun LM:effectivename ( obj ) (vlax-get-property obj (if (vlax-property-available-p obj 'effectivename) 'effectivename 'name ) ) ) ;========================================================================= (defun LM:assoc++ ( key lst / itm ) (if (setq itm (assoc key lst)) (subst (cons key (1+ (cdr itm))) itm lst) (cons (cons key 1) lst) ) ) ;========================================================================= (defun CreateScript () (setq file (open (strcat (getvar "dwgprefix") "CreateScript.scr") "W")) (write-line (strcat ".mview\tL\tOFF\tALL \nLAYOUT\tR\t" LaynName "\t" "-") file) (write-line (strcat "LAYOUT\tR\t" "-" "\t" PSize) file) (close file) (setq LaynName PSize) (crText (mapcar '+ '(150 2200) (list (car 1p) (cadr 1p))) 75 (strcat PrjName laynname)) ) ;========================================================================= (defun WriteScript () (setq file (open (strcat (getvar "dwgprefix") "CreateScript.scr") "A")) (write-line (strcat "LAYOUT\tC\t" LaynName "\t" PSize "\tLAYOUT\tS\t" PSize "\tGoLast\tMspace\t-pan\t" y1p "\t" y2p "\tPspace") file) (close file) (setq LaynName PSize) (setq y2p y1p) (crText (mapcar '+ '(150 2200) (list (car 1p) (cadr 1p))) 75 (strcat PrjName laynname)) ) ;========================================================================= (defun WriteNextScript () (setq file (open (strcat (getvar "dwgprefix") "CreateScript.scr") "A")) (write-line (strcat "LAYOUT\tC\t" LaynName "\t" PSize "\tLAYOUT\tS\t" PSize "\tGoLast\tMspace\t-pan\t" y1p "\t" y2p "\tPspace") file) (close file) (setq LaynName PSize) (setq y2p y1p) (crText (mapcar '+ '(150 2200) (list (car 1p) (cadr 1p))) 75 (strcat PrjName laynname)) ) ;========================================================================= (defun fixitoa ( #i #n / s ) (setq s (itoa #i))(while (> #n (strlen s))(setq s (strcat "0" s))) s) ;========================================================================= (defun LM:getvisibilitystate ( blk / vis ) (if (setq vis (LM:getvisibilityparametername blk)) (LM:getdynpropvalue blk vis) ) ) ;========================================================================= (defun LM:getvisibilityparametername ( blk / vis ) (if (and (vlax-property-available-p blk 'effectivename) (setq blk (vla-item (vla-get-blocks (vla-get-document blk)) (vla-get-effectivename blk) ) ) (= :vlax-true (vla-get-isdynamicblock blk)) (= :vlax-true (vla-get-hasextensiondictionary blk)) (setq vis (vl-some '(lambda ( pair ) (if (and (= 360 (car pair)) (= "BLOCKVISIBILITYPARAMETER" (cdr (assoc 0 (entget (cdr pair))))) ) (cdr pair) ) ) (dictsearch (vlax-vla-object->ename (vla-getextensiondictionary blk)) "ACAD_ENHANCEDBLOCK" ) ) ) ) (cdr (assoc 301 (entget vis))) ) ) ;========================================================================= (defun LM:getdynpropvalue ( blk prp ) (setq prp (strcase prp)) (vl-some '(lambda ( x ) (if (= prp (strcase (vla-get-propertyname x))) (vlax-get x 'value))) (vlax-invoke blk 'getdynamicblockproperties) ) ) ;========================================================================= (defun DelAllLayout ( / ll) (command "_.Layout" "Set" (car (getLayoutOrderList))) (while (/= 0 (setq ll (- (setq ll (length (getLayoutOrderList))) 1 ))) (progn (if (> ll 0) (command "_-LAYOUT" "DELETE" (nth ll (getLayoutOrderList))) ) );progn );while (command "Model") ) ;========================================================================= (defun getLayoutOrderList( / lst mklist mappend flatten) (defun mklist (x) (if (listp x) x (list x))) (defun mappend (fn lst)(apply 'append (mapcar fn lst))) (defun flatten (expr)(mappend 'mklist expr)) (vlax-for lay (vla-get-layouts (vla-get-activedocument (vlax-get-acad-object))) (setq lst (cons (list (vla-get-taborder lay)(vla-get-name lay)) lst)) ) (cdr(flatten(mapcar 'cdr (vl-sort lst '(lambda (a b) (< (car a)(car b))))))) ) ;========================================================================= (defun c:GoLast (/ l) (if (and (< 2 (vla-get-count (setq l (vla-get-Layouts (vla-get-ActiveDocument (vlax-get-acad-object)) ) ) ) ) (eq 0 (getvar 'TILEMODE)) ) (vla-put-taborder (vla-item l (getvar 'CTAB)) (1- (vla-get-count l)) ) (princ "\n ** Command is not allowed in Model Space **") ) (princ) ) ;========================================================================= (defun C:LockAllVp ( / i oldlo oldcmde) (setq oldcmde (getvar "CMDECHO")) (setvar "CMDECHO" 0) (setq oldlo (getvar "CTAB")) ;cannot lock model ; (setvar "CTAB" "Model") ;all layouts (foreach i (layoutlist) (progn (setvar "CTAB" i) (command "_-VPORTS" "_Lock" "_on" "_all" "") );progn ) (setvar "CTAB" oldlo) (setvar "CMDECHO" oldcmde) (princ "\nAll viewports locked.") (princ) ) ;========================================================================= (defun crText ( ins hgt str / ent ) (entmake (list '(000 . "TEXT") '(100 . "AcDbText") '(7 . "TEXT") '(8 . "Defpoints") (cons 010 ins) (cons 040 hgt) (cons 001 str) ) ) ) ;========================================================================= (defun *error* (msg) (if (not (wcmatch msg "quit/exit abort,function canceled")) (princ (strcat "\nError: " msg)) ; Display message for actual errors ) (setvar "CMDECHO" 1) ; Ensure settings are reset (princ) ; Quiet exit ) ;=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- (princ (strcat "\n:: Version 1.1 | \\U+00A9 FT ::" "\n:: This Progam also works with Single Panel ::" "\n:: \"CRL\" to Create Layout ::" ) ) (princ)

@RLX I use windows Findstr under CMD for search txt and lsp etc, just having a play how to call a bat file from CAD. I used ; (startapp "D:\\acadtemp\\test.bat insert") CMD option manually Windows lower left CMD Cd d:\alan\lisp Findstr "insert" *.lsp Bat file, I have one called fnd.bat D: Cd\alan\lisp findstr %1 *.lsp pause Pretty sure Findstr supports search sub directories. You should also be able to redirect to a file > filename. You are right use lisp to write the bat file, choose directory etc. It does not work with DWG files.

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

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.

Using commands to acomplish the conversion, especially batch ones, will be very slow while displaying the DXF graphics. Why not use ODBX? 1) Create a dbx doc 2) DXFIn the dxf file 3) Saveas the dbx as dwg _$ (vlax-dump-object dbx t) ; IAxDbDocument: nil ; Property values: ; Application (RO) = Exception occurred ; Blocks (RO) = #<VLA-OBJECT IAcadBlocks 000002520fe578b8> ; Database (RO) = #<VLA-OBJECT IAcadDatabase 0000025243645708> ; Dictionaries (RO) = #<VLA-OBJECT IAcadDictionaries 000002520fe56598> ; DimStyles (RO) = #<VLA-OBJECT IAcadDimStyles 000002520fe57678> ; ElevationModelSpace = 0.0 ; ElevationPaperSpace = 0.0 ; Groups (RO) = #<VLA-OBJECT IAcadGroups 000002520fe55db8> ; Layers (RO) = #<VLA-OBJECT IAcadLayers 000002520fe57558> ; Layouts (RO) = #<VLA-OBJECT IAcadLayouts 000002520fe561a8> ; Limits = (0.0 0.0 12.0 9.0) ; Linetypes (RO) = #<VLA-OBJECT IAcadLineTypes 000002520fe57798> ; Materials (RO) = #<VLA-OBJECT IAcadMaterials 000002520fe56ce8> ; ModelSpace (RO) = #<VLA-OBJECT IAcadModelSpace 0000025279adffc8> ; Name = "" ; PaperSpace (RO) = #<VLA-OBJECT IAcadPaperSpace 0000025279ae0068> ; PlotConfigurations (RO) = #<VLA-OBJECT IAcadPlotConfigurations 000002520fe567d8> ; Preferences (RO) = #<VLA-OBJECT IAcadDatabasePreferences 00000252436bc1a8> ; RegisteredApplications (RO) = #<VLA-OBJECT IAcadRegisteredApplications 000002520fe57948> ; SectionManager (RO) = Exception occurred ; SummaryInfo (RO) = #<VLA-OBJECT IAcadSummaryInfo 0000025243646068> ; TextStyles (RO) = #<VLA-OBJECT IAcadTextStyles 000002520fe579d8> ; UserCoordinateSystems (RO) = #<VLA-OBJECT IAcadUCSs 000002520fe56bc8> ; Viewports (RO) = #<VLA-OBJECT IAcadViewports 000002520fe56868> ; Views (RO) = #<VLA-OBJECT IAcadViews 000002520fe56e08> ; Methods supported: ; CopyObjects (3) ; DxfIn (2) ; DxfOut (3) ; HandleToObject (1) ; ObjectIdToObject (1) ; Open (2) ; Save () ; SaveAs (2) T

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

Hi all, I've been a lurker on CADTutor for years and learned a lot from this community, so I wanted to share something I built and get feedback from people who actually know LISP. Background: I'm a civil CAD drafter working on US land development projects — grading, drainage, easements, corridors. MLINE has always been the tool I wanted to use for drawing parallel offset lines but couldn't, mainly because the objects are locked, there's no lineweight control per component, and the .mln style management across a team is a nightmare. So I wrote a replacement. ────────────────────────────────── WHAT IT DOES ────────────────────────────────── Command MPL works like PLINE — you draw a centerline and it generates a set of configurable parallel LWPOLYLINEs around it. Every satellite line is a real polyline: fully grip-editable, trimmable, offsettable, joinable. No locked geometry, no exploding required. Each satellite line carries its own: - Offset distance (positive = left, negative = right) - Layer (Pro version) - Color, linetype, lineweight, linetype scale Configuration is handled through a DCL dialog (MPLEDIT). Settings save as user defaults and, in the Pro version, as named presets stored in %APPDATA%\MplineAuto\presets.dat. ────────────────────────────────── TWO VERSIONS ────────────────────────────────── Lite (free .lsp): - MPL, MPLEDIT, MPLSYNC - Manual sync after edits — run MPLSYNC, window-select the group, done - Groups are tracked via XDATA (app tag: MPLINE_PIPE) Pro (compiled .vlx, $29.49): - Everything in Lite plus: - Command reactor for auto-sync — watches masters before/after every command, diffs vertex lists, rebuilds only what changed - Named preset library with Save/Update/Delete from the dialog - Per-satellite layer assignment - MPLADD — promote existing LWPOLYLINEs or LINEs into MPL groups - MPLON / MPLOFF — toggle reactor at runtime - XDATA app tag: MPLINE_AUTO ────────────────────────────────── IMPLEMENTATION NOTES ────────────────────────────────── The interesting part was the Pro reactor. I went through a few approaches before landing on a global command reactor that snapshots the master cache before a command fires and diffs it after. This avoids object reactors entirely (which caused IDispatch arity issues in testing) and means the reactor doesn't interfere with Express Tools or COPY/MIRROR operations on non-MPL geometry. Groups copied with COPY or MIRROR produce new masters on the next MPLSYNC call — the reactor doesn't auto-register copies, which is intentional to avoid unexpected geometry multiplication. Happy to discuss the approach if anyone has thoughts or has solved similar problems differently. ────────────────────────────────── LINKS ────────────────────────────────── Video walkthrough: https://youtu.be/DXpyy1JWtXs Free Lite download: https://skillamplifier.gumroad.com/l/hgpujs Pro listing: https://skillamplifier.gumroad.com/l/nsidsv Blog post with full documentation and use cases: https://skillamplifier.wordpress.com/2026/05/16/multipline/ Full disclosure: I'm the developer. Posting here because I'd genuinely value feedback from experienced LISP users, and the Lite version is free so there's no risk trying it. Thanks for any thoughts. Zlatislav

Alright folks I recently got a 3D printer and I want to make some custom number plates for my buddies and my boys 4 wheelers. I have a pretty good start but when I type TXTEXP to raise up the numbers and letters the numbers just go way off screen and get real big. Any ideas?

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

I found this code which is can calculated the area of the hatch even if its intersection itself. Try it , I think it will help. Regards HAE-SHOW THE AREA OF HATCH EVEN IS NOT SHOWING AREA IN PROPERTIES.LSP

MCC-WRITE XYZ COORDS WITH MLEADER - REV12.LSP Please try this code for writing the coordinates. Regards.

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

can not open

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

Welcome aboard M07, did you do a google re this task ? I have seen posts in various forums for this task. There may also be something overt at the Autodesk Apps Store. Do you have access to Autodesk "Plant" that should do what you want.

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

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

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