Visual LISP, AutoLISP and General Customization

Visual LISP, AutoLISP and General Customization

Reply
Valued Mentor
Rich.O.3d
Posts: 526
Registered: ‎08-19-2008
Message 1 of 5 (482 Views)

edit attribute text in multiple drawings

482 Views, 4 Replies
09-16-2012 03:51 PM

hi,

 

I need to be able to batch process a bunch of title block attributes automatically.

 

Block Name: Title Block

Tag Name: SH

 

Currently they come out with just the number 1, 2 , 3 etc I need to add a leading zero ie 01, 02, 03 etc

All the scripts I have will just replace the number with another

I just want to append the zero infront of the existing number

ie the code will need to read the existing number and decide if its less than 10. if it is less than 10, then the code just needs to append the leading 0. if its 10 or over, then do nothing.

 

can anyone achieve this please

Cheers

Rich.O

CAD Management 101:
You can do it your own way,
If its done just how I say!
[Metallica:And Justice For All:1988]
*Expert Elite*
pbejse
Posts: 2,482
Registered: ‎11-24-2009
Message 2 of 5 (472 Views)

Re: edit attribute text in multiple drawings

09-16-2012 05:26 PM in reply to: Rich.O.3d

richos69 wrote:

Block Name: Title Block

Tag Name: SH

 

Currently they come out with just the number 1, 2 , 3 etc I need to add a leading zero ie 01, 02, 03 etc

All the scripts I have will just replace the number with another

I just want to append the zero infront of the existing number

ie the code will need to read the existing number and decide if its less than 10. if it is less than 10, then the code just needs to append the leading 0. if its 10 or over, then do nothing.

 

 


 

(defun PrefAtt (bn tag)
  (vlax-for layout (vla-get-layouts
		     (vla-get-activedocument (vlax-get-acad-object))
		   )
    (vlax-for itm (vla-get-block layout)
      (if (and
	    (= (vla-get-objectname itm) "AcDbBlockReference")
	    (= (strcase (vla-get-name itm)) (strcase bn))
	    (= (vla-get-HasAttributes itm) :vlax-true)
	  )
	(foreach tagV (vlax-invoke itm 'GetAttributes)
	  (if (and (eq (vla-get-tagstring tagV) (strcase tag))
		   (< 0 (read (setq str (vla-get-textstring tagV))) 10)
	      )
	    (vla-put-textstring tagV (strcat "0" str))
	  )
	)
      )
    )
  )(princ)
)

 

(prefatt "Title Block" "SH")

 

You can run this with script or modify the code for ODBX use:

(prefatt "Title Block" "SH")

HTH

Distinguished Mentor
_Tharwat
Posts: 612
Registered: ‎07-02-2010
Message 3 of 5 (442 Views)

Re: edit attribute text in multiple drawings

09-17-2012 01:10 AM in reply to: Rich.O.3d

Notings different than pBe 's codes , except it would unlock all layers before sercheaing for specific attributed blocks

and unlocked them back after making the changes if the certeria matched of course .

 

(defun c:TesT (/ Unlock-layers lock-layers l lst ss n e i)
  ;; 		 Tharwat 17. Sep. 2012   			;
  ;; add to the attributed values in Blocks that		;
  ;; are less than 10 to (01, 02, 03, 04, 05, 06, 07, 08, 09,)	;
  (while (setq l (tblnext "LAYER" (null l)))
    (if (eq (Logand 4 (cdr (assoc 70 l))) 4)
      (setq lst (cons (cdr (assoc 2 l)) lst))
    )
  )
  (defun Unlock-layers (layerlist / tbl)
    (foreach x layerlist
      (if (tblsearch "LAYER" x)
        (entmod (subst (cons 70 0) (assoc 70 (setq tbl (entget (tblobjname "LAYER" x)))) tbl))
      )
    )
    (command "_.regen")
  )
  (defun lock-layers (layerlist / tbl)
    (foreach x layerlist
      (if (tblsearch "LAYER" x)
        (entmod (subst (cons 70 4) (assoc 70 (setq tbl (entget (tblobjname "LAYER" x)))) tbl))
      )
    )
    (command "_.regen")
  )
  (if lst
    (Unlock-layers lst)
  )
  (if (setq ss (ssget "_x" '((0 . "INSERT") (66 . 1) (2 . "Title Block"))))
    (repeat (setq i (sslength ss))
      (setq n (entnext (ssname ss (setq i (1- i)))))
      (while (not (eq (cdr (assoc 0 (setq e (entget n)))) "SEQEND"))
        (if (and (eq (cdr (assoc 2 e)) "SH") (numberp (atoi (cdr (assoc 1 e)))) (< (atoi (cdr (assoc 1 e))) 10))
          (entmod (subst (cons 1 (strcat "0" (cdr (assoc 1 e)))) (assoc 1 e) e))
        )
        (setq n (entnext n))
      )
      (setq n nil)
    )
    (princ)
  )
  (if lst
    (lock-layers lst)
  )
  (princ)
)

 Tharwat

____________________________________________________
Get learn and learn and practice , to become experienced guy .
*Expert Elite*
pbejse
Posts: 2,482
Registered: ‎11-24-2009
Message 4 of 5 (408 Views)

Re: edit attribute text in multiple drawings

09-17-2012 05:58 PM in reply to: _Tharwat

Updated code [to remove white spaces]

 

(defun PrefAtt (bn tag)(vl-load-com)
  (vlax-for layout (vla-get-layouts
		     (vla-get-activedocument (vlax-get-acad-object))
		   )
    (vlax-for itm (vla-get-block layout)
      (if (and
	    (= (vla-get-objectname itm) "AcDbBlockReference")
	    (= (strcase (vla-get-name itm)) (strcase bn))
	    (= (vla-get-HasAttributes itm) :vlax-true)
	  )
	(foreach tagV (vlax-invoke itm 'GetAttributes)
	  (if (and (eq (vla-get-tagstring tagV) (strcase tag))
		   (< 0 (setq str (read (vla-get-textstring tagV))) 10)
	      )
	    (vl-catch-all-error-p
	      (vl-catch-all-apply  'vla-put-textstring (list tagV (strcat "0" (Itoa str)))))
	  )
	)
      )
    )
  )(princ)
)

 

HTH

 

 

Valued Mentor
Rich.O.3d
Posts: 526
Registered: ‎08-19-2008
Message 5 of 5 (389 Views)

Re: edit attribute text in multiple drawings

09-18-2012 06:54 PM in reply to: pbejse

thanks guys

I will try out as soon as I get a chance (under pump atm for project deliverables)

CAD Management 101:
You can do it your own way,
If its done just how I say!
[Metallica:And Justice For All:1988]
Announcements
Are you familiar with the Autodesk Expert Elites? The Expert Elite program is made up of customers that help other customers by sharing knowledge and exemplifying an engaging style of collaboration. To learn more, please visit our Expert Elite website.
Need installation help?

Start with some of our most frequented solutions or visit the Installation and Licensing Forum to get help installing your software.