Get ObjectID for Attdef script

Hi,

I'm writing a script containing attdef where I would like to:

1. Select a object (i.e. a closed polyline)

2. Assign area and length to the object

3. Create a block containing the area and length attribute.

I get stuck on the ObjID. Is it possible to get the objectID prior to the attdef and then use it in the default insert field? I'm using Acad2010 x64

%<\AcObjProp.16.2 Object(%<[color=red]\_ObjId 8796082670240[/color]>%,1).Area \f "%lu2">%

Thanks!

This is the code I use to retrieve an ObjectID:

(defun GetObjectID ( obj doc )
 ;; Lee Mac
 (if
   (eq "X64"
     (strcase
       (getenv "PROCESSOR_ARCHITECTURE")
     )
   )
   (vlax-invoke-method
     (vla-get-Utility doc) 'GetObjectIdString obj :vlax-false
   )
   (itoa (vla-get-Objectid obj))
 )
)

Requires two arguments -

VLA-Object : The object in question

Document Object: The document object - only because I normally use the function in a loop.

Lee

Thanks alot!

I'm really a rookie regarding lisp and scripts... so one more question:

How do I get this together with the attribute and block creation? Is there a way to get this done with script?

When you say 'script' are you referring to such that can be run on multiple drawings in one go? Bear in mind that a 'script' and LISP are two different things.

Perhaps take a look here:

http://www.cadtutor.net/forum/showpost.php?p=317428&postcount=20

http://www.cadtutor.net/forum/showpost.php?p=314560&postcount=4

http://www.cadtutor.net/forum/showpost.php?p=314562&postcount=5

http://www.cadtutor.net/forum/showpost.php?p=311693&postcount=20

I'm not really sure if it's a script or a lisp I want. I don't want to use it on multiple drawings.

My problem is that I want to automate the creation of 2000 blocks. The blocks must contain attribs with areas and lengths of several polylines. I can later make a data extraction to excel with blocknames including areas and lengths...

Is it possible to make a lisp of a attribute creation with object ->area?

It sounds like you want to use a LISP.

From those links I provided above - you should be able to place the Area Field into an attribute/text/mtext.

This might suit you:

