;;; - ------------------------------------------------------------------------------ - ;
;;; -                      A C M - A T T R I B T O O L S                             - ;
;;; - ------------------------------------------------------------------------------ - ;
;;; - Beschreibung : Attributsbezeichnungen am Attribut und in der Blockdefinition   - ;
;;; -                in Abhängigkeit von der alten Attributsbezeichnung ändern.      - ;
;;; -                Unsichtbar- und Sichtbarschalten von Attributen durch Anklicken - ;
;;; - Befehle      : ATT-RENAME  ATT-HIDE  ATT-SHOW                                  - ;
;;; - ------------------------------------------------------------------------------ - ;
;;; - letzte Änderung am : 24.10.2023                                                - ;
;;; -              durch : Thomas Krüger                                             - ;
;;; - ------------------------------------------------------------------------------ - ;
(vl-load-com)
(defun c:ATT-RENAME( / ATT ATTNAME NEWNAME BLOCK? OWNER COUNT1 COUNT2 DT:OBJEKT:GETOWNER)
  (defun DT:OBJEKT:GETOWNER(OBJ)
    (if(and(setq OBJ(cond
                      ((=(type OBJ)'ENAME)(vlax-ename->vla-object OBJ))
                      ((=(type OBJ)'VLA-OBJECT)OBJ)
                    )
           )      
           (setq OWNER
             (cond
              ((and(>(vl-string-search "x64"(getvar "PLATFORM"))0)
                   (vlax-method-applicable-p(vla-get-Document OBJ)"ObjectIdToObject32")
                   (vlax-property-available-p OBJ "ownerid32")
               )
                (vlax-invoke-method
                  (vla-get-Document OBJ)'ObjectIdToObject32(vla-get-ownerid32 OBJ)
                )
              )                     
              ('T
                (vlax-invoke-method
                  (vla-get-Document OBJ)'ObjectIdToObject(vla-get-ownerid OBJ)
                )
              )
             )  
           )
       )
      OWNER
    )
  )
  (defun DT:ATT:RENAME( ATTNAME NEWNAME BLKNAME
                      / BLOCK ITEM ATTRIBUTES ATTRIBUT COUNT1 COUNT2
                      )
    (setq COUNT1 0)
    (setq COUNT2 0)
    (if(and(=(type ATTNAME)'STR)
           (=(type NEWNAME)'STR)
           (=(type BLKNAME)'STR)
           (or(= BLKNAME "*")
              (tblobjname "BLOCK" BLKNAME)
           )
       )
      (progn      
        (vlax-for BLOCK (vla-get-blocks
                           (vla-get-activedocument
                             (vlax-get-acad-object)
                           )
                        )
          (if(=(vla-get-isxref BLOCK):vlax-false)
            (vlax-for ITEM BLOCK
              (if(and(member (strcase(vla-get-objectname  ITEM))
                            '("ACDBBLOCKREFERENCE" "ACDBMINSERTBLOCK")
                     )      
                     (=(vla-get-hasattributes ITEM) :vlax-true)
                     (setq ATTRIBUTES (vlax-variant-value
                                        (vla-getattributes ITEM)
                                      )
                     )      
                     (=(vlax-safearray-get-dim ATTRIBUTES)1)
                     (<=(vlax-safearray-get-l-bound ATTRIBUTES 1)
                        (vlax-safearray-get-u-bound ATTRIBUTES 1)
                     )
                     (setq ATTRIBUTES(vlax-safearray->list ATTRIBUTES))
                     (or (= BLKNAME "*")
                         (=(strcase(vla-get-name ITEM))(strcase BLKNAME))
                     )
                 )              
                (foreach ATTRIBUT ATTRIBUTES
                  (if(=(strcase(vla-get-TagString ATTRIBUT))                     
                       (strcase ATTNAME)
                     )
                    (progn
                      (if(not(vl-catch-all-error-p
                               (vl-catch-all-apply
                                 'vla-put-TagString
                                 (list ATTRIBUT NEWNAME)
                               )
                             )
                         )
                        (setq COUNT1(1+ COUNT1))
                      )  
                      (if(not(member
                               (strcase(vla-get-name ITEM))
                               BLOCKLIST
                             )
                         )
                        (setq BLOCKLIST(cons
                                         (strcase(vla-get-name ITEM))
                                         BLOCKLIST
                                       )
                        )
                      )  
                    )  
                  )  
                )
              )
            )
          )
        )
        (vlax-for BLOCK (vla-get-blocks
                          (vla-get-activedocument
                            (vlax-get-acad-object)
                          )
                        )
          (if(member
               (strcase(vla-get-name BLOCK))
               BLOCKLIST
             )
            (vlax-for ITEM BLOCK
              (if(and(=(strcase(vla-get-objectname  ITEM))
                       "ACDBATTRIBUTEDEFINITION"
                     )
                     (=(strcase(vla-get-Tagstring ITEM))
                       (strcase ATTNAME)
                     )                             
                     (not(vl-catch-all-error-p
                           (vl-catch-all-apply
                            'vla-put-TagString
                            (list ITEM NEWNAME)
                           )
                         )
                     )
                 )
                (setq COUNT2 (1+ COUNT2))
              )  
            )  
          )  
        )  
      )          
    )
    (list COUNT1 COUNT2)
  )
  (if(and(or(setq ATT(car(nentsel "\nATTRIBUT wählen: ")))
            (prompt "\nNichts gewählt.Abbruch.")
         )   
         (setq ATT(vlax-ename->vla-object ATT))           
         (or(=(strcase(vla-get-objectname ATT))
              "ACDBATTRIBUTE"
            )
            (prompt "\nKein attribut gewählt.Abbruch.")
         )   
         (setq ATTNAME(vla-get-TagString ATT))
         (setq NEWNAME(getstring
                        (strcat"\nNeue Attributsbezeichnung für \"" ATTNAME"\" :")
                      )
         )
         (or
           (/= (setq NEWNAME(vl-string-trim " " NEWNAME))
               ""
           )
           (prompt "\nUngültige neue Attributsbezeichnung.Abbruch.")
         )    
         (or(initget "Alle Block")'T)
         (or(setq BLOCK?(=(getkword"\nWelche Attribute berücksichtigen [Block / Alle]<Alle>:")"Block"))
            'T
         )
     )
    (progn
      (if BLOCK?
        (progn
          (setq OWNER(DT:OBJEKT:GETOWNER ATT))
          (setq OWNER(vla-get-name OWNER))
        )
        (setq OWNER "*")
      )
      (vla-endundomark(vla-get-activedocument(vlax-get-acad-object)))
      (vla-startundomark(vla-get-activedocument(vlax-get-acad-object)))
      (setq COUNT(DT:ATT:RENAME ATTNAME NEWNAME OWNER))
      (vla-endundomark(vla-get-activedocument(vlax-get-acad-object)))
      (prompt (strcat "\n"
                      (itoa (car COUNT))
                      " Attribute mit Bezeichnung \""
                      ATTNAME
                      "\" gefunden und in \""
                      NEWNAME
                      "\" geändert."
              )
      )
      (prompt (strcat "\n"
                      (itoa (cadr COUNT))
                      " Attributsdefinitionen mit Bezeichnung \""
                      ATTNAME
                      "\" gefunden und in \""
                      NEWNAME
                      "\" geändert."
              )
      )
    )
  )
  (princ)
)
;;; - ------------------------------------------------------------------------------ - ;
(defun C:ATT-HIDE(/ ATT)
  (if(and(setq ATT(car(nentsel "\nAttribut wählen:")))
         (setq ATT(vlax-ename->vla-object ATT))
         (=(strcase(vla-get-objectname ATT))"ACDBATTRIBUTE")
     )
    (progn
      (vla-endundomark(vla-get-activedocument(vlax-get-acad-object)))
      (vla-startundomark(vla-get-activedocument(vlax-get-acad-object)))
      (vla-put-invisible  ATT :vlax-true)
      (vla-endundomark(vla-get-activedocument(vlax-get-acad-object)))
    )
    (princ"\nKein Attribut gewählt")    
  )
  (princ)    
)
;;; - ------------------------------------------------------------------------------ - ;
(defun C:ATTS-SHOW(/ AWS BLOCK ATTRIBUTES NOMUTT ANZ INDEX)
  (setq NOMUTT(getvar "NOMUTT"))
  (setvar "NOMUTT" 1)
  (princ "\nBlockreferenz mit Attributen wählen:")
  (vl-catch-all-error-p
    (setq AWS(vl-catch-all-apply
               'ssget (list '((0 . "INSERT")(66 . 1)))
             ) 
    )
  )   
  (setvar "NOMUTT" NOMUTT)
  (if (and (=(type AWS)'PICKSET)
           (>(setq ANZ(sslength AWS))0)
      )
    (progn
      (vla-endundomark(vla-get-activedocument(vlax-get-acad-object)))
      (vla-startundomark(vla-get-activedocument(vlax-get-acad-object)))
      (setq INDEX -1)
      (repeat ANZ
        (if(and(setq BLOCK(ssname AWS (setq INDEX (1+ INDEX))))
               (setq BLOCK(vlax-ename->vla-object BLOCK))
               (member (strcase(vla-get-objectname  BLOCK))
                       '("ACDBBLOCKREFERENCE" "ACDBMINSERTBLOCK")
               )
               (=(vla-get-hasattributes BLOCK):vlax-true)
               (setq ATTRIBUTES (vlax-variant-value
                                  (vla-getattributes BLOCK)
                                )
               )      
               (=(vlax-safearray-get-dim ATTRIBUTES)1)
               (<=(vlax-safearray-get-l-bound ATTRIBUTES 1)
                  (vlax-safearray-get-u-bound ATTRIBUTES 1)
               )
               (setq ATTRIBUTES(vlax-safearray->list ATTRIBUTES))
           )
          (foreach ATT ATTRIBUTES
            (vla-put-invisible  ATT :vlax-false)
          )
        )                 
      )  
      (vla-endundomark(vla-get-activedocument(vlax-get-acad-object)))
    )
    (princ"\nKeine Blockreferenz mit Attributen gewählt")    
  )
  (princ)    
)
;;; - ------------------------------------------------------------------------------ - ;
(defun ATTRIBTOOLS:INFO() 
  (mapcar
    'princ
    (list
      "\n\n"
      "\nATTRIB-Tools : Ändern der Attributsbezeichnung und Sichtbarkeit"   
      "\n=============="
      "\n(C) Thomas Krüger 2023  E-Mail: tk@cad-od.de"  
      "\nBefehlsaufruf : ATT-RENAME  ATT-HIDE  ATT-SHOW"
      "\n"    
    )
  )
  (princ)  
) 
;;; - ------------------------------------------------------------------------------ - ;
(ATTRIBTOOLS:INFO)
(princ)

