Jump to content

Select text by inicial character or string

teknomatika

By teknomatika
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

teknomatika Rising Star

teknomatika

Posted
Posted

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.

Link to comment
Share on other sites
Bhull1985 Community Regular

Bhull1985

Posted
Posted

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.

Link to comment
Share on other sites
teknomatika Rising Star

teknomatika

Posted
  • Author
Posted

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.

Link to comment
Share on other sites
teknomatika Rising Star

teknomatika

Posted
  • Author
Posted

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)

Link to comment
Share on other sites
pBe Grand Master

pBe

Posted
Posted (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 by pBe
Link to comment
Share on other sites
teknomatika Rising Star

teknomatika

Posted
  • Author
Posted

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

Link to comment
Share on other sites
pBe Grand Master

pBe

Posted
Posted

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

Link to comment
Share on other sites
teknomatika Rising Star

teknomatika

Posted
  • Author
Posted
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!

Link to comment
Share on other sites
  • 5 months later...
teknomatika Rising Star

teknomatika

Posted
  • Author
Posted

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?

Link to comment
Share on other sites
teknomatika Rising Star

teknomatika

Posted
  • Author
Posted

Resolved. The texts that was testing contained a space at the beginning, which confused me.

Sorry for the false alert.

Link to comment
Share on other sites
  • 6 years later...
Terry Cadd Apprentice

Terry Cadd

Posted
Posted

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.

 

Link to comment
Share on other sites

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.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...