(defun c:Fld ( / GetBlock GetObjectID PutAttValue InsertBlock
                BOBJ DOC ENT FBLOCK FTAG OBJ PT RESULT SPC TAG VALUE)
 (vl-load-com)
 ;; Lee Mac  ~  11.05.10
 

 [b][color=Red](setq fBlock "Block")[/color][/b]   [b][color=Red];; Block Name or nil[/color][/b]

 [color=Red][b](setq ftag  "TAG1")[/b][/color]  [b][color=Red] ;; Tag Name[/color][/b]
 

 (defun GetBlock ( block )
 ;; Lee Mac  ~  05.05.10
   (cond
     (
       (not
         (and
           (or block
             (setq block
               (getfiled "Select Block" "" "dwg" 16)
             )
           )
           (or
             (and
               (vl-position
                 (vl-filename-extension block) '("" nil)
               )
               (or
                 (tblsearch "BLOCK" block)
                 (setq block
                   (findfile
                     (strcat block ".dwg")
                   )
                 )
               )
             )
             (setq block (findfile block))
           )
         )
       )
      nil
     )
     ( block )
   )
 )

 (defun GetObjectID ( obj doc )
   ;; Lee Mac
   (if
     (eq "X64"
       (strcase
         (getenv "PROCESSOR_ARCHITECTURE")
       )
     )
     (vlax-invoke-method
       (vla-get-Utility doc) 'GetObjectIdString obj :vlax-false
     )
     (itoa (vla-get-Objectid obj))
   )
 )

 (defun PutAttValue ( object tag value )
   ;; Lee Mac  ~  05.05.10
   (mapcar
     (function
       (lambda ( attrib )
         (and
           (eq tag (vla-get-TagString attrib))
           (vla-put-TextString attrib value)
         )
       )
     )
     (vlax-invoke object 'GetAttributes)
   )
   value
 )

 (defun InsertBlock ( Block Name Point )
   (if
     (not
       (vl-catch-all-error-p
         (setq result
           (vl-catch-all-apply (function vla-insertblock)
             (list Block (vlax-3D-point point) Name 1. 1. 1. 0.)
           )
         )
       )
     )
     result
   )
 )

 (setq spc
   (if
     (or
       (eq AcModelSpace
         (vla-get-ActiveSpace
           (setq doc
             (vla-get-ActiveDocument
               (vlax-get-acad-object)
             )
           )
         )
       )
       (eq :vlax-true (vla-get-MSpace doc))
     )
     (vla-get-ModelSpace doc)
     (vla-get-PaperSpace doc)
   )
 )
 

 (if (setq fBlock (GetBlock fBlock))
   
   (while
     (progn
       (setq ent (car (entsel "\nSelect Object to Retrieve Area: ")))

       (cond
         (
           (eq 'ENAME (type ent))

           (if
             (not
               (vlax-property-available-p
                 (setq obj (vlax-ename->vla-object ent)) 'Area
               )
             )
             (princ "\n** Invalid Object Selected **")
             
             (if
               (and
                 (setq pt (getpoint "\nPick Point for Block: "))
                 (setq bObj (InsertBlock spc fBlock pt))
               )
               (progn
                 (and ftag
                   (PutAttValue bObj ftag
                     (strcat "%<\\AcObjProp Object(%<\\_ObjId "
                       (GetObjectID obj doc) ">%).Area \\f \"%lu6%qf1\">%"
                     )
                   )
                 )
                 (vla-regen doc acActiveViewport)
               )
             )
           )
         )
       )
     )
   )
   (princ "\n** Block not Found **")
 )
 (princ)
)
         

Update the Block Name and Tag Name at the top.

Thanks alot! You most helpful. Looking at the code it's definitly what I'm looking for. But perhaps I'm stupid, but I can't get this to work.

It's halted on

My bad, It works just fine! Thanks alot!

One more question thus...

Now I make a attrib with TAG1 and make a block called "block" out of that attrib. I would like to make a new block (and give it a new name) for every new attrib.

Is it possible to:

1. select the closed polyline

2. create the attrib with the selected polyline area

3. create and name the block containing the polyline and attrib

?

This would be just so very wonderful

This will create individual blocks for each field - but I'm at a loss as to why you would want to approach it this way.

(defun c:Fld ( / GetBlock GetObjectID PutAttValue InsertBlock AddBlock Itemp
                BLK BOBJ COLL DOC ENT FBLOCK FTAG OBJ PT RESULT SEED SPC TAG VALUE

                )
 (vl-load-com)
 ;; Lee Mac  ~  11.05.10
 

 (setq fBlock "Block")   ;; Block Name

 (setq ftag  "TAG1")   ;; Tag Name
 

 (defun GetObjectID ( obj doc )
   ;; Lee Mac
   (if
     (eq "X64"
       (strcase
         (getenv "PROCESSOR_ARCHITECTURE")
       )
     )
     (vlax-invoke-method
       (vla-get-Utility doc) 'GetObjectIdString obj :vlax-false
     )
     (itoa (vla-get-Objectid obj))
   )
 )

 (defun PutAttValue ( object tag value )
   ;; Lee Mac  ~  05.05.10
   (mapcar
     (function
       (lambda ( attrib )
         (and
           (eq tag (vla-get-TagString attrib))
           (vla-put-TextString attrib value)
         )
       )
     )
     (vlax-invoke object 'GetAttributes)
   )
   value
 )

 (defun InsertBlock ( Block Name Point )
   (if
     (not
       (vl-catch-all-error-p
         (setq result
           (vl-catch-all-apply (function vla-insertblock)
             (list Block (vlax-3D-point point) Name 1. 1. 1. 0.)
           )
         )
       )
     )
     result
   )
 )

 (defun Itemp ( coll item )
   (if
     (not
       (vl-catch-all-error-p
         (setq item
           (vl-catch-all-apply
             (function vla-item) (list coll item)
           )
         )
       )
     )
     item
   )
 )

 (defun AddBlock ( seed pt / coll name )
   (setq coll
     (vla-get-Blocks
       (vla-get-ActiveDocument
         (vlax-get-acad-object)
       )
     )
   )

   (setq Name
     (
       (lambda ( i )
         (while
           (Itemp coll
             (strcat seed
               (itoa
                 (setq i (1+ i))
               )
             )
           )
         )
         (strcat seed (itoa i))
       )
       0
     )
   )

   (list 
     (vla-Add coll
       (vlax-3D-point pt) name
     )
     name
   )
 )    

 (setq spc
   (if
     (or
       (eq AcModelSpace
         (vla-get-ActiveSpace
           (setq doc
             (vla-get-ActiveDocument
               (vlax-get-acad-object)
             )
           )
         )
       )
       (eq :vlax-true (vla-get-MSpace doc))
     )
     (vla-get-ModelSpace doc)
     (vla-get-PaperSpace doc)
   )
 )
 
   
 (while
   (progn
     (setq ent (car (entsel "\nSelect Object to Retrieve Area: ")))

     (cond
       (
         (eq 'ENAME (type ent))
        
         (if
           (not
             (vlax-property-available-p
               (setq obj (vlax-ename->vla-object ent)) 'Area
             )
           )
           (princ "\n** Invalid Object Selected **")
             
           (if
             (and
               (setq pt   (getpoint "\nPick Point for Block: "))
               (setq blk  (AddBlock fBlock '(0. 0. 0.)))
               (vla-AddAttribute (car blk)
                 (vla-get-height
                   (Itemp
                     (vla-get-TextStyles doc) (getvar 'TEXTSTYLE)
                   )
                 )
                 acAttributeModePreset
                 "Enter Tag Value: "
                 (vlax-3D-point '(0. 0. 0.))
                 ftag
                 ""
               )                  
               (setq bObj (InsertBlock spc (cadr blk) pt))
             )
             (progn
               (and ftag
                 (PutAttValue bObj ftag
                   (strcat "%<\\AcObjProp Object(%<\\_ObjId "
                     (GetObjectID obj doc) ">%).Area \\f \"%lu6%qf1\">%"
                   )
                 )
               )
               (vla-regen doc acActiveViewport)
             )
           )
         )
        t
       )
     )
   )
 )
 (princ)
)

This might suit you:

 

(defun c:Fld ( / GetBlock GetObjectID PutAttValue InsertBlock
                BOBJ DOC ENT FBLOCK FTAG OBJ PT RESULT SPC TAG VALUE)
 (vl-load-com)
 ;; Lee Mac  ~  11.05.10


 [b][color=red](setq fBlock "Block")[/color][/b]   [b][color=red];; Block Name or nil[/color][/b]

 [color=red][b](setq ftag  "TAG1")[/b][/color]  [b][color=red] ;; Tag Name[/color][/b]


 (defun GetBlock ( block )
 ;; Lee Mac  ~  05.05.10
   (cond
     (
       (not
         (and
           (or block
             (setq block
               (getfiled "Select Block" "" "dwg" 16)
             )
           )
           (or
             (and
               (vl-position
                 (vl-filename-extension block) '("" nil)
               )
               (or
                 (tblsearch "BLOCK" block)
                 (setq block
                   (findfile
                     (strcat block ".dwg")
                   )
                 )
               )
             )
             (setq block (findfile block))
           )
         )
       )
      nil
     )
     ( block )
   )
 )

 (defun GetObjectID ( obj doc )
   ;; Lee Mac
   (if
     (eq "X64"
       (strcase
         (getenv "PROCESSOR_ARCHITECTURE")
       )
     )
     (vlax-invoke-method
       (vla-get-Utility doc) 'GetObjectIdString obj :vlax-false
     )
     (itoa (vla-get-Objectid obj))
   )
 )

 (defun PutAttValue ( object tag value )
   ;; Lee Mac  ~  05.05.10
   (mapcar
     (function
       (lambda ( attrib )
         (and
           (eq tag (vla-get-TagString attrib))
           (vla-put-TextString attrib value)
         )
       )
     )
     (vlax-invoke object 'GetAttributes)
   )
   value
 )

 (defun InsertBlock ( Block Name Point )
   (if
     (not
       (vl-catch-all-error-p
         (setq result
           (vl-catch-all-apply (function vla-insertblock)
             (list Block (vlax-3D-point point) Name 1. 1. 1. 0.)
           )
         )
       )
     )
     result
   )
 )

 (setq spc
   (if
     (or
       (eq AcModelSpace
         (vla-get-ActiveSpace
           (setq doc
             (vla-get-ActiveDocument
               (vlax-get-acad-object)
             )
           )
         )
       )
       (eq :vlax-true (vla-get-MSpace doc))
     )
     (vla-get-ModelSpace doc)
     (vla-get-PaperSpace doc)
   )
 )


 (if (setq fBlock (GetBlock fBlock))

   (while
     (progn
       (setq ent (car (entsel "\nSelect Object to Retrieve Area: ")))

       (cond
         (
           (eq 'ENAME (type ent))

           (if
             (not
               (vlax-property-available-p
                 (setq obj (vlax-ename->vla-object ent)) 'Area
               )
             )
             (princ "\n** Invalid Object Selected **")

             (if
               (and
                 (setq pt (getpoint "\nPick Point for Block: "))
                 (setq bObj (InsertBlock spc fBlock pt))
               )
               (progn
                 (and ftag
                   (PutAttValue bObj ftag
                     (strcat "%<\\AcObjProp Object(%<\\_ObjId "
                       (GetObjectID obj doc) ">%).Area \\f \"%lu6%qf1\">%"
                     )
                   )
                 )
                 (vla-regen doc acActiveViewport)
               )
             )
           )
         )
       )
     )
   )
   (princ "\n** Block not Found **")
 )
 (princ)
)

 

Update the Block Name and Tag Name at the top.

Is there any chance you can modify this so that the block that gets inserted has 3 attributes instead of just the Area. ie "Room Name" (entered manually by user), "Area" and "Perimeter"??

Very nice!

It was exactly what I was looking for, but my block has a trouble of scale.

My block is in centimeters and I play the lisp in a meter file.

Maybe you will be kind to help me.

Hi,

Sorry to repost my question of this topic "http://www.cadtutor.net/forum/showthread.php?31029-Insert-An-Attribute-Block-Then-Fill-In-w-Field/page2"

But what is in here is almost what i need.

Instead of select the area, is it possible to select one block and retreive the attribute "TAG2", for example.

Sorry for my english.

I'm from Portugal.

Thanks

A bit of sample code

(setq ss1 (ssget))
(foreach att (vlax-invoke (vlax-ename->vla-object (ssname SS1 0 )) 'getattributes)
     (Princ  (strcat "\n" (vla-get-tagstring att) " " (vla-get-textstring att)))
) ; end foreach

I'm a newbie in coding. What part of the original code do i have to replace with that?

Thanks

The example I posted displays the tagname and attribute value a simple way to find tag names.

(princ "\nPick a attributed block ")
(setq ss1 (ssget))
(foreach att (vlax-invoke (vlax-ename->vla-object (ssname SS1 0 )) 'getattributes)
    (if (=  (vla-get-tagstring att) "TAG2") (alert (vla-get-textstring att)) )
; put rest of code here
)

Thanks for the reply. But i don't know what is the rest of the code.

I'm trying to use this code:

(defun c:Fld ( / GetBlock GetObjectID PutAttValue InsertBlock
                BOBJ DOC ENT FBLOCK FTAG OBJ PT RESULT SPC TAG VALUE)
 (vl-load-com)
 ;; Lee Mac  ~  11.05.10


 (setq fBlock "Block")   ;; Block Name or nil

 (setq ftag  "TAG1")   ;; Tag Name


 (defun GetBlock ( block )
 ;; Lee Mac  ~  05.05.10
   (cond
     (
       (not
         (and
           (or block
             (setq block
               (getfiled "Select Block" "" "dwg" 16)
             )
           )
           (or
             (and
               (vl-position
                 (vl-filename-extension block) '("" nil)
               )
               (or
                 (tblsearch "BLOCK" block)
                 (setq block
                   (findfile
                     (strcat block ".dwg")
                   )
                 )
               )
             )
             (setq block (findfile block))
           )
         )
       )
      nil
     )
     ( block )
   )
 )

 (defun GetObjectID ( obj doc )
   ;; Lee Mac
   (if
     (eq "X64"
       (strcase
         (getenv "PROCESSOR_ARCHITECTURE")
       )
     )
     (vlax-invoke-method
       (vla-get-Utility doc) 'GetObjectIdString obj :vlax-false
     )
     (itoa (vla-get-Objectid obj))
   )
 )

 (defun PutAttValue ( object tag value )
   ;; Lee Mac  ~  05.05.10
   (mapcar
     (function
       (lambda ( attrib )
         (and
           (eq tag (vla-get-TagString attrib))
           (vla-put-TextString attrib value)
         )
       )
     )
     (vlax-invoke object 'GetAttributes)
   )
   value
 )

 (defun InsertBlock ( Block Name Point )
   (if
     (not
       (vl-catch-all-error-p
         (setq result
           (vl-catch-all-apply (function vla-insertblock)
             (list Block (vlax-3D-point point) Name 1. 1. 1. 0.)
           )
         )
       )
     )
     result
   )
 )

 (setq spc
   (if
     (or
       (eq AcModelSpace
         (vla-get-ActiveSpace
           (setq doc
             (vla-get-ActiveDocument
               (vlax-get-acad-object)
             )
           )
         )
       )
       (eq :vlax-true (vla-get-MSpace doc))
     )
     (vla-get-ModelSpace doc)
     (vla-get-PaperSpace doc)
   )
 )


 (if (setq fBlock (GetBlock fBlock))

   (while
     (progn
       [color="red"](setq ent (car (entsel "\nSelect Object to Retrieve Area: ")))

       (cond
         (
           (eq 'ENAME (type ent))

           (if
             (not
               (vlax-property-available-p
                 (setq obj (vlax-ename->vla-object ent)) 'Area
               )
             )
             (princ "\n** Invalid Object Selected **")[/color]

             (if
               (and
                 (setq pt (getpoint "\nPick Point for Block: "))
                 (setq bObj (InsertBlock spc fBlock pt))
               )
               (progn
                 (and ftag
                   (PutAttValue bObj ftag
                     (strcat "%<\\AcObjProp Object(%<\\_ObjId "
                       (GetObjectID obj doc) ">%).Area \\f \"%lu6%qf1\">%"
                     )
                   )
                 )
                 (vla-regen doc acActiveViewport)
               )
             )
           )
         )
       )
     )
   )
   (princ "\n** Block not Found **")
 )
 (princ)
)

It works fine with selecting areas and insert them in "block" with Attribrute "TAG1" with a field with the area selected.

But i'm trying to incorporate your code, but i don't know how

I supose the part in "red" is what i need to replace with yout code, but i'm doing something wrong.

Sorry, i'm new at this.

After some googling, i tried this:

(defun c:Fld ( / GetBlock GetObjectID PutAttValue InsertBlock
                BOBJ DOC ENT FBLOCK FTAG OBJ PT RESULT SPC TAG VALUE)
 (vl-load-com)
 ;; Lee Mac  ~  11.05.10


 (setq fBlock "BAR2")   ;; Block Name or nil

 (setq ftag  "N")   ;; Tag Name


 (defun GetBlock ( block )
 ;; Lee Mac  ~  05.05.10
   (cond
     (
       (not
         (and
           (or block
             (setq block
               (getfiled "Select Block" "" "dwg" 16)
             )
           )
           (or
             (and
               (vl-position
                 (vl-filename-extension block) '("" nil)
               )
               (or
                 (tblsearch "BLOCK" block)
                 (setq block
                   (findfile
                     (strcat block ".dwg")
                   )
                 )
               )
             )
             (setq block (findfile block))
           )
         )
       )
      nil
     )
     ( block )
   )
 )

 (defun GetObjectID ( obj doc )
   ;; Lee Mac
   (if
     (eq "X64"
       (strcase
         (getenv "PROCESSOR_ARCHITECTURE")
       )
     )
     (vlax-invoke-method
       (vla-get-Utility doc) 'GetObjectIdString obj :vlax-false
     )
     (itoa (vla-get-Objectid obj))
   )
 )

 (defun PutAttValue ( object tag value )
   ;; Lee Mac  ~  05.05.10
   (mapcar
     (function
       (lambda ( attrib )
         (and
           (eq tag (vla-get-TagString attrib))
           (vla-put-TextString attrib value)
         )
       )
     )
     (vlax-invoke object 'GetAttributes)
   )
   value
 )

 (defun InsertBlock ( Block Name Point )
   (if
     (not
       (vl-catch-all-error-p
         (setq result
           (vl-catch-all-apply (function vla-insertblock)
             (list Block (vlax-3D-point point) Name 1. 1. 1. 0.)
           )
         )
       )
     )
     result
   )
 )

 (setq spc
   (if
     (or
       (eq AcModelSpace
         (vla-get-ActiveSpace
           (setq doc
             (vla-get-ActiveDocument
               (vlax-get-acad-object)
             )
           )
         )
       )
       (eq :vlax-true (vla-get-MSpace doc))
     )
     (vla-get-ModelSpace doc)
     (vla-get-PaperSpace doc)
   )
 )


 (if (setq fBlock (GetBlock fBlock))

   (while
     (progn
       (princ "\nPick a attributed block ")

       (cond
         (
                         
               (setq ss1 (ssget))
	(foreach att (vlax-invoke (vlax-ename->vla-object (ssname SS1 0 )) 'getattributes)
	(if (=  (vla-get-tagstring att) "BAR") (alert (vla-get-textstring att)) ))

	(and
                 (setq pt (getpoint "\nPick Point for Block: "))
                 (setq bObj (InsertBlock spc fBlock pt))
               )
               (progn
                 (and ftag
                   (PutAttValue bObj ftag
                     (strcat "%<\\AcObjProp Object(%<\\_ObjId "
                       (GetObjectID obj doc) ">%).TextString >%"
                     )
                   )
                 )

                 (vla-regen doc acActiveViewport)
            
           )
         )
       )
     )
   )
   (princ "\n** Block not Found **")
 )
 (princ)
)

But i received this error: "error: bad argument type: VLA-OBJECT nil"

And the block is inserted with a field with text "No", but after checking the filter, it seems that the problem is the ObjectId, that do not correspond of the selected block.

The solution could be simple, but i don't understand lisp.

thanks

I'm a rookie at this. Yesterday i have done more search but i keep getting errors.

I have multiples drawings with multiples blocks to do until saturday and this Lisp will be my salvation.

Can anyone help?

Thanks