Add new attribute to multiple existing blocks

[Beni88]

Hi there

Im a very beginner at using lisp, so help would come in handy.

 

Couldnt find anything on the web for this precise issue.

I have a dwg containing hundreds of blocks, each with the same attribute tags and different values (eg Name, Model, Size..). This is my library, which needs to be modified in the same manner. I need a new attribute *Price* added to all blocks, i will enter the value manually later on. Is it possible to add this new attribute automatically without exploding the existing blocks? I guess it has to be done with lisp?

Thank you for any help!

 

[Cad64]

No, you don't need a lisp routine. Just edit the block, add the new attribute, save and exit the editor. Then insert the new edited block and run the ATTSYNC command to update all blocks with the same name.

[Beni88]

The blocks have each a unique name..its their structure (layers etc) that is the same. So its hundreds of different blocks, but they all need the new attribute

[rlx]

maybe this function from Lee works?

 

http://www.lee-mac.com/addobjectstoblock.html

 

else check this link :

 

https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/lisp-to-select-blocks-and-add-attributes/td-p/6869077/page/2

 

 

Edited January 25, 2019 by rlx

[Beni88]

Hi rlx

 

Thank you! The second link helped a lot. I can add the Attribute now to multiple blocks, and was able to change its Name and pre set value.

But how do I change the new Attribute to be invisible?

 

This is the code I used for now:

