Finding a word(s) and putting a circle around it?
Hi John,
Here's a quick draft:
(defun c:cfind ( / center cnt lst mat rad str tmp )
(setq rad 12.0 ;; Circle radius
cnt 0
)
(defun center ( obj / llp urp )
(if (and (vlax-method-applicable-p obj 'getboundingbox)
(not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list obj 'llp 'urp))))
)
(apply 'mapcar
(cons '(lambda ( a b ) (/ (+ a b) 2.0))
(mapcar 'vlax-safearray->list (list llp urp))
)
)
'(0.0 0.0)
)
)
(if (/= "" (setq str (strcase (getstring t "\nSpecify word to find: "))))
(progn
(vlax-for blk (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))
(if (= :vlax-false (vla-get-islayout blk))
(vlax-for obj blk
(cond
( (= :vlax-false (vla-get-visible obj)))
( (wcmatch (vla-get-objectname obj) "AcDb*Text")
(if (= (strcase (vla-get-textstring obj)) str)
(setq tmp (cons (center obj) tmp))
)
)
( (and (= "AcDbBlockReference" (vla-get-objectname obj))
(= :vlax-true (vla-get-hasattributes obj))
)
(foreach att (vlax-invoke obj 'getattributes)
(if (= (strcase (vla-get-textstring att)) str)
(setq tmp (cons (center obj) tmp))
)
)
)
)
)
)
(if tmp
(setq lst (cons (cons (vla-get-name blk) tmp) lst)
tmp nil
)
)
)
(vlax-for blk (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))
(if (= :vlax-true (vla-get-islayout blk))
(vlax-for obj blk
(cond
( (wcmatch (vla-get-objectname obj) "AcDb*Text")
(if (= (strcase (vla-get-textstring obj)) str)
(progn
(vla-addcircle blk (vlax-3D-point (center obj)) rad)
(setq cnt (1+ cnt))
)
)
)
( (= "AcDbBlockReference" (vla-get-objectname obj))
(if (= :vlax-true (vla-get-hasattributes obj))
(foreach att (vlax-invoke obj 'getattributes)
(if (= (strcase (vla-get-textstring att)) str)
(progn
(vla-addcircle blk (vlax-3D-point (center obj)) rad)
(setq cnt (1+ cnt))
)
)
)
)
(if (setq tmp (cdr (assoc (vla-get-name obj) lst)))
(progn
(setq mat (refgeom (vlax-vla-object->ename obj)))
(foreach ins tmp
(vla-addcircle blk (vlax-3D-point (mapcar '+ (mxv (car mat) ins) (cadr mat))) rad)
(setq cnt (1+ cnt))
)
)
)
)
)
)
)
)
(cond
( (= 1 cnt)
(princ "\nOne match found.")
)
( (= 0 cnt)
(princ "\nNo matches found.")
)
( (princ (strcat "\n" (itoa cnt) " matches found.")))
)
)
)
(princ)
)
;; RefGeom (gile)
;; Returns a list whose first item is a 3x3 transformation matrix and
;; second item the object insertion point in its parent (xref, block or space)
(defun refgeom ( ent / ang enx mat ocs )
(setq enx (entget ent)
ang (cdr (assoc 050 enx))
ocs (cdr (assoc 210 enx))
)
(list
(setq mat
(mxm
(mapcar '(lambda ( v ) (trans v 0 ocs t))
'(
(1.0 0.0 0.0)
(0.0 1.0 0.0)
(0.0 0.0 1.0)
)
)
(mxm
(list
(list (cos ang) (- (sin ang)) 0.0)
(list (sin ang) (cos ang) 0.0)
'(0.0 0.0 1.0)
)
(list
(list (cdr (assoc 41 enx)) 0.0 0.0)
(list 0.0 (cdr (assoc 42 enx)) 0.0)
(list 0.0 0.0 (cdr (assoc 43 enx)))
)
)
)
)
(mapcar '- (trans (cdr (assoc 10 enx)) ocs 0)
(mxv mat (cdr (assoc 10 (tblsearch "block" (cdr (assoc 2 enx))))))
)
)
)
;; Matrix Transpose - Doug Wilson
;; Args: m - nxn matrix
(defun trp ( m )
(apply 'mapcar (cons 'list m))
)
;; Matrix x Matrix - Vladimir Nesterovsky
;; Args: m,n - nxn matrices
(defun mxm ( m n )
((lambda ( a ) (mapcar '(lambda ( r ) (mxv a r)) m)) (trp n))
)
;; Matrix x Vector - Vladimir Nesterovsky
;; Args: m - nxn matrix, v - vector in R^n
(defun mxv ( m v )
(mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) m)
)
(vl-load-com) (princ)
The above is not compatible with nested blocks however.
Lee
You're welcome John.
A 'malformed list' error would indicate a missing closing parenthesis ")"; since the code performs successfully in my testing, are you certain that you have copied the code correctly?
Lee
Excellent! - I'm delighted to hear that the code is working well.
johnw wrote:
When you have a moment, can you modify the code so it can find a word that is in part of a sentence. I.e. I want to put a circle around the word "OPT." but most of these words are in a sentence like "OPT. SERV. DOOR" or "OPT. LAUNDRY TUB" etc.
This would not be possible to achieve, sorry.
johnw wrote:
PS - I sent you an email yesterday with a programming request.
Received, thank you.
Lee_Mac wrote:
johnw wrote:
When you have a moment, can you modify the code so it can find a word that is in part of a sentence. I.e. I want to put a circle around the word "OPT." but most of these words are in a sentence like "OPT. SERV. DOOR" or "OPT. LAUNDRY TUB" etc.
This would not be possible to achieve, sorry.
To clarify my response - circling the specific word within the sentence would not be possible, but simply detecting the word and circling the entire text object would certainly be possible by switching the "=" operator with the wcmatch function and supplying the program with a wildcard pattern, e.g. "*OPT*".
Lee
Hi John,
Try the following:
(defun c:cfind ( / center cnt lst mat rad str tmp )
(setq rad 12.0 ;; Circle radius
cnt 0
)
(defun center ( obj / llp urp )
(if (and (vlax-method-applicable-p obj 'getboundingbox)
(not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list obj 'llp 'urp))))
)
(apply 'mapcar
(cons '(lambda ( a b ) (/ (+ a b) 2.0))
(mapcar 'vlax-safearray->list (list llp urp))
)
)
'(0.0 0.0)
)
)
(if (/= "" (setq str (strcase (getstring t "\nSpecify word to find: "))))
(progn
(vlax-for blk (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))
(if (= :vlax-false (vla-get-islayout blk))
(vlax-for obj blk
(cond
( (= :vlax-false (vla-get-visible obj)))
( (wcmatch (vla-get-objectname obj) "AcDb*Text")
(if (wcmatch (strcase (vla-get-textstring obj)) str)
(setq tmp (cons (center obj) tmp))
)
)
( (and (= "AcDbBlockReference" (vla-get-objectname obj))
(= :vlax-true (vla-get-hasattributes obj))
)
(foreach att (vlax-invoke obj 'getattributes)
(if (wcmatch (strcase (vla-get-textstring att)) str)
(setq tmp (cons (center obj) tmp))
)
)
)
)
)
)
(if tmp
(setq lst (cons (cons (vla-get-name blk) tmp) lst)
tmp nil
)
)
)
(vlax-for blk (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))
(if (= :vlax-true (vla-get-islayout blk))
(vlax-for obj blk
(cond
( (wcmatch (vla-get-objectname obj) "AcDb*Text")
(if (wcmatch (strcase (vla-get-textstring obj)) str)
(progn
(vla-addcircle blk (vlax-3D-point (center obj)) rad)
(setq cnt (1+ cnt))
)
)
)
( (= "AcDbBlockReference" (vla-get-objectname obj))
(if (= :vlax-true (vla-get-hasattributes obj))
(foreach att (vlax-invoke obj 'getattributes)
(if (wcmatch (strcase (vla-get-textstring att)) str)
(progn
(vla-addcircle blk (vlax-3D-point (center obj)) rad)
(setq cnt (1+ cnt))
)
)
)
)
(if (setq tmp (cdr (assoc (vla-get-name obj) lst)))
(progn
(setq mat (refgeom (vlax-vla-object->ename obj)))
(foreach ins tmp
(vla-addcircle blk (vlax-3D-point (mapcar '+ (mxv (car mat) ins) (cadr mat))) rad)
(setq cnt (1+ cnt))
)
)
)
)
)
)
)
)
(cond
( (= 1 cnt)
(princ "\nOne match found.")
)
( (= 0 cnt)
(princ "\nNo matches found.")
)
( (princ (strcat "\n" (itoa cnt) " matches found.")))
)
)
)
(princ)
)
;; RefGeom (gile)
;; Returns a list whose first item is a 3x3 transformation matrix and
;; second item the object insertion point in its parent (xref, block or space)
(defun refgeom ( ent / ang enx mat ocs )
(setq enx (entget ent)
ang (cdr (assoc 050 enx))
ocs (cdr (assoc 210 enx))
)
(list
(setq mat
(mxm
(mapcar '(lambda ( v ) (trans v 0 ocs t))
'(
(1.0 0.0 0.0)
(0.0 1.0 0.0)
(0.0 0.0 1.0)
)
)
(mxm
(list
(list (cos ang) (- (sin ang)) 0.0)
(list (sin ang) (cos ang) 0.0)
'(0.0 0.0 1.0)
)
(list
(list (cdr (assoc 41 enx)) 0.0 0.0)
(list 0.0 (cdr (assoc 42 enx)) 0.0)
(list 0.0 0.0 (cdr (assoc 43 enx)))
)
)
)
)
(mapcar '- (trans (cdr (assoc 10 enx)) ocs 0)
(mxv mat (cdr (assoc 10 (tblsearch "block" (cdr (assoc 2 enx))))))
)
)
)
;; Matrix Transpose - Doug Wilson
;; Args: m - nxn matrix
(defun trp ( m )
(apply 'mapcar (cons 'list m))
)
;; Matrix x Matrix - Vladimir Nesterovsky
;; Args: m,n - nxn matrices
(defun mxm ( m n )
((lambda ( a ) (mapcar '(lambda ( r ) (mxv a r)) m)) (trp n))
)
;; Matrix x Vector - Vladimir Nesterovsky
;; Args: m - nxn matrix, v - vector in R^n
(defun mxv ( m v )
(mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) m)
)
(vl-load-com) (princ)
The above will allow you to specify wildcard patterns, e.g. *OPT*
johnw wrote:
Lee, will this command also find words inside a "block"?
Yes, but not within nested blocks (though, with some time it could be made to do so)
