Get ObjectID for Attdef script

[Lee Mac]

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?

 

Try the following - change the block names/tags at the top of the code as necessary:

(defun c:myfield ( / atr att blk cmd dwg ent ins newblk newtag obj reftag )
   (setq 
       reftag "TAG2"    ;; Attribute tag to reference
       newtag "TAG1"    ;; Attribute tag to house field
       newblk "MyBlock" ;; Attributed Block to be inserted
       reftag (strcase reftag)
       newtag (strcase newtag)
   )
   (cond
       (   (not
               (or (tblsearch "block" (setq blk newblk))
                   (and (setq dwg (findfile (strcat newblk ".dwg")))
                       (progn
                           (setq cmd (getvar 'cmdecho))
                           (setvar 'cmdecho 0)
                           (command "_.-insert" dwg nil)
                           (setvar 'cmdecho cmd)
                           (tblsearch "block" (setq blk newblk))
                       )
                   )
               )
           )
           (princ (strcat "\nBlock \"" newblk "\" not found or could not be defined."))
       )
       (   (progn
               (while
                   (progn
                       (setvar 'errno 0)
                       (setq ent (car (entsel (strcat "\nSelect block containing \"" reftag "\" tag: "))))
                       (cond
                           (   (= 7 (getvar 'errno))
                               (princ "\nMissed, try again.")
                           )
                           (   (null ent) nil)
                           (   (/= "AcDbBlockReference" (vla-get-objectname (setq obj (vlax-ename->vla-object ent))))
                               (princ "\nSelected object is not a block.")
                           )
                           (   (not (setq atr (vl-some '(lambda ( att ) (if (= (strcase (vla-get-tagstring att)) reftag) att)) (vlax-invoke obj 'getattributes))))
                               (princ (strcat "\nSelected block does not contain \"" reftag "\" attribute."))
                           )
                       )
                   )
               )
               (not (and atr (setq ins (getpoint (strcat "\nSpecify point for \"" newblk "\": ")))))
           )
       )
       (   (vl-some
              '(lambda ( att )
                   (if (= newtag (strcase (vla-get-tagstring att)))
                       (progn
                           (vla-put-textstring att
                               (strcat "%<\\AcObjProp Object(%<\\_ObjId " (LM:objectid atr) ">%).TextString>%")
                           )
                           t
                       )
                   )
               )
               (vlax-invoke
                   (vla-insertblock
                       (vlax-get-property (LM:acdoc)
                           (if (= 1 (getvar 'cvport))
                               'paperspace
                               'modelspace
                           )
                       )
                       (vlax-3D-point (trans ins 1 0))
                       blk 1.0 1.0 1.0 0.0
                   )
                   'getattributes
               )
           )
           (vla-regen (LM:acdoc) acactiveviewport)
       )
       (   (princ (strcat "\nBlock \"" newblk "\" does not contain attribute \"" newtag "\".")))
   )
   (princ)
)

;; ObjectID  -  Lee Mac
;; Returns a string containing the ObjectID of a supplied VLA-Object
;; Compatible with 32-bit & 64-bit systems

(defun LM:objectid ( obj )
   (eval
       (list 'defun 'LM:objectid '( obj )
           (if (wcmatch (getenv "PROCESSOR_ARCHITECTURE") "*64*")
               (if (vlax-method-applicable-p (vla-get-utility (LM:acdoc)) 'getobjectidstring)
                   (list 'vla-getobjectidstring (vla-get-utility (LM:acdoc)) 'obj ':vlax-false)
                  '(LM:ename->objectid (vlax-vla-object->ename obj))
               )
              '(itoa (vla-get-objectid obj))
           )
       )
   )
   (LM:objectid obj)
)

;; Entity Name to ObjectID  -  Lee Mac
;; Returns the 32-bit or 64-bit ObjectID for a supplied entity name

(defun LM:ename->objectid ( ent )
   (LM:hex->decstr
       (setq ent (vl-string-right-trim ">" (vl-prin1-to-string ent))
             ent (substr ent (+ (vl-string-position 58 ent) 3))
       )
   )
)

;; Hex to Decimal String  -  Lee Mac
;; Returns the decimal representation of a supplied hexadecimal string

(defun LM:hex->decstr ( hex / foo bar )
   (defun foo ( lst rtn )
       (if lst
           (foo (cdr lst) (bar (- (car lst) (if (< 57 (car lst)) 55 48)) rtn))
           (apply 'strcat (mapcar 'itoa (reverse rtn)))
       )
   )
   (defun bar ( int lst )
       (if lst
           (if (or (< 0 (setq int (+ (* 16 (car lst)) int))) (cdr lst))
               (cons (rem int 10) (bar (/ int 10) (cdr lst)))
           )
           (bar int '(0))
       )
   )
   (foo (vl-string->list (strcase hex)) nil)
)

;; 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)

 

The above uses several functions from my Area Field to Attribute program.

[Jocker_Boy]

Lee Mac, MANY THANKS!!!

 

It works perfect.

Thank you so much!

[Lee Mac]

Excellent, you're welcome

[Jocker_Boy]

Hi, again...

Many thanks for the code, i'm saving many hours of work.

After some work, i detected that i also need another tag, with field.

I'm a rookie in this, so i try to use your code and add some parts (red):

 

(defun c:ii ( / atr [color="red"]atr1[/color] att [color="red"]att1[/color] blk cmd dwg ent ins newblk newtag obj reftag [color="red"]reftag1[/color] )
   (setq 
       reftag "_N"    ;; Attribute tag to reference
       [color="red"]reftag1 "_Q"    ;; Attribute tag to reference[/color]
       newtag "BB"    ;; Attribute tag to house field
       [color="red"]newtag1 "CC"   ;; Attribute tag to house field[/color]
       newblk "BAR"   ;; Attributed Block to be inserted
       reftag (strcase reftag)
       [color="red"]reftag1 (strcase reftag1)[/color]
       newtag (strcase newtag)
   )
   (cond
       (   (not
               (or (tblsearch "block" (setq blk newblk))
                   (and (setq dwg (findfile (strcat newblk ".dwg")))
                       (progn
                           (setq cmd (getvar 'cmdecho))
                           (setvar 'cmdecho 0)
                           (command "_.-insert" dwg nil)
                           (setvar 'cmdecho cmd)
                           (tblsearch "block" (setq blk newblk))
                       )
                   )
               )
           )
           (princ (strcat "\nBlock \"" newblk "\" not found or could not be defined."))
       )
       (   (progn
               (while
                   (progn
                       (setvar 'errno 0)
                       (setq ent (car (entsel (strcat "\nSelect block containing \"" reftag "\" tag: "))))
                       (cond
                           (   (= 7 (getvar 'errno))
                               (princ "\nMissed, try again.")
                           )
                           (   (null ent) nil)
                           (   (/= "AcDbBlockReference" (vla-get-objectname (setq obj (vlax-ename->vla-object ent))))
                               (princ "\nSelected object is not a block.")
                           )
                           (   (not (setq atr (vl-some '(lambda ( att ) (if (= (strcase (vla-get-tagstring att)) reftag) att)) (vlax-invoke obj 'getattributes))))
                               (princ (strcat "\nSelected block does not contain \"" reftag "\" attribute."))
                           )
		   [color="red"] (   (not (setq atr1 (vl-some '(lambda ( att1 ) (if (= (strcase (vla-get-tagstring att1)) reftag1) att1)) (vlax-invoke obj 'getattributes))))
                               (princ (strcat "\nSelected block does not contain \"" reftag1 "\" attribute."))
                           )[/color]
                       )
                   )
               )
               (not (and atr (setq ins (getpoint (strcat "\nSpecify point for \"" newblk "\": ")))))
           )
       )
       (   (vl-some
              '(lambda ( att )
                   (if (= newtag (strcase (vla-get-tagstring att)))
                       (progn
                           (vla-put-textstring att
                               (strcat "%<\\AcObjProp Object(%<\\_ObjId " (LM:objectid atr) ">%).TextString>%")
                           )
                           t
                       )
                   )
               )
       [color="red"]'(lambda ( att1 )
                   (if (= newtag (strcase (vla-get-tagstring att1)))
                       (progn
                           (vla-put-textstring att1
                               (strcat "%<\\AcObjProp Object(%<\\_ObjId " (LM:objectid atr1) ">%).TextString>%")
                           )
                           t
                       )
                   )
               )[/color]
               (vlax-invoke
                   (vla-insertblock
                       (vlax-get-property (LM:acdoc)
                           (if (= 1 (getvar 'cvport))
                               'paperspace
                               'modelspace
                           )
                       )
                       (vlax-3D-point (trans ins 1 0))
                       blk 1.0 1.0 1.0 0.0
                   )
                   'getattributes
               )
           )
           (vla-regen (LM:acdoc) acactiveviewport)
       )

 
       (   (princ (strcat "\nBlock \"" newblk "\" does not contain attribute \"" newtag "\".")))
   )
   (princ)
)

;; ObjectID  -  Lee Mac
;; Returns a string containing the ObjectID of a supplied VLA-Object
;; Compatible with 32-bit & 64-bit systems

(defun LM:objectid ( obj )
   (eval
       (list 'defun 'LM:objectid '( obj )
           (if (wcmatch (getenv "PROCESSOR_ARCHITECTURE") "*64*")
               (if (vlax-method-applicable-p (vla-get-utility (LM:acdoc)) 'getobjectidstring)
                   (list 'vla-getobjectidstring (vla-get-utility (LM:acdoc)) 'obj ':vlax-false)
                  '(LM:ename->objectid (vlax-vla-object->ename obj))
               )
              '(itoa (vla-get-objectid obj))
           )
       )
   )
   (LM:objectid obj)
)

;; Entity Name to ObjectID  -  Lee Mac
;; Returns the 32-bit or 64-bit ObjectID for a supplied entity name

(defun LM:ename->objectid ( ent )
   (LM:hex->decstr
       (setq ent (vl-string-right-trim ">" (vl-prin1-to-string ent))
             ent (substr ent (+ (vl-string-position 58 ent) 3))
       )
   )
)

;; Hex to Decimal String  -  Lee Mac
;; Returns the decimal representation of a supplied hexadecimal string

(defun LM:hex->decstr ( hex / foo bar )
   (defun foo ( lst rtn )
       (if lst
           (foo (cdr lst) (bar (- (car lst) (if (< 57 (car lst)) 55 48)) rtn))
           (apply 'strcat (mapcar 'itoa (reverse rtn)))
       )
   )
   (defun bar ( int lst )
       (if lst
           (if (or (< 0 (setq int (+ (* 16 (car lst)) int))) (cdr lst))
               (cons (rem int 10) (bar (/ int 10) (cdr lst)))
           )
           (bar int '(0))
       )
   )
   (foo (vl-string->list (strcase hex)) nil)
)

;; 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)

 

But i get this error: "Specify point for "BAR": ; error: too many arguments"

 

I'm trying to use Vlide and google.

But, maybe this is not so simple as i thought.

 

Sorry for the trouble.

 

Many thanks

[Jocker_Boy]

In this weekend i tried to learn about lisp, but i'm in the beginning.

Any ideias how to solve the error?

 

Thanks

[Lee Mac]

([color=BLUE]defun[/color] c:myfield ( [color=BLUE]/[/color] att blk cmd des dwg ent ins newblk obj src taglst )
   ([color=BLUE]setq[/color] taglst '(([color=MAROON]"_N"[/color] . [color=MAROON]"BB"[/color]) ([color=MAROON]"_Q"[/color] . [color=MAROON]"CC"[/color])) [color=GREEN];; Attribute tag mapping[/color]
         newblk [color=MAROON]"MyBlock"[/color]                      [color=GREEN];; Attributed Block to be inserted[/color]
   )
   ([color=BLUE]cond[/color]
       (   ([color=BLUE]not[/color]
               ([color=BLUE]or[/color] ([color=BLUE]tblsearch[/color] [color=MAROON]"block"[/color] ([color=BLUE]setq[/color] blk newblk))
                   ([color=BLUE]and[/color] ([color=BLUE]setq[/color] dwg ([color=BLUE]findfile[/color] ([color=BLUE]strcat[/color] newblk [color=MAROON]".dwg"[/color])))
                       ([color=BLUE]progn[/color]
                           ([color=BLUE]setq[/color] cmd ([color=BLUE]getvar[/color] 'cmdecho))
                           ([color=BLUE]setvar[/color] 'cmdecho 0)
                           ([color=BLUE]command[/color] [color=MAROON]"_.-insert"[/color] dwg [color=BLUE]nil[/color])
                           ([color=BLUE]setvar[/color] 'cmdecho cmd)
                           ([color=BLUE]tblsearch[/color] [color=MAROON]"block"[/color] ([color=BLUE]setq[/color] blk newblk))
                       )
                   )
               )
           )
           ([color=BLUE]princ[/color] ([color=BLUE]strcat[/color] [color=MAROON]"\nBlock \""[/color] newblk [color=MAROON]"\" not found or could not be defined."[/color]))
       )
       (   ([color=BLUE]progn[/color]
               ([color=BLUE]while[/color]
                   ([color=BLUE]progn[/color] ([color=BLUE]setvar[/color] 'errno 0)
                       ([color=BLUE]setq[/color] ent
                           ([color=BLUE]car[/color]
                               ([color=BLUE]entsel[/color]
                                   ([color=BLUE]strcat[/color]
                                       [color=MAROON]"\nSelect block containing "[/color]
                                       ([color=BLUE]substr[/color] ([color=BLUE]apply[/color] '[color=BLUE]strcat[/color] ([color=BLUE]mapcar[/color] '([color=BLUE]lambda[/color] ( x ) ([color=BLUE]strcat[/color] [color=MAROON]","[/color] ([color=BLUE]car[/color] x))) taglst)) 2)
                                       [color=MAROON]" tags: "[/color]
                                   )
                               )
                           )
                       )
                       ([color=BLUE]cond[/color]
                           (   ([color=BLUE]=[/color] 7 ([color=BLUE]getvar[/color] 'errno))
                               ([color=BLUE]princ[/color] [color=MAROON]"\nMissed, try again."[/color])
                           )
                           (   ([color=BLUE]null[/color] ent) [color=BLUE]nil[/color])
                           (   ([color=BLUE]/=[/color] [color=MAROON]"AcDbBlockReference"[/color] ([color=BLUE]vla-get-objectname[/color] ([color=BLUE]setq[/color] obj ([color=BLUE]vlax-ename->vla-object[/color] ent))))
                               ([color=BLUE]princ[/color] [color=MAROON]"\nSelected object is not a block."[/color])
                           )
                           (   ([color=BLUE]progn[/color]
                                   ([color=BLUE]setq[/color] src ([color=BLUE]mapcar[/color] '([color=BLUE]lambda[/color] ( x ) ([color=BLUE]cons[/color] ([color=BLUE]vla-get-tagstring[/color] x) x)) ([color=BLUE]vlax-invoke[/color] obj 'getattributes)))
                                   ([color=BLUE]vl-some[/color]
                                      '([color=BLUE]lambda[/color] ( x )
                                           ([color=BLUE]if[/color] ([color=BLUE]not[/color] ([color=BLUE]assoc[/color] ([color=BLUE]car[/color] x) src))
                                               ([color=BLUE]princ[/color] ([color=BLUE]strcat[/color] [color=MAROON]"\nSelected block does not contain \""[/color] ([color=BLUE]car[/color] x) [color=MAROON]"\" attribute."[/color]))
                                           )
                                       )
                                       taglst
                                   )
                               )
                           )
                       )
                   )
               )
               ([color=BLUE]not[/color] ([color=BLUE]and[/color] ent ([color=BLUE]setq[/color] ins ([color=BLUE]getpoint[/color] ([color=BLUE]strcat[/color] [color=MAROON]"\nSpecify point for \""[/color] newblk [color=MAROON]"\": "[/color])))))
           )
       )
       (   ([color=BLUE]setq[/color] des
               ([color=BLUE]mapcar[/color] '([color=BLUE]lambda[/color] ( x ) ([color=BLUE]cons[/color] ([color=BLUE]vla-get-tagstring[/color] x) x))
                   ([color=BLUE]vlax-invoke[/color]
                       ([color=BLUE]vla-insertblock[/color]
                           ([color=BLUE]vlax-get-property[/color] (LM:acdoc)
                               ([color=BLUE]if[/color] ([color=BLUE]=[/color] 1 ([color=BLUE]getvar[/color] 'cvport))
                                   'paperspace
                                   'modelspace
                               )
                           )
                           ([color=BLUE]vlax-3D-point[/color] ([color=BLUE]trans[/color] ins 1 0))
                           blk 1.0 1.0 1.0 0.0
                       )
                       'getattributes
                   )
               )
           )
           ([color=BLUE]foreach[/color] tag taglst
               ([color=BLUE]if[/color] ([color=BLUE]setq[/color] att ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] ([color=BLUE]cdr[/color] tag) des)))
                   ([color=BLUE]vla-put-textstring[/color] att
                       ([color=BLUE]strcat[/color] [color=MAROON]"%<\\AcObjProp Object(%<\\_ObjId "[/color] (LM:objectid ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] ([color=BLUE]car[/color] tag) src))) [color=MAROON]">%).TextString>%"[/color])
                   )
                   ([color=BLUE]princ[/color] ([color=BLUE]strcat[/color] [color=MAROON]"\nBlock \""[/color] newblk [color=MAROON]"\" does not contain attribute \""[/color] ([color=BLUE]cdr[/color] tag) [color=MAROON]"\"."[/color]))
               )
           )
           ([color=BLUE]vla-regen[/color] (LM:acdoc) [color=BLUE]acactiveviewport[/color])
       )
   )
   ([color=BLUE]princ[/color])
)

[color=GREEN];; ObjectID  -  Lee Mac[/color]
[color=GREEN];; Returns a string containing the ObjectID of a supplied VLA-Object[/color]
[color=GREEN];; Compatible with 32-bit & 64-bit systems[/color]

([color=BLUE]defun[/color] LM:objectid ( obj )
   ([color=BLUE]eval[/color]
       ([color=BLUE]list[/color] '[color=BLUE]defun[/color] 'LM:objectid '( obj )
           ([color=BLUE]if[/color] ([color=BLUE]wcmatch[/color] ([color=BLUE]getenv[/color] [color=MAROON]"PROCESSOR_ARCHITECTURE"[/color]) [color=MAROON]"*64*"[/color])
               ([color=BLUE]if[/color] ([color=BLUE]vlax-method-applicable-p[/color] ([color=BLUE]vla-get-utility[/color] (LM:acdoc)) 'getobjectidstring)
                   ([color=BLUE]list[/color] '[color=BLUE]vla-getobjectidstring[/color] ([color=BLUE]vla-get-utility[/color] (LM:acdoc)) 'obj '[color=BLUE]:vlax-false[/color])
                  '(LM:ename->objectid ([color=BLUE]vlax-vla-object->ename[/color] obj))
               )
              '([color=BLUE]itoa[/color] ([color=BLUE]vla-get-objectid[/color] obj))
           )
       )
   )
   (LM:objectid obj)
)

[color=GREEN];; Entity Name to ObjectID  -  Lee Mac[/color]
[color=GREEN];; Returns the 32-bit or 64-bit ObjectID for a supplied entity name[/color]

([color=BLUE]defun[/color] LM:ename->objectid ( ent )
   (LM:hex->decstr
       ([color=BLUE]setq[/color] ent ([color=BLUE]vl-string-right-trim[/color] [color=MAROON]">"[/color] ([color=BLUE]vl-prin1-to-string[/color] ent))
             ent ([color=BLUE]substr[/color] ent ([color=BLUE]+[/color] ([color=BLUE]vl-string-position[/color] 58 ent) 3))
       )
   )
)

[color=GREEN];; Hex to Decimal String  -  Lee Mac[/color]
[color=GREEN];; Returns the decimal representation of a supplied hexadecimal string[/color]

([color=BLUE]defun[/color] LM:hex->decstr ( hex [color=BLUE]/[/color] foo bar )
   ([color=BLUE]defun[/color] foo ( lst rtn )
       ([color=BLUE]if[/color] lst
           (foo ([color=BLUE]cdr[/color] lst) (bar ([color=BLUE]-[/color] ([color=BLUE]car[/color] lst) ([color=BLUE]if[/color] ([color=BLUE]<[/color] 57 ([color=BLUE]car[/color] lst)) 55 48)) rtn))
           ([color=BLUE]apply[/color] '[color=BLUE]strcat[/color] ([color=BLUE]mapcar[/color] '[color=BLUE]itoa[/color] ([color=BLUE]reverse[/color] rtn)))
       )
   )
   ([color=BLUE]defun[/color] bar ( int lst )
       ([color=BLUE]if[/color] lst
           ([color=BLUE]if[/color] ([color=BLUE]or[/color] ([color=BLUE]<[/color] 0 ([color=BLUE]setq[/color] int ([color=BLUE]+[/color] ([color=BLUE]*[/color] 16 ([color=BLUE]car[/color] lst)) int))) ([color=BLUE]cdr[/color] lst))
               ([color=BLUE]cons[/color] ([color=BLUE]rem[/color] int 10) (bar ([color=BLUE]/[/color] int 10) ([color=BLUE]cdr[/color] lst)))
           )
           (bar int '(0))
       )
   )
   (foo ([color=BLUE]vl-string->list[/color] ([color=BLUE]strcase[/color] hex)) [color=BLUE]nil[/color])
)

[color=GREEN];; Active Document  -  Lee Mac[/color]
[color=GREEN];; Returns the VLA Active Document Object[/color]

([color=BLUE]defun[/color] LM:acdoc [color=BLUE]nil[/color]
   ([color=BLUE]eval[/color] ([color=BLUE]list[/color] '[color=BLUE]defun[/color] 'LM:acdoc '[color=BLUE]nil[/color] ([color=BLUE]vla-get-activedocument[/color] ([color=BLUE]vlax-get-acad-object[/color]))))
   (LM:acdoc)
)

([color=BLUE]vl-load-com[/color]) ([color=BLUE]princ[/color])

[Jocker_Boy]

Lee, thanks again.

 

It is perfect. In my spare time i'm learning lisp code, but i'm in the beginning.

[Lee Mac]

You're welcome - good luck with your coding!

[ReSiN]

Try the following - change the block names/tags at the top of the code as necessary:

(defun c:myfield ( / atr att blk cmd dwg ent ins newblk newtag obj reftag )
   (setq 
       reftag "TAG2"    ;; Attribute tag to reference
       newtag "TAG1"    ;; Attribute tag to house field
       newblk "MyBlock" ;; Attributed Block to be inserted
       reftag (strcase reftag)
       newtag (strcase newtag)
   )
   (cond
       (   (not
               (or (tblsearch "block" (setq blk newblk))
                   (and (setq dwg (findfile (strcat newblk ".dwg")))
                       (progn
                           (setq cmd (getvar 'cmdecho))
                           (setvar 'cmdecho 0)
                           (command "_.-insert" dwg nil)
                           (setvar 'cmdecho cmd)
                           (tblsearch "block" (setq blk newblk))
                       )
                   )
               )
           )
           (princ (strcat "\nBlock \"" newblk "\" not found or could not be defined."))
       )
       (   (progn
               (while
                   (progn
                       (setvar 'errno 0)
                       (setq ent (car (entsel (strcat "\nSelect block containing \"" reftag "\" tag: "))))
                       (cond
                           (   (= 7 (getvar 'errno))
                               (princ "\nMissed, try again.")
                           )
                           (   (null ent) nil)
                           (   (/= "AcDbBlockReference" (vla-get-objectname (setq obj (vlax-ename->vla-object ent))))
                               (princ "\nSelected object is not a block.")
                           )
                           (   (not (setq atr (vl-some '(lambda ( att ) (if (= (strcase (vla-get-tagstring att)) reftag) att)) (vlax-invoke obj 'getattributes))))
                               (princ (strcat "\nSelected block does not contain \"" reftag "\" attribute."))
                           )
                       )
                   )
               )
               (not (and atr (setq ins (getpoint (strcat "\nSpecify point for \"" newblk "\": ")))))
           )
       )
       (   (vl-some
              '(lambda ( att )
                   (if (= newtag (strcase (vla-get-tagstring att)))
                       (progn
                           (vla-put-textstring att
                               (strcat "%<\\AcObjProp Object(%<\\_ObjId " (LM:objectid atr) ">%).TextString>%")
                           )
                           t
                       )
                   )
               )
               (vlax-invoke
                   (vla-insertblock
                       (vlax-get-property (LM:acdoc)
                           (if (= 1 (getvar 'cvport))
                               'paperspace
                               'modelspace
                           )
                       )
                       (vlax-3D-point (trans ins 1 0))
                       blk 1.0 1.0 1.0 0.0
                   )
                   'getattributes
               )
           )
           (vla-regen (LM:acdoc) acactiveviewport)
       )
       (   (princ (strcat "\nBlock \"" newblk "\" does not contain attribute \"" newtag "\".")))
   )
   (princ)
)

;; ObjectID  -  Lee Mac
;; Returns a string containing the ObjectID of a supplied VLA-Object
;; Compatible with 32-bit & 64-bit systems

(defun LM:objectid ( obj )
   (eval
       (list 'defun 'LM:objectid '( obj )
           (if (wcmatch (getenv "PROCESSOR_ARCHITECTURE") "*64*")
               (if (vlax-method-applicable-p (vla-get-utility (LM:acdoc)) 'getobjectidstring)
                   (list 'vla-getobjectidstring (vla-get-utility (LM:acdoc)) 'obj ':vlax-false)
                  '(LM:ename->objectid (vlax-vla-object->ename obj))
               )
              '(itoa (vla-get-objectid obj))
           )
       )
   )
   (LM:objectid obj)
)

;; Entity Name to ObjectID  -  Lee Mac
;; Returns the 32-bit or 64-bit ObjectID for a supplied entity name

(defun LM:ename->objectid ( ent )
   (LM:hex->decstr
       (setq ent (vl-string-right-trim ">" (vl-prin1-to-string ent))
             ent (substr ent (+ (vl-string-position 58 ent) 3))
       )
   )
)

;; Hex to Decimal String  -  Lee Mac
;; Returns the decimal representation of a supplied hexadecimal string

(defun LM:hex->decstr ( hex / foo bar )
   (defun foo ( lst rtn )
       (if lst
           (foo (cdr lst) (bar (- (car lst) (if (< 57 (car lst)) 55 48)) rtn))
           (apply 'strcat (mapcar 'itoa (reverse rtn)))
       )
   )
   (defun bar ( int lst )
       (if lst
           (if (or (< 0 (setq int (+ (* 16 (car lst)) int))) (cdr lst))
               (cons (rem int 10) (bar (/ int 10) (cdr lst)))
           )
           (bar int '(0))
       )
   )
   (foo (vl-string->list (strcase hex)) nil)
)

;; 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)

 

The above uses several functions from my Area Field to Attribute program.

 

Hi Lee

 

Is it possible to modify the above coding to have the "Myblock" with attribute tag housing the field to update depending on the reference block it is touching at it's insert point? Or if not, a way to reconnect the object ID to a different instance of the reference block with a different "TAG2" value, without having to reinsert "Myblock"?

 

In addition can matching attribute fields be incremented similar to your Automatically Label Attributes lisp, not just every instance of the block/tag?

 

For example:

 

Insert reference block "REF" with "TAG2" = ABC1

3 x "Myblock" inserted afterwards touching "REF" with "TAG1" = ABC1-1, ABC1-2, and ABC-1-3

Update/reconnect "Myblock" if it is moved or copied to touch a different instance of "REF" with different value for "TAG2" (ABC2) and restart increment e.g. ABC2-1, ABC2-2, etc.

 

Thanks

Edited October 10, 2016 by ReSiN