(defun c:add$ ( / ss i blk blks def AttObj)
    (and
       (setq ss (ssget '((0 . "INSERT"))))
       (setq i (sslength ss))
       (while (> i 0)
          (setq blk (cdr (assoc 2 (entget (ssname ss (setq i (1- i)))))))
          (if (not (vl-position blk blks))(setq blks (cons blk blks)))
       )
    )
    (foreach blk blks
         (setq def (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) blk))
         (setq AttObj
            (vla-addattribute def
              8
              acattributemodelockposition
              "Enter Item #"
              (vlax-3D-point 72 84)
              "PRICE\U+0020"
              "100"
            )
         )
         (vlax-put AttObj 'Alignment acAlignmentmiddle) ;; 4
         (command "_.attsync" "_N" blk)
     )
    (princ)
)
(vl-load-com) (princ)

Further on, after applying this code to my database dwg-file with all my blocks in it, I will fill in the price for each block in the properties section with the new Attribute "PRICE". How can I automatically sychronize every drawing (or at least the one I open) so that the new Attribute "Price" including it's set value will be up to date for every block in this particular dwg?

[rlx]

to put an attribute invisible read this :

 second part of your question would need more info , like sample drawing , source of your pricelist (xls , txt?) and above all more time than I have right now (today anyway)

[BIGAL]

Just a thought if the attribute price is the last attribute in the creation order then its easy when you do a vl  'getattributes you can get the count of attributes as well so last attribute can be found.

 

A txt file with a list of block names  would stop it updating wrong blocks. An alternative is say a excel then a csv output of name,att position,price this has advantage if you move attribute order. On startup a read excel could be done also.

Edited January 30, 2019 by BIGAL

[Beni88]

Hi all

I'm very late with following up on the issue of the additional attribute, which I thought I had the solution that I needed. Sorry for the delay and thank you for any help up till now!!

I'll try to explain my issue more thoroughly this time

 

My problem is this:

I have 200+ different blocks (chair, desk, lamp..) in one dwg. They all have the same stucture (Layer, Attributes) but different values for the Attibutes (eg. Name, Size, Model and so on..).

That's my library drawing. I use the acad tool bar which allows me to drag and drop these blocks into any drawing I like. And so I used these blocks in many different drawings already.

 

Now with the code below, I added ONE new Attribute 'Price' to each block in my library. Unfortunately, I still had to change the value for the attribute 'Price' manually, since they are different for each block (each item has a different price obviously). And because they need to be the set value, I had to do this using battman.

 

This is the code I used:

(defun c:add$ ( / ss i blk blks def AttObj)
    (and
       (setq ss (ssget '((0 . "INSERT"))))
       (setq i (sslength ss))
       (while (> i 0)
          (setq blk (cdr (assoc 2 (entget (ssname ss (setq i (1- i)))))))
          (if (not (vl-position blk blks))(setq blks (cons blk blks)))
       )
    )
    (foreach blk blks
         (setq def (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) blk))
         (setq AttObj
            (vla-addattribute def
              0.07
               acAttributeModeInvisible
              ""
              (vlax-3D-point 72 84)
              "PRICE"
              "338"
            )
         )
         (vlax-put AttObj 'Alignment acAlignmentmiddle) ;; 4
         (command "_.attsync" "_N" blk)
     )
    (princ)
)
(vl-load-com) (princ)

 

Now, if I create a new drawing and insert any block from my library drawing, the block including the new attribute 'Price' is correct and has already the right value in it. So later on, I can extract the data into an xls-file.

 

But I would like to 'update' my preexisting drawings as well. In those, the blocks are of course still without the new attribute 'Price'. I tried to insert using WBLOCK, but that would mean I have to do this for every single block. I usually have dozens of different blocks in one drawing and can't use WBLOCK for every single one of them.

Also using WBLOCK, the color and layer changes back to 'Layer 0' and Color 'from Layer' .

 

Is there a routine which at least allows me to insert my whole 'library' (not just one block!) into a drawing, and updates (sync) the older blocks in it at once?

Or is there a simpler way to do this?

 

Thank you so much for any help!

 

example_1.dwg

[BIGAL]

Maybe look at lee-mac steal.lsp it can bring in blocks from another dwg. Not sure about the overwrite bit.

 

Thinking a bit more a script may do it using repeat for every block not tested.

-insert c:\\mydwh\\myblocksbybeni88\\block1 Y

-insert c:\\mydwh\\myblocksbybeni88\\block2 Y

 

 

[Beni88]

I tried Lee Mac's lsp, but the script steal.lsp can only insert blocks that aren't already in the drawing. So I don't even know if the overwrite is working or not..

 

Second part of your answer makes sense, but I wouldn't know where to start with writing that kind of script. I found a script online which creates a wblock for each block of my library drawing and saves it to some folder.

So I need the script to repeadetly insert every wblock from this specific folder into my new drawing, chooses Y to update the existing blocks (IF the specific block is in the new drawing), deletes the block afterwards and syncs all blocks?

Edited April 28, 2019 by Beni88

[BIGAL]

Ok lets go back to the drawing board, step one export out all blocknames to a text file, which is your master dwg.

 

Add , price   --> blkname,100

 

Add price with  value to every block. 

 

this needs the code above to read the file probably best to copy and call "add-update price"

 

you can do as many as you like in one go using a srcript it would look like this

Open dwg1
(load "add price lisp")
close Y
Open dwg2
(load "add price lisp")
close Y
Open dwg3
(load "add price lisp")
close Y

 

To run the lisp on loading as per code posted just add (c:add-price$) as a last line in your lisp this will auto run it. Note new name of defun. You could preload but will keep simple. Replace "338" with the value of the price in code.

 

Needed

The update lisp needs to be re-written.

There is a lot of code out there to write block name need to find, I may have somewhere.

 

Edited April 29, 2019 by BIGAL

[BIGAL]

Ok try this let me know

 

this will output block names to a file change in both codes you need to edit the file to the block list you want.

; dump blocknames to file c:\acadtemp\blocks.txt

; By Alan H April 2019

(defun write-blks ( /  blkname block fname)
(setq fname (open "C:\\Acadtemp\\blocks.txt" "w"))
(vlax-for block (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) 
(if   (not (wcmatch (strcase (vla-get-name block) t) "*_space*")) 
(progn
(setq blkname (vla-get-name block))
(write-line (strcat blkname "," "0") fname)
)
)
)
(close fname)
)
(write-blks)

 

; update a list of blocks and add an attribute
; update the attribute value at same time
; By Alan H April 2019
 

; thanks to Lee-mac for this defun
(defun _csv->lst ( str / pos )
(if (setq pos (vl-string-position 44 str))
    (cons (substr str 1 pos) (_csv->lst (substr str (+ pos 2))))
    (list str)
    )
)

(setq fname (open "c:\\acadtemp\\blocks.txt" "R"))
(setq lst '())
(while (setq blkval(read-line fname))
(setq lst (cons (_csv->lst blkval) lst))
)
(close fname)

 

(defun find-it (blknames / )
(setq val nil)
(setq x 0)
(repeat (length lst)
(setq blkval (nth x lst))
(if (= (nth 0 blkval) blknames)
(setq val (nth 1 blkval))
)
(setq x (+ x 1))
)
)

 

(defun add-price$ ( / blk blks def AttObj)
 (setq blks (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))))
    (vlax-for blk blks
    (setq blkname (strcase (vla-get-name blk) t))
    (if   (not (wcmatch blkname "*_space*")) 
    (progn
    (find-it blkname)
    (if (/= val nil)
    (progn
         (setq AttObj
            (vla-addattribute blk
              0.07
              acAttributeModeInvisible
              "Enter price"
              (vlax-3D-point 72 84)
              "PRICE"
              val
            )
         )
         (vlax-put AttObj 'Alignment acAlignmentmiddle) ;; 4
         (command "_.attsync" "_N" blkname)
     )
     )
     )
     )
     )
    (princ)
)

 

(vl-load-com) (princ)

 

(add-price$)

 

Edited April 29, 2019 by BIGAL

[Beni88]

Hi BIGAL

 

The first script works and creates the text file. But I don't think I understand what the second script is supposed to do....and it is not working (file nil it says)?

 

I could now create a text file (master list) with row 1 (Name of the block --> thanks to script one) and row 2 (price for this particular block --> manually). So all I need is a script which I can run in any drawing I like, and this script will add the new attribute PRICE to every block in the drawing which matches the master list. And it should get the actual price for each blog in that list..

 

 

So, check for every block in drawing

  for each blog that is also in the master list

    add attribute price

    add price from master list for this block name

 

something like that..

[BIGAL]

We need a sample dwg either with price added or better two dwgs one with one without, only need a few blocks say at least 3. Youcan make the blocks dumb like a sq so long as they have attributes.

[Beni88]

Alright, here are the 2 files. Each containes the same 4 blocks, with or without the price ("Preis") attribute.

 

Please note that for 2 blocks, the price is not the 'set value', just the value in this drawing. The script which I used didn't add the price as 'set value'. For 2 blocks, I already changed this manually.

 

Thank you so much!!

example_w_price.dwg example_without_price.dwg

[Beni88]

Hi BIGAL

 

It isn't that easy right? I'm still trying myself...Or were you able to build something?

[ammobake]

Might it be possible to create a standalone attribute (price) then assign it to each block in the library via lisp from a master pricing spreadsheet?  In theory, inserting it as a standalone attribute would then let you have multiple blocks with different pricing?

Lisp isn't really my thing lol so I'm not an expert.

 

-ChriS

[Beni88]

Hi ChriS

 

Sorry, my Lisp is enexistent  not sure it would work your way tho.

 

 

I have found this amazing routine from LeeMac which updates the attributes of all mentioned blocks in a drawing according to a csv file. The only thing that is missing is the creation of the additional PRICE attribute, if there is a block whithout it yet. Otherwise I think this could work for me:

;;-----------------------=={ Update Attributes }==----------------------;;
;;                                                                      ;;
;;  Reads a CSV file containing attribute data, and, should the drawing ;;
;;  name of the current drawing appear in the first column of the CSV   ;;
;;  Drawing List, the program will proceed to update block attributes.  ;;
;;                                                                      ;;
;;  The attributes updated will be those with tags corresponding to the ;;
;;  CSV column headings. These will be updated with values from the     ;;
;;  row in which the drawing file is listed.                            ;;
;;                                                                      ;;
;;  -------------------------------------                               ;;
;;  Example of CSV format:                                              ;;
;;  -------------------------------------                               ;;
;;                                                                      ;;
;;  +------------+-----------+-----------+----------+-----+----------+  ;;
;;  |    DWG     |  Layout*  |   Block*  |   TAG1   | ... |   TAGN   |  ;;
;;  +------------+-----------+-----------+----------+-----+----------+  ;;
;;  |  Drawing1  |  Layout1  |   Block1  |  Value1  | ... |  ValueN  |  ;;
;;  +------------+-----------+-----------+----------+-----+----------+  ;;
;;  |  Drawing1  |  Layout2  |   Block1  |  Value1  | ... |  ValueN  |  ;;
;;  +------------+-----------+-----------+----------+-----+----------+  ;;
;;  |  Drawing2  |  Layout1  |   Block2  |  Value1  | ... |  ValueN  |  ;;
;;  +------------+-----------+-----------+----------+-----+----------+  ;;
;;  |    ...     |    ...    |    ...    |    ...   | ... |    ...   |  ;;
;;  +------------+-----------+-----------+----------+-----+----------+  ;;
;;                                                                      ;;
;;  *Layout & Block Name columns are optional.                          ;;
;;                                                                      ;;
;;  -------------------------------------                               ;;
;;  Possible Warnings:                                                  ;;
;;  -------------------------------------                               ;;
;;  -  Without a block filter or block name column the code will        ;;
;;     update ALL attributed blocks with tags listed in the CSV         ;;
;;     headings.                                                        ;;
;;                                                                      ;;
;;  -  Currently designed to run on startup - add to either             ;;
;;     Startup-Suite or ACADDOC.lsp to update blocks when drawing is    ;;
;;     opened. To disable code running when loaded, remove (c:utb)      ;;
;;     from the bottom of the code.                                     ;;
;;                                                                      ;;
;;----------------------------------------------------------------------;;
;;  Author:  Lee Mac, Copyright © 2011  -  www.lee-mac.com              ;;
;;----------------------------------------------------------------------;;
;;  Version 1.0    -    2011-01-12                                      ;;
;;                                                                      ;;
;;  - First release.                                                    ;;
;;----------------------------------------------------------------------;;
;;  Version 1.1    -    2011-01-13                                      ;;
;;                                                                      ;;
;;  - Added optional 'Layout' column (next to DWG Column) to allow      ;;
;;    multiple titleblocks to be updated with different information     ;;
;;    within a single drawing.                                          ;;
;;----------------------------------------------------------------------;;
;;  Version 1.2    -    2011-08-28                                      ;;
;;                                                                      ;;
;;  - Removed case-sensitivity of drawing file column in CSV.           ;;
;;----------------------------------------------------------------------;;
;;  Version 1.3    -    2011-12-27                                      ;;
;;                                                                      ;;
;;  - Revised the code to correctly process CSV files generated using   ;;
;;    OpenOffice software.                                              ;;
;;----------------------------------------------------------------------;;
;;  Version 1.4    -    2012-01-16                                      ;;
;;                                                                      ;;
;;  - Updated the 'ReadCSV' local function to correctly read CSV cells  ;;
;;    containing commas and quotes.                                     ;;
;;----------------------------------------------------------------------;;
;;  Version 1.5    -    2012-09-19                                      ;;
;;                                                                      ;;
;;  - Updated CSV file parser function to account for the use of        ;;
;;    alternative cell delimiter characters in CSV file (such as a      ;;
;;    semi-colon).                                                      ;;
;;----------------------------------------------------------------------;;
;;  Version 1.6    -    2013-05-22                                      ;;
;;                                                                      ;;
;;  - Removed the need for file extension in first column of CSV file.  ;;
;;  - Updated CSV file parser function to correct bug.                  ;;
;;----------------------------------------------------------------------;;
;;  Version 1.7    -    2014-11-01                                      ;;
;;                                                                      ;;
;;  - Fixed bug causing filenames containing ASCII character 46 (point) ;;
;;    to not be found in the first column of the CSV file.              ;;
;;----------------------------------------------------------------------;;
;;  Version 1.8    -    2015-04-13                                      ;;
;;                                                                      ;;
;;  - Added support for duplicate attribute tags.                       ;;
;;  - Added support for optional 'Block Name' column in CSV file.       ;;
;;  - Added inclusion of anonymous block names to optional block name   ;;
;;    filter to enable dynamic block support.                           ;;
;;----------------------------------------------------------------------;;
;;  Version 1.9    -    2016-09-18                                      ;;
;;                                                                      ;;
;;  - Fixed implementation of block filter when processing attributed   ;;
;;    dynamic blocks.                                                   ;;
;;----------------------------------------------------------------------;;

(defun c:utb

    (
        /
        *error*
        ano
        bln bno
        csv
        ent
        flg fnb:fun
        inc
        lst
        sel str
        tag
        utb:blk utb:csv utb:ftr utb:lay
        val
    )

;;----------------------------------------------------------------------;;
;; Location of CSV Drawing List (set to nil for prompt)                 ;;
;;                                                                      ;;
;; If the CSV file resides in the same directory as the drawing, omit   ;;
;; the filepath from the location of the CSV file, and only include     ;;
;; the filename, e.g. "myfile.csv"                                      ;;
;;                                                                      ;;
;; If only a filename is specified, AutoCAD will first search the       ;;
;; working directory for this file before searching the Support Paths.  ;;
;;----------------------------------------------------------------------;;
  
    (setq utb:csv nil) ;; e.g. (setq utb:csv "C:/myfolder/myfile.csv")

;;----------------------------------------------------------------------;;
;; Block Filter (may use wildcards and may be nil)                      ;;
;;----------------------------------------------------------------------;;

    (setq utb:ftr nil)  ;; e.g. (setq utb:ftr "*BORDER")

;;----------------------------------------------------------------------;;
;; Layout Column (t or nil)                                             ;;
;;----------------------------------------------------------------------;;

    (setq utb:lay t)    ;; set to t if CSV file contains Layout Column

;;----------------------------------------------------------------------;;
;; Block Name Column (t or nil)                                         ;;
;;----------------------------------------------------------------------;;

    (setq utb:blk nil)  ;; set to t if CSV file contains Block Name Column

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

    (defun *error* ( msg )
        (LM:endundo (LM:acdoc))
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\nError: " msg))
        )
        (princ)
    )

    (setq fnb:fun
        (lambda ( s )
            (if (wcmatch (strcase s t) "*.dwg,*.dxf,*.dwt,*.dws")
                (vl-filename-base s) s
            )
        )
    )
    (cond
        (   (not (setq sel (ssget "_X" (vl-list* '(0 . "INSERT") '(66 . 1) (if utb:ftr (list (cons 2 (strcat "`*U*," utb:ftr))))))))
            (princ "\nNo Attributed Blocks found in drawing.")
        )
        (   (and utb:csv (not (setq csv (findfile utb:csv))))
            (princ
                (strcat
                    "\n"
                    (vl-filename-base utb:csv)
                    (vl-filename-extension utb:csv)
                    " not found."
                )
            )
        )
        (   (and csv (/= ".CSV" (strcase (vl-filename-extension csv))))
            (princ "\nAttribute data file must be in CSV format.")
        )
        (   (not (or csv (setq csv (getfiled "Select CSV File" "" "csv" 16))))
            (princ "\n*Cancel*")
        )
        (   (not (setq lst (mapcar '(lambda ( x ) (cons (strcase (fnb:fun (car x))) (cdr x))) (LM:readcsv csv))))
            (princ
                (strcat
                    "\nNo data found in "
                    (vl-filename-base csv)
                    ".csv file."
                )
            )
        )
        (   (not
                (setq tag (mapcar 'strcase (cdar lst))
                      lst (LM:massoc (strcase (fnb:fun (getvar 'dwgname))) lst)
                )
            )
            (princ (strcat "\n" (fnb:fun (getvar 'dwgname)) " not found in first column of CSV file."))
        )
        (   t
            (setq lst (mapcar '(lambda ( x ) (mapcar 'cons tag x)) lst)
                  ano 0
                  bno 0
            )
            (LM:startundo (LM:acdoc))
            (repeat (setq inc (sslength sel))
                (setq ent (ssname sel (setq inc (1- inc)))
                      bln (strcase (LM:al-effectivename ent))
                      val lst
                      flg nil
                )
                (if (or (null utb:ftr) (wcmatch bln (strcase utb:ftr)))
                    (progn
                        (if utb:lay
                            (setq val (mapcar '(lambda ( x ) (cons (strcase (cdar x)) (cdr x))) val)
                                  val (LM:massoc (strcase (cdr (assoc 410 (entget ent)))) val)
                            )
                        )
                        (if utb:blk
                            (setq val (mapcar '(lambda ( x ) (cons (strcase (cdar x)) (cdr x))) val)
                                  val (cdr (assoc bln val))
                            )
                            (setq val (car val))
                        )
                        (if val
                            (foreach att (vlax-invoke (vlax-ename->vla-object ent) 'getattributes)
                                (if
                                    (and
                                        (setq str (assoc (strcase (vla-get-tagstring att)) val))
                                        (progn
                                            (setq val (LM:remove1st str val))
                                            (/= (vla-get-textstring att) (cdr str))
                                        )
                                    )
                                    (progn
                                        (vla-put-textstring att (cdr str))
                                        (setq flg t
                                              ano (1+ ano)
                                        )
                                    )
                                )
                            )
                        )
                        (if flg (setq bno (1+ bno)))
                    )
                )
            )
            (if (zerop ano)
                (princ "\nAll attributes are up-to-date.")
                (princ
                    (strcat
                        "\n"           (itoa ano) " attribute" (if (= 1 ano) "" "s")
                        " updated in " (itoa bno) " block"     (if (= 1 bno) "" "s") "."
                    )
                )
            )
            (LM:endundo (LM:acdoc))
        )
    )
    (princ)
)

;; Effective Block Name  -  Lee Mac
;; ent - [ent] Block Reference entity

(defun LM:al-effectivename ( ent / blk rep )
    (if (wcmatch (setq blk (cdr (assoc 2 (entget ent)))) "`**")
        (if
            (and
                (setq rep
                    (cdadr
                        (assoc -3
                            (entget
                                (cdr
                                    (assoc 330
                                        (entget
                                            (tblobjname "block" blk)
                                        )
                                    )
                                )
                               '("AcDbBlockRepBTag")
                            )
                        )
                    )
                )
                (setq rep (handent (cdr (assoc 1005 rep))))
            )
            (setq blk (cdr (assoc 2 (entget rep))))
        )
    )
    blk
)

;; Read CSV  -  Lee Mac
;; Parses a CSV file into a matrix list of cell values.
;; csv - [str] filename of CSV file to read
 
(defun LM:readcsv ( csv / des lst sep str )
    (if (setq des (open csv "r"))
        (progn
            (setq sep (cond ((vl-registry-read "HKEY_CURRENT_USER\\Control Panel\\International" "sList")) (",")))
            (while (setq str (read-line des))
                (setq lst (cons (LM:csv->lst str sep 0) lst))
            )
            (close des)
        )
    )
    (reverse lst)
)

;; CSV -> List  -  Lee Mac
;; Parses a line from a CSV file into a list of cell values.
;; str - [str] string read from CSV file
;; sep - [str] CSV separator token
;; pos - [int] initial position index (always zero)
 
(defun LM:csv->lst ( str sep pos / s )
    (cond
        (   (not (setq pos (vl-string-search sep str pos)))
            (if (wcmatch str "\"*\"")
                (list (LM:csv-replacequotes (substr str 2 (- (strlen str) 2))))
                (list str)
            )
        )
        (   (or (wcmatch (setq s (substr str 1 pos)) "\"*[~\"]")
                (and (wcmatch s "~*[~\"]*") (= 1 (logand 1 pos)))
            )
            (LM:csv->lst str sep (+ pos 2))
        )
        (   (wcmatch s "\"*\"")
            (cons
                (LM:csv-replacequotes (substr str 2 (- pos 2)))
                (LM:csv->lst (substr str (+ pos 2)) sep 0)
            )
        )
        (   (cons s (LM:csv->lst (substr str (+ pos 2)) sep 0)))
    )
)

(defun LM:csv-replacequotes ( str / pos )
    (setq pos 0)
    (while (setq pos (vl-string-search  "\"\"" str pos))
        (setq str (vl-string-subst "\"" "\"\"" str pos)
              pos (1+ pos)
        )
    )
    str
)

;; MAssoc  -  Lee Mac
;; Returns all associations of a key in an association list

(defun LM:massoc ( key lst / item )
    (if (setq item (assoc key lst))
        (cons (cdr item) (LM:massoc key (cdr (member item lst))))
    )
)

;; Remove 1st  -  Lee Mac
;; Removes the first occurrence of an item from a list

(defun LM:remove1st ( itm lst / f )
    (setq f equal)
    (vl-remove-if '(lambda ( a ) (if (f a itm) (setq f (lambda ( a b ) nil)))) lst)
)

;; Start Undo  -  Lee Mac
;; Opens an Undo Group.

(defun LM:startundo ( doc )
    (LM:endundo doc)
    (vla-startundomark doc)
)

;; End Undo  -  Lee Mac
;; Closes an Undo Group.

(defun LM:endundo ( doc )
    (while (= 8 (logand 8 (getvar 'undoctl)))
        (vla-endundomark doc)
    )
)

;; Active Document  -  Lee Mac
;; Returns the VLA Active Document Object

(defun LM:acdoc nil
    (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
    (LM:acdoc)
)

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

(vl-load-com)
(princ
    (strcat
        "\n:: UpdateTitleblock.lsp | Version 1.9 | \\U+00A9 Lee Mac "
        (menucmd "m=$(edtime,0,yyyy)")
        " www.lee-mac.com ::"
        "\n:: Type \"utb\" to run manually ::\n"
    )
)
(princ)

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

(c:utb) ;; Remove or comment this line to disable autorun

;;----------------------------------------------------------------------;;
;;                             End of File                              ;;
;;----------------------------------------------------------------------;;

 

[aridzv]

Hi.

Is it possible to add to this lisp an IF condition that check if the attribute "PRICE" is already exist in every block in the selection set,

and if it is - to skip update that block?

 

I've tried to add those lines but I'm getting an error:

        (vl-load-com)

        (setq tagname "PRICE")

        .

        .

        .

        (foreach att (vlax-invoke blk 'getattributes)
        (if ( /= tagname (strcase (vla-get-tagstring att)))

 

the error I'm getting is "...; error : Automation Error. Method [GETATTRIBUTES] not available"

Thanks,

Ari.

     

On 4/24/2019 at 4:51 PM, Beni88 said:

...

This is the code I used:

(defun c:add$ ( / ss i blk blks def AttObj)
    (and
       (setq ss (ssget '((0 . "INSERT"))))
       (setq i (sslength ss))
       (while (> i 0)
          (setq blk (cdr (assoc 2 (entget (ssname ss (setq i (1- i)))))))
          (if (not (vl-position blk blks))(setq blks (cons blk blks)))
       )
    )
    (foreach blk blks
         (setq def (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) blk))
         (setq AttObj
            (vla-addattribute def
              0.07
               acAttributeModeInvisible
              ""
              (vlax-3D-point 72 84)
              "PRICE"
              "338"
            )
         )
         (vlax-put AttObj 'Alignment acAlignmentmiddle) ;; 4
         (command "_.attsync" "_N" blk)
     )
    (princ)
)
(vl-load-com) (princ)

 

Now, if I create a new drawing and insert any block from my library drawing, the block including the new attribute 'Price' is correct and has already the right value in it. So later on, I can extract the data into an xls-file.

 

But I would like to 'update' my preexisting drawings as well. In those, the blocks are of course still without the new attribute 'Price'. I tried to insert using WBLOCK, but that would mean I have to do this for every single block. I usually have dozens of different blocks in one drawing and can't use WBLOCK for every single one of them.

Also using WBLOCK, the color and layer changes back to 'Layer 0' and Color 'from Layer' .

 

Is there a routine which at least allows me to insert my whole 'library' (not just one block!) into a drawing, and updates (sync) the older blocks in it at once?

Or is there a simpler way to do this?

 

Thank you so much for any help!

 

example_1.dwg 88.72 kB · 6 downloads

 

[BIGAL]

There is a has-property check so it sounds like its getting a block with no attributes.

 

(if (= (vla-get-hasattributes blk) :vlax-true)
(foreach att (vlax-invoke blk 'getattributes)
.....