Visual LISP, AutoLISP and General Customization

[#1]

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

[#2]

---

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

[#3]

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

[#4]

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

[#5]

thanks guys

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