Script to Change Attribute

[matthewrussell]

Hey guys,

 

I was wondering if there is a script you can write to change a certain value of a praticular attribute.

 

This is because I need to often change the value of the revision of the drawing on many drawings at once and it would be a lot easier if there was a script or a Lisp or anything to do this instead of opening all the drawings which i need to change

 

Cheers

[askrius]

Hey guys,

 

I was wondering if there is a script you can write to change a certain value of a praticular attribute.

 

This is because I need to often change the value of the revision of the drawing on many drawings at once and it would be a lot easier if there was a script or a Lisp or anything to do this instead of opening all the drawings which i need to change

 

Cheers

 

I did this via VBA for an internal tool. Cannot post any code (employment agreement prohibits it), but I can say its not too hard to accomplish

[Lee Mac]

Can a LISP be called through VBA?

 

Because writing a LISP to accomplish a task such as this is pretty simple, but obviously the LISP cannot open and close drawings.

[BIGAL]

I can give it in VBA as below

 

Public Sub issued_for_construction()
' This Updates the Issued for construction and sets rev 0

Dim SS As AcadSelectionSet
Dim Count As Integer
Dim FilterDXFCode(1) As Integer
Dim FilterDXFVal(1) As Variant
Dim attribs As Variant
Dim BLOCK_NAME As String
On Error Resume Next
FilterDXFCode(0) = 0
FilterDXFVal(0) = "INSERT"
FilterDXFCode(1) = 2
FilterDXFVal(1) = "DA1DRTXT"
BLOCK_NAME = "DA1DRTXT"
Set SS = ThisDrawing.SelectionSets.Add("issued")
SS.Select acSelectionSetAll, , , FilterDXFCode, FilterDXFVal

For Cntr = 0 To SS.Count - 1
  attribs = SS.Item(Cntr).GetAttributes


       attribs(0).TextString = "ISSUED FOR CONSTRUCTION"
       attribs(3).TextString = "0"

       attribs(0).Update
       attribs(3).Update

Next Cntr
ThisDrawing.SelectionSets.Item("issued").Delete
'DO AGAIN FOR REVTABLE
'DATE
'Dim MyDate
'MyDate = Date
Call DashDate
FilterDXFCode(1) = 2
FilterDXFVal(1) = "REVTABLE"
BLOCK_NAME = "REVTABLE"
Set SS = ThisDrawing.SelectionSets.Add("revs")
SS.Select acSelectionSetAll, , , FilterDXFCode, FilterDXFVal

For Cntr = 0 To SS.Count - 1
  attribs = SS.Item(Cntr).GetAttributes


       attribs(0).TextString = "0"
       attribs(1).TextString = DashDate
       attribs(2).TextString = "ISSUED FOR CONSTRUCTION"



       attribs(0).Update
       attribs(1).Update
       attribs(2).Update

Next Cntr
ThisDrawing.SelectionSets.Item("revs").Delete
MsgBox "Drawing now changed to Issued for Construction"
End Sub

 

 

just do the following in a menu etc or call form a lisp keystroke say "I0"

 

^C^C(vl-vbaload "issued.dvb") (vl-vbarun "issued_for_construction")

 

 

sorry almost forgot script

 

open dwg1 (vl-vbaload "issued.dvb") (vl-vbarun "issued_for_construction") close y

open dwg2 (vl-vbarun "issued_for_construction") close y

open dwg3 (vl-vbarun "issued_for_construction") close y

[matthewrussell]

How does that work. As in how does it find the right attribute to add the Values into?

[JeepMaster]

Here's a really good one from ASMI.

