Search through block entities

May 11, 2014

I have a block containing some lines representing a device and a number (text) next to it as an index to that device. I insert this block to my drawing. Sometimes I need to change some attributes (XDATA) of that block using an Autolisp routine. However I need to change that number too, say, from no 1 to no 2. How can I search through entities in a block without having to explode it, find the one I want (text) and change it? Is that possible for blocks?

May 11, 2014

Are you after changing an attribute or a single text value ?

Can you upload before and after image or drawing ?

May 11, 2014

A single text value, nothing to do with attributes. The block is only some very simple lines (3~4) and next to them there is a simple text "1" functioning as an index for the user. This dwg is inserted as block in an other main dwg file. It must be inserted always as a block.

May 11, 2014

So you want to search for a specific value in the select blocks or just change all texts values according to user's inputs ?

May 11, 2014

Shut in the dark

(defun c:Test (/ doc ss in)
 ;;    Tharwat 11.May. 2014        ;;
 (if (and (/= (setq in (getstring t "\n Type a text to replace in block :")) "")
          (princ "\n *** Select blocks ***")
          (setq ss (ssget "_:L" '((0 . "INSERT"))))
     )
   (progn (vla-startundomark (setq doc (vla-get-activedocument (vlax-get-acad-object))))
          ((lambda (x / sn en lst nm e el)
             (while (setq sn (ssname ss (setq x (1+ x))))
               (if (not (member (setq nm (cdr (assoc 2 (setq en (entget sn))))) lst))
                 (progn (setq lst (cons nm lst))
                        (setq e (tblobjname "BLOCK" nm))
                        (while (setq e (entnext e))
                          (if (wcmatch (cdr (assoc 0 (setq el (entget e)))) "*TEXT")
                            (entmod (subst (cons 1 in) (assoc 1 el) el))
                          )
                        )
                 )
               )
             )
           )
            -1
          )
          (vla-endundomark doc)
          (vla-regen doc Acallviewports)
   )
 )
 (princ)
)(vl-load-com)

May 11, 2014

Only for text .


(vl-load-com)

(defun C:GZ ()

 (command "undo" "be")
 (setq	olderr	*error*			; Initialize variables
*error*	chgterr
 )

    (setvar "CMDECHO" 0)
   (command "ucs" "w")


  (setq *App (vlax-get-acad-object))
  (setq *Doc (vla-get-ActiveDocument *APP))

   (setq SS (nentsel "\nPlease pick the text: "))
   (setq ENT (entget (car SS)) 
         PT  (cadr SS)
         PT11  PT
     )
 
    (setq ens1 (last SS))

  (if  (not (equal PT ens1 0.1)  )              
  (setq  ens (last (last SS)) 
      mat (RevRefGeom ens)                      
      PT11 (MCS2WCS mat PT11 )                   
      obj (vlax-ename->vla-object ens)
      name (vla-get-name obj)            
   )
   )
  
   (if (= (cdr (assoc 0 ENT)) "TEXT")
       (progn
       (entmake ENT)
(setq ent1 (entlast))
(setq el1  (entget ent1))
     (setq  STR (cdr (assoc 1 ENT)))
   

  
  (setq dq1 (setq dqb1 (assoc 72 el1)))
  (setq dq2 (setq dqb2 (assoc 73 el1)))
  (if (/= dq1 0)
    (progn
      (setq p11 (assoc 11 el1))	
      (setq p11b '(0.0 0.0 0.0))
      (setq el1 (subst (cons 11 p11b) p11 el1)) 
      (setq dq 0)		
      (setq el1 (subst (cons 72 dq) dqb1 el1)) 
      (if (/= dq2 0)
	(setq el1 (subst (cons 73 dq) dqb2 el1))
      )				
      (entmod el1)		
    )
  )




      
      
      
       (setq LST '()) 
       (setq LTT '()) 

       (setq lls "")
       (setq ijk nil)

       (while (/= STR "")
       (setq step 0)
       (if (> (ascii (substr STR 1 1)) 159)
         (progn
           (setq STRI (substr STR 1 2))
           (setq  LST  (cons STRI LST))
           (setq  LST  (cons STRI LST))
           
           (setq  STR  (substr STR 3))

          


         (if (not ijk)
          (progn
          (setq lls (strcat lls STRI))
          (entmod (setq el1 (subst (cons 1 lls)
			     (assoc 1 el1)
			     el1
		      )
	    )
    )  
         
        (if	 (setq xx (CheckWidth ent1 PT11) )
         (progn
           (entdel ent1)  
           (setq   strr  (getstring (strcat "\nPlease enter a new text:[" STRI "]"))
                   LTT    (cons strr LTT)
                   ijk      T
           )
        )
        (setq  LTT  (cons STRI LTT))
        )

        ) ; progn
       (setq  LTT  (cons STRI LTT))
       )
     
     



         )  ;(progn

       (progn
          (if (and (< (asj 2) 159)  (< (asj 3) 159)  (< (asj 4) 159)  (< (asj 5) 159)  (wcmatch (substr STR 1 5) "%%**") )
     ;     (if	(wcmatch (substr STR 1 5) "%%**")
     (if (wcmatch (substr STR 1 5) "%%[0-9][0-9][0-9]")
             
                 (setq STRI (substr STR 1 5)  
                       STR  (substr STR 6)  
                       step  5)
                 (setq STRI (substr STR 1 3) 
                       STR  (substr STR 4)  )
      )	
            			;endif 
      (setq STRI (substr STR 1 1)  STR  (substr STR 2) )
    )
                             
           (setq  LST  (cons STRI LST))
           



         (if (not ijk)
          (progn
          (setq lls (strcat lls STRI))
          (entmod (setq el1 (subst (cons 1 lls)
			     (assoc 1 el1)
			     el1
		      )
	    )
    )  
          
        (if	(setq xx (CheckWidth ent1 PT11) )
        (progn
          (entdel ent1)
          (setq   strr  (getstring (strcat "\nPlease enter a new text:[" STRI "]")))
          (if (= step 5) 
            (progn
            (if (= strr "1") (setq strr "%%129"))
            (if (= strr "2") (setq strr "%%130"))
            (if (= strr "3") (setq strr "%%160"))
            (setq step 0)
            )
          )
             (setq step 0)
              (setq    LTT    (cons strr LTT)
                       ijk     T
          )
         
         )
        (setq  LTT  (cons STRI LTT))
        )

        )
       (setq  LTT  (cons STRI LTT))

       )




         )  ;progn

        )   ; (if (> (ascii (substr STR 1 1)) 159)
     (setq STRI "")
       ) ; while
     ;(entdel ent1)
       (setq LTT (reverse LTT))
       (setq LST (reverse LST))
      
       (setq ttx "")
       (setq kkk 0)
       (while (< kkk (length LTT))
         (setq ttx (strcat ttx (nth kkk LTT)))       
         (setq kkk (1+ kkk))
       )
       (entmod (subst (cons 1 ttx) (assoc 1 ENT) ENT))

       (if  (not (equal PT ens1 0.1)  )          
        (progn

        (setq bbs (ssget "X" '((0 . "insert")) ))
          (setq i 0)
          (while (<  i (sslength bbs) )  

            (setq nai (ssname bbs i)) 
            (setq enn (entget nai))
            (setq nam (cdr (assoc 2 enn)))
            (if (= nam name)
               (progn  (entdel nai) (entdel nai) )
            )
            (setq i ( 1+ i ) )
          )
           
        ; (entdel ens)
         ;(entdel ens)  
       )
       )

       )     
   )


 (setq *error* olderr)			; Restore old *error* handler
 (command "undo" "e")
(command "ucs" "p")
  
   (princ)
     
) ;

(defun ASj (jj0 / asjj)
(setq asjj (ascii (substr STR jj0 1)))  
)


(defun CheckWidth (textent selpt / );ll ur hbox)
 (command "ucs" "Object" textent)
 (setq selpt (trans selpt 0 1))
 (setq	ll   (car (textbox (entget textent)))
ur   (cadr (textbox (entget textent)))
wid  (abs (- (car ur) (car ll)))
wid1 (abs (- (car selpt) (car ll)))
hbox (/ (PickBoxSize) 2.0)
 )
 (command "ucs" "p")
 (if (> wid (- wid1 hbox))
   T
   nil
 )
)

;;---------------------------------------- 

(defun PickBoxSize (/ SS VS PB SWP SHP AR WSD PPDU BOX)
 (setq	SSc   (getvar "SCREENSIZE")	; screen size in pixels 
VS   (getvar "VIEWSIZE")	; screen height in drawing units 
PB   (getvar "pickbox")		; get current pickbox size 
SWP  (car SSc)			; width of screen in pixels 
SHP  (cadr SSc)			; height of screen in pixels 
AR   (/ SWP SHP)		; aspect ratio width/height 
WSD  (* VS AR)			; width of screen dwg units = ratio timesheight 
PPDU (/ WSD SWP)		; pixels per drawing unit 
BOX  (/ (* VS (* 2 PB)) SHP)	; drawing units per pixel 
 )
)


;;; This routine is from gile,I revised some places for a better algorithm.  
;;; Thanks a lot.                                   -highflybird 2009/2/22   
;;; =========================================================================
;;; RefGeom (gile)                                                           
;;; returns a list which first item is a 3x3 transformation matrix (rotation,
;;; scales, normal) and second item the object insertion point in its parent 
;;; (xref, bloc or space)                                                    
;;; Argument : an ename                                                      
;;; =========================================================================
(defun RefGeom (ename / Lst ang Nor mat Org Ins Ax Ay Sx Sy Sz)
 (setq	Lst (entget ename)						; the name of entity
Nor (cdr (assoc 210 Lst))                                       ; normal
Sx  (cdr (assoc 41  Lst))                                       ; X scale factor 
Sy  (cdr (assoc 42  Lst)) 					; Y scale factor 
Sz  (cdr (assoc 43  Lst))					; Z scale factor 
Ang (cdr (assoc 50  Lst))                                       ; rotation angle
Ax  (cos Ang)                                                   ; the value of cosine
Ay  (sin Ang)                                                   ; the value of sine
mat (mxm
      (list
	(trans '(1.0 0.0 0.0) 0 Nor T)				; transform X axis
	(trans '(0.0 1.0 0.0) 0 Nor T)				; transform Y axis
	(trans '(0.0 0.0 1.0) 0 Nor T)				; transform Z axis
      )
      (list
	(list (* Ax Sx) (- (* Ay Sy)) 0.)			; multiple Scale Matrix and rotation Matrix
	(list (* Ay Sx) (* Ax Sy)     0.)
	(list 0.0       0.0           Sz)
      )
    )
Org (cdr (assoc 10 (tblsearch "BLOCK" (cdr (assoc 2 Lst)))))	; get the origin of the block
Ins (trans (cdr (assoc 10 Lst)) Nor 0)				; transformate insertpoint
 )						
 (if (/= Org '(0.0 0.0 0.0))						; if the origin isn't '(0 0 0)
   (setq Ins (mapcar '- Ins (mxv mat Org)))				; then insertpoint needs a displacement
 )
 (setq mat (mapcar 'App2Last mat Ins)                                  ; to make a standard transformation matrix
       mat (App2Last mat '(0.0 0.0 0.0 1.0))
 )
)

;; RevRefGeom (gile)
;; RefGeom inverse function

(defun RevRefGeom (ename / Data ang norm mat ins)
 (setq	Data (entget ename)
ang  (- (cdr (assoc 50 Data)))
norm (cdr (assoc 210 Data))
mat  (mxm
       (list (list (/ 1 (cdr (assoc 41 Data))) 0.0 0.0)
	     (list 0.0 (/ 1 (cdr (assoc 42 Data))) 0.0)
	     (list 0.0 0.0 (/ 1 (cdr (assoc 43 Data))))
       )
       (mxm
	 (list (list (cos ang) (- (sin ang)) 0.0)
	       (list (sin ang) (cos ang) 0.0)
	       '(0.0 0.0 1.0)
	 )
	 (mapcar (function (lambda (v) (trans v norm 0 T)))
		 '((1.0 0.0 0.0) (0.0 1.0 0.0) (0.0 0.0 1.0))
	 )
       )
     )
ins  (mapcar
       '-
       (cdr (assoc 10 (tblsearch "BLOCK" (cdr (assoc 2 Data)))))
       (mxv mat (trans (cdr (assoc 10 Data)) norm 0))
     )
mat  (mapcar 'App2Last mat ins)
mat  (App2Last mat '(0.0 0.0 0.0 1.0))
 )
)

;;; Append a element to the last
(defun App2Last (m v)
 (list (car m) (cadr m) (caddr m) v)
)  


;;; VXV Returns the dot product of 2 vectors
(defun vxv (v1 v2)
 (apply '+ (mapcar '* v1 v2))
)


;;; TRP Transpose a matrix -Doug Wilson-
(defun trp (m)
 (apply 'mapcar (cons 'list m))
)


;;; MXV Apply a transformation matrix to a vector -Vladimir Nesterovsky-
(defun mxv (m v)
 (mapcar '(lambda (r) (vxv r v)) m)
)


;;; MXM Multiply two matrices -Vladimir Nesterovsky-
(defun mxm (m q)
 (mapcar '(lambda (r) (mxv (trp q) r)) m)
)


;;; MCS to WCS -- revised by highflybird
(defun MCS2WCS (mat P / p1)
 (setq p1 (App2Last p 1))
 (list
   (vxv (car mat) p1) 
   (vxv (cadr mat) p1)
   (vxv (caddr mat) p1)
 )
)

May 11, 2014

Thank both of you for your help. However there is an issue with these routines. When I pick the block, the text changes to all copies of that block. My intent is to change only the text of the block I pick. Would that be an issue?

May 11, 2014

Thank both of you for your help. However there is an issue with these routines. When I pick the block, the text changes to all copies of that block. My intent is to change only the text of the block I pick. Would that be an issue?

So you want to pick at the text that is in a block to change its value ?

May 11, 2014

So you want to pick at the text that is in a block to change its value ?

Yes, more or less. To be exact I want to pick the other block with text, say, "2" then some with "1" and finally the selection set I make with "1" becomes "2". I dont need the code for all of that. I just want to know how I could get in the block elements to change that "1" when I store in memory the "2" information.

May 11, 2014

MJLM,

You realize you will also need to change the block name, you cannot have two or more blocks with the same name & different contents, unless you use attributes....(how long have you been using ACAD ?)

May 11, 2014

MJLM,

You realize you will also need to change the block name, you cannot have two or more blocks with the same name & different contents, unless you use attributes....(how long have you been using ACAD ?)

I think I understand what you say. Thanks

May 11, 2014

using attributes would be my recommendation

Sign In

Search through block entities

Recommended Posts

MJLM

Tharwat

MJLM

Tharwat

Tharwat

highflybird

MJLM

Tharwat

MJLM

Snownut

MJLM

dbroada

Join the conversation

Tutorials

Forums

Activity