[编程交流] 获取Attdef脚本的ObjectID

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

(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

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

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

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