teknomatika Posted October 31, 2013 Posted October 31, 2013 Anyone who knows some routine to allows selecting a set of texts started by a certain character or string? For example: Select all texts started by NB. It should be possible to enter the search criteria / selection. Quote
Bhull1985 Posted October 31, 2013 Posted October 31, 2013 Here's a lisp from TerryCad that is a find and replace text utility, should be fairly similar to what you're needing. ;-------------------------------------------------------------------------------; Program Name: FindReplace.lsp [FindReplace R1]; Created By: Terry Miller (Email: terrycadd@yahoo.com); (URL: http://web2.airmail.net/terrycad); Date Created: 11-19-11; Function: FindReplace is a text utility to find and replace text in the; current drawing or in all open drawings. FindReplace.lsp requires; the functions inside of OpenDwgsCmds.lsp, OpenDwgsCmds.dvb,; Dcl_Tiles.lsp, Dcl_Tiles.dcl and GetIcon.lsp.;-------------------------------------------------------------------------------; Revision History; Rev By Date Description;-------------------------------------------------------------------------------; 1 TM 11-19-11 Initial version;-------------------------------------------------------------------------------; c:FindReplace - Find Replace text in current drawing or in all open drawings;-------------------------------------------------------------------------------(defun c:FR ()(c:FindReplace));Shortcut(defun c:FindReplace (/ Chk_Value: CmdList@ Dcl_Id% DosCommand$ FileName% Find$ List103@ Passed Replace$ Return# Var101$ Var102$ Var103$ Verify_Info:) (princ "\nFind Replace in Drawings\n") (FindReplace_Support) ;----------------------------------------------------------------------------- ; Chk_Value: - Check dialog values ;----------------------------------------------------------------------------- (defun Chk_Value: ($key $value / KeyName$ NumKey$ SaveVar$ TitleBar$ VarNum$) (setq NumKey$ (substr $key (- (strlen $key) 2)) ; Last 3 digits VarNum$ (strcat "Var" NumKey$ "$") ; Variable name SaveVar$ (eval (read VarNum$)) ; Previous value KeyName$ (substr $key 1 (- (strlen $key) 3)); Key name );setq (cond ((= $key "Edit101")(setq Var101$ $value)) ((= $key "Edit102")(setq Var102$ $value)) (t (Set_Value $key $value)) );cond ;--------------------------------------------------------------------------- ; Exceptions to Set_Value ;--------------------------------------------------------------------------- );defun Chk_Value: ;----------------------------------------------------------------------------- ; Verify_Info: - Verifies that the required information is correct ;----------------------------------------------------------------------------- (defun Verify_Info: () (if (= Var101$ "") (GetOk "Find Replace Message" "Find text field is required to be completed!" "exclam") (done_dialog 1) );if );defun Verify_Info: ;----------------------------------------------------------------------------- ; Set Default Variables and List Values ;----------------------------------------------------------------------------- (setq List103@ (list "All Open Drawings" "Current Drawing")) (if (not *FindReplace@) (setq *FindReplace@ (list nil "" "" (nth 1 List103@))) );if (setq Var101$ (nth 1 *FindReplace@) Var102$ (nth 2 *FindReplace@) Var103$ (nth 3 *FindReplace@) );setq ;----------------------------------------------------------------------------- ; Load Dialog ;----------------------------------------------------------------------------- (setq Dcl_Id% (load_dialog "FindReplace.dcl")) (new_dialog "FindReplace" Dcl_Id%) (GetTiles "FindReplace.dcl" "FindReplace") ;----------------------------------------------------------------------------- ; Set Dialog Initial Settings ;----------------------------------------------------------------------------- (set_tile "Title" " Find Replace in Drawings") (set_tile "Text101" "Find text") (set_tile "Text102" "Replace text") (set_tile "Text103" "Search in") (set_tile "Edit101" Var101$) (set_tile "Edit102" Var102$) (set_tile_list "List103" List103@ Var103$) ;----------------------------------------------------------------------------- ; Dialog Actions ;----------------------------------------------------------------------------- (action_tile "Edit101" "(Chk_Value: $key $value)") (action_tile "Edit102" "(Chk_Value: $key $value)") (action_tile "List103" "(Chk_Value: $key $value)") (action_tile "accept" "(Verify_Info:)") (setq Return# (start_dialog)) (unload_dialog Dcl_Id%) (if (= Return# 0) (exit)) (setq *FindReplace@ (list Return# Var101$ Var102$ Var103$) );setq (setq Find$ (FindReplace Var101$ "\"" "\\\"")) (setq Replace$ (FindReplace Var102$ "\"" "\\\"")) (if (= Var103$ "Current Drawing") (progn (setq Find$ (FindReplace Find$ "\\\"" "\"")) (setq Replace$ (FindReplace Replace$ "\\\"" "\"")) (FindReplaceAllTabs Find$ Replace$) );progn (progn (if (not OpenDwgsCmds) (load "OpenDwgsCmds") );if (setq CmdList@ (list (strcat "(FindReplaceAllTabs \"" Find$ "\" \"" Replace$ "\")"))) (OpenDwgsCmds CmdList@) );progn );if (princ));defun c:FindReplace;-------------------------------------------------------------------------------; FindReplaceAllTabs - Changes Text, Mtext, Dimensions and Attribute Block entities; that have a Find$ string with a Replace$ string in all layout tabs.; Arguments: 2; Find$ = Phrase string to find; Replace$ = Phrase to replace it with; Syntax: (FindReplaceAllTabs "NOT TO SCALE" "1 = 18"); Returns: Updates Text, Mtext, Dimension and Attribute Block entities in all layout tabs.;-------------------------------------------------------------------------------(defun FindReplaceAllTabs (Find$ Replace$ / BlkEntList@ BlkEntName^ BlkEntType$ Cnt# Ctab$ DimEntList@ DimEntName^ DimEntType$ EntList@ EntName^ EntType$ Layout$ Mid$ Mid2$ NewText$ Num# Replace$ SS& Text$) (setq Ctab$ (getvar "CTAB")) (if (and (= (type Find$) 'STR)(= (type Replace$) 'STR)(/= Find$ "")) (progn (setq Find$ (FindReplace Find$ "," (chr 183))) (setq Cnt# 1 Num# 0 NewText$ "") (repeat (strlen Replace$) (setq Mid$ (substr Replace$ Cnt# 1)) (if (= Mid$ "\n") (setq NewText$ (strcat NewText$ "\\P") Num# (1+ Num#) );setq (progn (setq Mid2$ (substr Replace$ Cnt# 2)) (if (= Mid2$ "\\n") (setq NewText$ (strcat NewText$ "\\P") Num# (1+ Num#) Cnt# (1+ Cnt#) );setq (setq NewText$ (strcat NewText$ Mid$)) );if );progn );if (setq Cnt# (1+ Cnt#)) );repeat (if (> Num# 0) (setq Replace$ (strcat (String$ Num# "\\P") NewText$)) );if (command "UNDO" "BEGIN") (foreach Layout$ (cons "Model" (GetLayoutList)) (command "LAYOUT" "S" Layout$) (if (/= Layout$ "Model") (command "PSPACE") );if (if (setq SS& (ssget "x" (list '(-4 . "<AND")'(-4 . "<OR")'(0 . "TEXT")'(0 . "MTEXT")'(0 . "DIMENSION")'(0 . "INSERT")'(-4 . "OR>")(cons 410 (getvar "CTAB"))'(-4 . "AND>")))) (progn (setq Cnt# 0) (repeat (sslength SS&) (setq EntName^ (ssname SS& Cnt#) EntList@ (entget EntName^) EntType$ (cdr (assoc 0 EntList@)) Text$ (cdr (assoc 1 EntList@)) );setq (if Text$ (progn (setq Text$ (FindReplace Text$ "," (chr 183))) );progn );if (if (= EntType$ "INSERT") (if (assoc 66 EntList@) (progn (while (/= (cdr (assoc 0 EntList@)) "SEQEND") (setq EntList@ (entget EntName^)) (if (= (cdr (assoc 0 EntList@)) "ATTRIB") (progn (setq Text$ (cdr (assoc 1 EntList@))) (setq Text$ (FindReplace Text$ "," (chr 183))) (if (wcmatch Text$ (strcat "*" Find$ "*")) (progn (setq ReplaceWith$ (FindReplace Text$ Find$ Replace$)) (setq ReplaceWith$ (FindReplace ReplaceWith$ (chr 183) ",")) (entmod (subst (cons 1 ReplaceWith$) (assoc 1 EntList@) EntList@)) (entupd EntName^) );progn );if );progn );if (setq EntName^ (entnext EntName^)) );while );progn );if (if (wcmatch Text$ (strcat "*" Find$ "*")) (progn (setq ReplaceWith$ (FindReplace Text$ Find$ Replace$)) (setq ReplaceWith$ (FindReplace ReplaceWith$ (chr 183) ",")) (entmod (subst (cons 1 ReplaceWith$) (assoc 1 EntList@) EntList@)) (entupd EntName^) );progn );if );if (setq Cnt# (1+ Cnt#)) );repeat );progn );if );foreach (command "UNDO" "END") );progn );if (command "LAYOUT" "S" Ctab$) (princ));defun FindReplaceAllTabs;-------------------------------------------------------------------------------; GetLayoutList - Returns a list of layouts in the drawing in tab order;-------------------------------------------------------------------------------(defun GetLayoutList (/ Layouts@) (vlax-map-collection (vla-get-layouts (vla-get-activedocument (vlax-get-acad-object))) '(lambda (x) (setq Layouts@ (cons x Layouts@))) );vlax-map-collection (setq Layouts@ (vl-sort Layouts@ '(lambda (x y) (< (vla-get-taborder x) (vla-get-taborder y))))) (vl-remove "Model" (mapcar '(lambda (x) (vla-get-name x)) Layouts@)));defun GetLayoutList;-------------------------------------------------------------------------------; FindReplace_Support - Checks to see if supporting functions are loaded;-------------------------------------------------------------------------------(defun FindReplace_Support (/ Passed) (setq Passed t) (if (not OpenDwgsCmds) (if (findfile "OpenDwgsCmds.lsp") (load "OpenDwgsCmds.lsp") (setq Passed nil) );if );if (if (or (not GetTiles)(not Set_Value)) (if (findfile "Dcl_Tiles.lsp") (load "Dcl_Tiles.lsp") (setq Passed nil) );if );if (if (or (not GetOK)(not EditBox)) (if (findfile "GetIcon.lsp") (load "GetIcon.lsp") (setq Passed nil) );if );if (if (not Passed) (progn (alert (strcat "FindReplace requires the functions inside of OpenDwgsCmds.lsp," "\nOpenDwgsCmds.dvb, Dcl_Tiles.lsp, Dcl_Tiles.dcl and GetIcon.lsp." "\nDownload the latest versions from AutoLISP Exchange," "\n(URL: http://web2.airmail.net/terrycad).") );alert (exit) );progn );if (progn));defun FindReplace_Support;-------------------------------------------------------------------------------(princ);End of FindReplace.lsp See how that does for you and if needing more post again here p.s. bad formatting with the paste but if you copy and paste into a text file then load it into autocad it should work just fine. Quote
teknomatika Posted October 31, 2013 Author Posted October 31, 2013 Tanks, I appreciate the tip. However, for its functioning are more accurate files, which incidentally found in the author's site. After getting all the files, yet I find that does not fit what I want. As I said, I do not intend to replace text but only select. Quote
pBe Posted October 31, 2013 Posted October 31, 2013 It should be possible to enter the search criteria / selection. What exactly? Quote
teknomatika Posted October 31, 2013 Author Posted October 31, 2013 pBe, anyone. for example, the first character, the first two, first three, etc. Examples: All strings initiated by N (NC, NB, ND, NC, note, nothing, never, ect) All strings initiated by NA (as natural, national, nature, navy, ect) All strings initiated by 12 (123456, 1268, 1299A, 12af, ect) All strings initiated by NAT (natural, national, natura,, ect) Quote
pBe Posted October 31, 2013 Posted October 31, 2013 (edited) pBe,anyone. for example, the first character, the first two, first three, etc. Examples: All strings initiated by N (NC, NB, ND, NC, note, nothing, never, ect) All strings initiated by NA (as natural, national, nature, navy, ect) All strings initiated by 12 (123456, 1268, 1299A, 12af, ect) All strings initiated by NAT (natural, national, natura,, ect) (defun c:demo ( / wc find ss a b) (if (and (setq wc "" find (getstring T "\nEnter String to search: ")) (setq ss (ssget "_x" (list (cons 1 (strcat (while (/= find "") (setq a (substr find 1 1)) (setq wc [color="blue"] (Strcat wc ;;; add more special characters here ;; (if (Setq b (member a '(" " "*"))) (Strcat "`" (Car b)) (Strcat "["(strcase a) (strcase a t)"]")))[/color] find (substr find 2) ) wc ) "*" ) ) (cons 410 (getvar 'ctab)) ) ) ) ) ;;; Do your thing here ;;; (sssetfirst nil ss) ;;; ;;; ) (princ) ) Edited October 31, 2013 by pBe Quote
teknomatika Posted October 31, 2013 Author Posted October 31, 2013 @pBe Well there is. Thanks for the quick and efficient response. Eventually the space (acts as an enter) could be considered as a character in the search, but I give myself satisfied. Quote
pBe Posted October 31, 2013 Posted October 31, 2013 Eventually the space (acts as an enter) could be considered as a character in the search, but I give myself satisfied. You are welcome, Glad i could help. to include spaces " " (setq wc "" find (getstring [b]T [/b] "\nEnter String to search: ")) Cheers Quote
teknomatika Posted October 31, 2013 Author Posted October 31, 2013 You are welcome, Glad i could help. to include spaces " " (setq wc "" find (getstring [b]T [/b] "\nEnter String to search: ")) Cheers Updated and working! Tanks again! Quote
pBe Posted October 31, 2013 Posted October 31, 2013 Updated and working!Tanks again! Right on Have fun playing around with the code teknomatika. Quote
teknomatika Posted April 1, 2014 Author Posted April 1, 2014 pBe i need help: The routine is not running. I do not understand why because it was not changed. Is there any system variable that may be influencing its action? Quote
teknomatika Posted April 1, 2014 Author Posted April 1, 2014 Resolved. The texts that was testing contained a space at the beginning, which confused me. Sorry for the false alert. Quote
Terry Cadd Posted April 28, 2020 Posted April 28, 2020 The website http://web2.airmail.net/terrycad that hosted AutoLISP Exchange, FindReplace and Getting Started with DCL Dialogs has been moved to the new domain https://autolisp-exchange.com . All programs and files are free to download and share. Just click on a button to view the program, then right-click and choose Save as... Quote FindReplace is a text utility to find and replace text in the current drawing or in all open drawings. Quote
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.