;; ====================================================================    ;;
;;                                                                   ;;
;;  CHAT.LSP - The program for change attributes with the chosen       ;;
;;              value in dynamic and ordinary blocks.                   ;;
;;                                                                   ;;
;; ==================================================================== ;;
;;                                                                   ;;
;;  Command(s) to call: CHAT                                           ;;
;;                                                                   ;;
;;  Pick sample attribute for filter creation, and after that select    ;;
;;  blocks containing this attribute. The program will request to enter ;;
;;  replaced value (the specified attribute by default) and if          ;;
;;  attributes are found will highlight blocks and will request         ;;
;;  new value.                                                          ;;
;;                                                                   ;;
;; ====================================================================    ;;
;;                                                                   ;;
;;  THIS PROGRAM AND PARTS OF IT MAY REPRODUCED BY ANY METHOD ON ANY       ;;
;;  MEDIUM FOR ANY REASON. YOU CAN USE OR MODIFY THIS PROGRAM OR      ;;
;;  PARTS OF IT ABSOLUTELY FREE.                             ;;
;;                                                                   ;;
;;  THIS PROGRAM PROVIDES THIS PROGRAM 'AS IS' WITH ALL FAULTS AND      ;;
;;  SPECIFICALLY DISCLAIMS ANY IMPLIED WARRANTY OF MERCHANTABILITY         ;;
;;  OR FITNESS FOR A PARTICULAR USE.                         ;;
;;                                                                   ;;
;; ====================================================================    ;;
;;                                                                   ;;
;;  V1.1, 18th Aug 2008, Riga, Latvia                                      ;;
;;  © Aleksandr Smirnov (ASMI)                                     ;;
;;  For AutoCAD 2000 - 2008 (isn't tested in a next versions)        ;;
;;                                                                   ;;
;;                                      http://www.asmitools.com       ;;
;;                                     ;;
;; ====================================================================    ;;


(defun c:chat(/ cAtt cBl cTag efNm sStr nLst fSet oVal fLst exLst
          fStr actDoc atLst pLst cFrom cTo sucCnt errCnt wSet)

 (vl-load-com)

 (if
   (and
     (setq cAtt(nentsel "\nPick sample attribute > "))
     (= "ATTRIB"(cdr(assoc 0(entget(car cAtt)))))
     ); end and
   (progn
     (setq actDoc(vla-get-ActiveDocument
           (vlax-get-acad-object))
       cBl(vla-ObjectIDtoObject actDoc
        (vla-get-OwnerID
          (setq cAtt
            (vlax-ename->vla-object(car cAtt)))))
       cTag(vla-get-TagString cAtt)
       sucCnt 0 errCnt 0
       wSet(ssadd)
       ); end setq
     (if(vlax-property-available-p cBl 'EffectiveName)
   (progn
     (setq fStr(vla-get-EffectiveName cBl)
       nLst(mapcar 'vla-get-Name
              (vl-remove-if-not
                (function(lambda(x)
              (equal fStr(vla-get-EffectiveName x))))
                    (mapcar 'vlax-ename->vla-object
                      (vl-remove-if 'listp 
                                (mapcar 'cadr(ssnamex
                      (ssget "_X" '((0 . "INSERT")
                    (66 . 1)(2 . "`*U*,")))))))))
       ); end setq
      (foreach n nLst
        (if(not(member n exLst))
            (setq fStr(strcat "`" n "*," fStr)
              exLst(cons n exLst)
              ); end setq
          ); end if
        ); end foreach
     (setq fLst(list '(0 . "INSERT")(cons 2 fStr)))
     ); end progn
   (setq fLst(list '(0 . "INSERT")(cons 2(vla-getName cBl))))
   ); end if
     (princ "\n<<< Select blocks >>> ")
     (if(setq fSet(ssget fLst))
   (progn
     (princ(strcat "\n" (itoa(sslength fSet)) " block(s) found. "))
       (setq cFrom(getstring T
            (strcat "\nChange from <"
                (setq oVal(vla-get-TextString cAtt)) ">: ")))
     (if(= "" cFrom)(setq cFrom oVal))
     (foreach b(mapcar 'vlax-ename->vla-object
                      (vl-remove-if 'listp 
                                (mapcar 'cadr(ssnamex fSet))))
       (setq atLst(vlax-safearray->list
            (vlax-variant-value
              (vla-GetAttributes b))))
       (foreach at atLst
            (if(and
              (equal(vla-get-TagString at)cTag)
              (equal(vla-get-TextString at)cFrom)
             ); end and
            (progn
              (setq pLst(cons at pLst))
              (ssadd(vlax-vla-object->ename b)wSet)
            ); end progn
          ); end if
         ); end foreacn
       ); end foreach
     (if(/= 0(length pLst))
       (progn
         (princ
       (strcat "\n" (itoa(length pLst)) " attribute(s) found. ")
       ); end princ
         (sssetfirst nil wSet)
         (if
           (and
             (setq cTo(getstring T "\nChange to: "))
             (/= "" cTo)
             ); end and
           (progn
        (sssetfirst nil nil)
            (vla-StartUndoMark actDoc)
             (foreach a pLst
                (if(vl-catch-all-error-p
                 (vl-catch-all-apply 'vla-put-TextString
                     (list a cTo)))
                  (setq errCnt(1+ errCnt))
                  (setq sucCnt(1+ sucCnt))
                  ); end if
               ); end foreach
            (princ
              (strcat "\n" (itoa sucCnt) " of "
              (itoa(length pLst))" attributes changed. ")
          ); end princ
        (if(/= 0 errCnt)
          (princ(strcat(itoa errCnt) " were on locked layer! "))
          ); end if
        (vla-EndUndoMark actDoc)
        ); end progn
       ); end if
     ); end progn
       (princ
         (strcat "\nCan't to find attributes with '"
             cFrom "' value!"))
       ); end if
     ); end progn
   ); end if
     ); end progn
   (princ "\n It isn't attribute  ")
   ); end if
 (princ)
 ); end of c:chatt

(princ "\n*** Type CHAT for change of attributes with the chosen value. ***")
         

[CmdrDuh]

I use VBA and i call the block by name, and then the tag by name. then just edit the value

[CmdrDuh]

Bigal is doing it here

FilterDXFCode(0) = 0
FilterDXFVal(0) = "INSERT"
FilterDXFCode(1) = 2
FilterDXFVal(1) = "DA1DRTXT"
BLOCK_NAME = "DA1DRTXT"
Set SS = ThisDrawing.SelectionSets.Add("issued")
SS.Select acSelectionSetAll, , , FilterDXFCode, FilterDXFVal

For Cntr = 0 To SS.Count - 1
  attribs = SS.Item(Cntr).GetAttributes


       attribs(0).TextString = "ISSUED FOR CONSTRUCTION"
       attribs(3).TextString = "0"

       attribs(0).Update
       attribs(3).Update

Next Cntr

where he knows that of the 4 (presumed) attributes, he wants to update #1 and #4 (being 0 based)

[BIGAL]

Sorry guys a bit more info DA1DRTXT is an A1 title block thats it name. It has about 10 attributes but I only need to change the first and 4th ie attrib(0) & attrib(3).

 

Try the code with your block name and just change the attribute number start with 0 to see which number you need to use.

 

Also try double click your block and "eattedit" should come up and just count down starting with zero in the info on the screen for editing attributes to work out the number.

 

You may find if you run it multiple times it will give an error its beacuse its creating the selection set a 2nd time just add

ThisDrawing.SelectionSets.Item("issued").Delete

[nkotiga]

Hello!

I need litle help about AutoCAD script. I use AutoCAD map 2009 and I try to make script to change color in block (block name „kc“) from red to ByLayer!! The script need to do this with every block named „kc“ in sheet. I appreciate any help!

[dbroada]

Please don't tag questions on to the end of another thread, it will often get missed.

 

If you are asking to change all the blocks named "kc" in your drawing then you don't need script or LISP or VBA. Just redefine it once using BEDIT and all the blocks will be updated. If however you need to change all the kc blocks in many drawings then you will need a different approach.

[nkotiga]

Please don't tag questions on to the end of another thread, it will often get missed.

 

If you are asking to change all the blocks named "kc" in your drawing then you don't need script or LISP or VBA. Just redefine it once using BEDIT and all the blocks will be updated. If however you need to change all the kc blocks in many drawings then you will need a different approach.

 

 

THANKS....drinks on me8)