Select Searched String Value in Dims, Texts, MLeaders and MLeaders with Attributed Blocks

[rcb007]

I found a way to search for (Dimensions, Mtext, Text, Multileaders with Text, and the Multileaders with Attributed Blocks using the Find and  Replace command within Autocad.

 

I like the way you can list the results and then create a selection set and highlight of the searched items.

 

 

I did not know if anyone had a quicker way to search for string value which would highlight select the objects. 

 

I was messing around with the below code, but again, not having the same results as the find and replace.

 

;;;https://www.cadtutor.net/forum/topic/74112-lisp-to-select-multiple-text-and-mtext-values-entered/

(defun C:selTxt (/ SS txt)
  (setq txt (getstring "\nSearch Text for Terms: ")) ;hit enter for defult options.
  (if (eq txt "")
    (setq txt "Area*,*m2") ;set defult search options here
  )
  (if (setq SS (ssget "_X" (list '(0 . "MTEXT,TEXT,MULTILEADER,DIMENSION") (cons 1 txt) (cons 410 (getvar 'ctab)))))
    (sssetfirst nil ss)
    (prompt (strcat "\nText doesn't contain " txt))
  )
  (princ)
)

 

Thank you for any ideas for this one.

 

 

 

Edited September 1, 2022 by rcb007

[ronjonp]

You cannot directly filter with code 1 for multileaders, dimensions and long mtext strings.

Edited September 1, 2022 by ronjonp

[ronjonp]

Give this a try:

(defun c:foo (/ _getvalue f s)
  (defun _getvalue (o / r)
    (cond ((and (vlax-method-applicable-p o 'getblockattributevalue) (= 1 (vla-get-contenttype o)))
	   (vlax-for x (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))
				 (vla-get-contentblockname o)
		       )
	     (if (= "AcDbAttributeDefinition" (vla-get-objectname x))
	       (setq r (vla-getblockattributevalue o (vla-get-objectid x)))
	     )
	   )
	   r
	  )
	  ((vlax-property-available-p o 'textstring) (vla-get-textstring o))
	  ((vlax-property-available-p o 'textoverride) (vla-get-textoverride o))
    )
  )
  (cond	((and (setq f (getstring t "\nEnter string to search for: "))
	      (setq s (ssget '((0 . "MULTILEADER,*TEXT,DIMENSION"))))
	 )
	 (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
	   ;; Not case sensitive exact match
	   (or (= (strcase f) (strcase (_getvalue (vlax-ename->vla-object e)))) (ssdel e s))
	   ;; Not case sensitive partial match
;;;       (or (wcmatch (strcase (_getvalue (vlax-ename->vla-object e))) (strcase (strcat "*" f "*")))
;;;	   (ssdel e s)
;;;       )
	 )
	 (sssetfirst nil s)
	)
  )
  (princ)
)

 

[mhupp]

See if this is what you are looking for.  wcmatch and vl-string-search function are both case sensitive so you have to convert ever thing to upper or lower case so they match. unless you want to find the exact text.

 

also might want to add a t to get string if you want to add spaces

(getstring T "\nSearch for Text [Area]: ")

 

;;----------------------------------------------------------------------------;;
;; Searches drawing for Text
(defun C:ST (/ txt ss typ)
  (if (eq (setq txt (strcase (getstring "\nSearch for Text [Area]: "))) "");hit enter for defult options.
    (setq txt "AREA") ;set defult search options here
  )
  (if (setq ss (ssget "_X" (list '(0 . "MTEXT,TEXT,MULTILEADER,DIMENSION") (cons 410 (getvar 'ctab)))))
    (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
      (setq typ (cdr (assoc 0 (entget ent))))
      (cond
        ((member typ '("TEXT" "MTEXT" "MULTILEADER"))
          (setq obj (vlax-ename->vla-object ent)) ;convert to val-object
          (if (vl-string-search txt (strcase (vlax-get obj 'TextString))) 
            (progn) ;if found leave in selection set
            (ssdel ent ss) ;if not found in string remove from selection s
          )
        )
        ((eq typ "DIMENSION") 
          (setq obj (vlax-ename->vla-object ent)) ;convert to val-object
          (if (vl-string-search txt (strcase (vlax-get obj 'TextOverride)))
            (progn) ;if found leave in selection set
            (ssdel ent ss) ;if not found in string remove from selection s
          )
        )
      )
    )
  )
  (if (> (sslength ss) 1) ;if anything is still in the selection set
    (progn
      (prompt (strcat "\n" (itoa (sslength ss)) " Entitys containing \"" txt "\""))
      (sssetfirst nil ss)
    )
    (prompt (strcat "\n" txt "Not Found in Drawing"))
  )
  (princ)
)

 

Edited September 1, 2022 by mhupp

[rcb007]

18 hours ago, ronjonp said:

Give this a try:

(defun c:foo (/ _getvalue f s)
  (defun _getvalue (o / r)
    (cond ((and (vlax-method-applicable-p o 'getblockattributevalue) (= 1 (vla-get-contenttype o)))
	   (vlax-for x (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))
				 (vla-get-contentblockname o)
		       )
	     (if (= "AcDbAttributeDefinition" (vla-get-objectname x))
	       (setq r (vla-getblockattributevalue o (vla-get-objectid x)))
	     )
	   )
	   r
	  )
	  ((vlax-property-available-p o 'textstring) (vla-get-textstring o))
	  ((vlax-property-available-p o 'textoverride) (vla-get-textoverride o))
    )
  )
  (cond	((and (setq f (getstring t "\nEnter string to search for: "))
	      (setq s (ssget '((0 . "MULTILEADER,*TEXT,DIMENSION"))))
	 )
	 (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
	   ;; Not case sensitive exact match
	   (or (= (strcase f) (strcase (_getvalue (vlax-ename->vla-object e)))) (ssdel e s))
	   ;; Not case sensitive partial match
;;;       (or (wcmatch (strcase (_getvalue (vlax-ename->vla-object e))) (strcase (strcat "*" f "*")))
;;;	   (ssdel e s)
;;;       )
	 )
	 (sssetfirst nil s)
	)
  )
  (princ)
)

 

 

Thank you for your help. Ronjon, one question. everything works but without one item. 

I have a multileader block which has 2 attributes,  and one multi-lined text in the block. 

Not quite sure if there was a code that could reach down to that level or not. 

Great job it rocks.

[ronjonp]

5 hours ago, rcb007 said:

 

Thank you for your help. Ronjon, one question. everything works but without one item. 

I have a multileader block which has 2 attributes,  and one multi-lined text in the block. 

Not quite sure if there was a code that could reach down to that level or not. 

Great job it rocks.

You'd have to compile all the attributes in this part of the code. As it stands now, it only grabs the last value that it finds.

	   (vlax-for x (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))
				 (vla-get-contentblockname o)
		       )
	     (if (= "AcDbAttributeDefinition" (vla-get-objectname x))
	       (setq r (vla-getblockattributevalue o (vla-get-objectid x)))
	     )
	   )

 

Honestly I'd stick to the FIND command. The code above will not read attributed blocks either.