Visual LISP, AutoLISP and General Customization
cancel
Showing results for 
Show  only  | Search instead for 
Did you mean: 

Global Attribute Change Mulitple Drawings

4 REPLIES 4
Reply
Message 1 of 5
alan1959
1344 Views, 4 Replies

Global Attribute Change Mulitple Drawings

We have a few hundred drawings that we need to change certain block attributes. We need to change the valve of the text in that attribute from whatever it is (doe snot matter what it is) to a specific text string.

 

For example:

 

If the attribute is called "name" and has the text string of ALAN in it in some drawing or BRUCE in other drawings, we want to chaneg all drawings to TOM.

 

Any help with a lisp routine would be appreciated.

Thanks

4 REPLIES 4
Message 2 of 5
pbejse
in reply to: alan1959


@alan1959 wrote:

We have a few hundred drawings that we need to change certain block attributes. We need to change the valve of the text in that attribute from whatever it is (doe snot matter what it is) to a specific text string.

 

For example:

 

If the attribute is called "name" and has the text string of ALAN in it in some drawing or BRUCE in other drawings, we want to chaneg all drawings to TOM.

 

Any help with a lisp routine would be appreciated.

Thanks


QUESTION:

this might sound silly to you but, are these attribtues LEFT justified? it matters using ODBX wtih attribute editing  but not for script.

 

Also we can narrow down if you supply the block name


 

Message 3 of 5
pbejse
in reply to: pbejse

Okay....have time to kill.

 

In conjunction with this code from our fellow member Lee Mac

 

see attached file:

 

command: Reptag

Enter Tag name to search: Name

Enter Text String: Banana Cake

Browse for folder....

 

HTH

 

[kudos to LM]

 

 

Message 4 of 5
alan1959
in reply to: pbejse

Some of the attriubutes are LEFT justified while others are CENTER justified. The block name is TB-TEXT and an example of the attribute I want to change is TITLE_1 or LOCATION

Message 5 of 5
Hallex
in reply to: alan1959

Something like this may help

See comments within the code

divide this code on 2 files:

{code}

;;; -----------------------------   SCRPROC.lsp   -------------------------------;;;
;;; you can save this file in any place
;;; 5/28/09

;;; edited 2/9/12
;;;--------------------------  Write and run script   ----------------------------;;;
(defun C:SCRPROC(/ allfiles allfolders dwgname dwgs fn scrpath subfold x)

;; Files & Folders
;; Function to create a tree-structured list of folders
;; given the parent folder as a Path.
;; Note that using a path of "" or "." or "\\" will exclude
;; the drive letter.  McNeel's DOSLIB has a DOS_FULLPATH function
;; that can return such folders with drive designations.
;; (c) John F. Uhden, Cadlantic
(defun @Folders (Path / Folders )
  (defun @Dirs (Path / Dir Dirs)
    (and
      (= (type Path) 'STR)
;;;      (or
;;;        (/= (type DOS_FULLPATH) 'EXRXSUBR)
;;;        (setq Path (DOS_FULLPATH Path))
;;;      )
      (if (wcmatch Path ",*/,*\\")
        (setq Dir Path)
        (setq Dir (strcat Path "\\"))
      )
      (setq Dirs (vl-directory-files Dir "*.*" -1))
      (setq Folders (cons Path Folders))
      (setq Dirs (vl-remove-if '(lambda (x)(vl-position x '("." ".."))) Dirs))
      (mapcar '@Dirs (mapcar '(lambda (x)(strcat Dir x)) Dirs))
    )
  )
  (@Dirs Path)
  (reverse Folders)
)
 
;;;---------------------------  main part   ------------------------;;;
 
(setq dwgname (getfiled "Select Drawing File"   "" "dwg" 16))
(setq allfolders (@Folders (vl-filename-directory dwgname)))
 
  (foreach subfold allfolders
    (setq dwgs (vl-directory-files subfold "*.dwg" 1))
    (if dwgs
      (setq allfiles (append (mapcar '(lambda (x)(if(wcmatch subfold ",*/,*\\")
         (strcat subfold x)
         (strcat subfold "\\" x))
     ) dwgs)
        allfiles)))
    )


(setq scrpath (strcat (vl-filename-directory dwgname) "\\BatchAtt.scr"))

      (setq fn      (open scrpath "w"))(princ)

     (foreach dwgpath allfiles

(write-line (strcat "_open \"" dwgpath "\"") fn)
  (write-line "(C:SCA)" fn);;<--THIS MUST BE IN THE SEARCH PATH
   (write-line "_redraw" fn)
     (write-line (strcat "_.saveas  \"" dwgpath "\"") fn);<--- DO NOT TOUCH THIS LINE!
       (write-line "_close"  fn)
  (close fn)
  (terpri)
  (command "_.script" scrpath)
  (princ)
  )
(princ "\n\t---   Start commad with SCRPROC   ---")
(prin1)

 

 


  ;;; -----------------------------   SCA.lsp   -------------------------------;;;
  ;;; SCA.lsp save this file in the support path only, e.g in:
  ;;; (strcat (getvar "ROAMABLEROOTPREFIX") "Support")
  ;;; you can move it from this folder after the work is finished
  ;;;;; Note: you have to put this file in startup suite:
  ;;; Tools->AutoLIsp->Load Application->Startup suit / Contents->Add
  ;;; 2/9/12
(defun C:SCA (/ acapp adoc allfiles allfolders ;|att_data-global|; bname dwgname dwgs lt olayouts subfold tabs x)
 
(defun _getsortedtabs (/ tabs tabName)
    (vlax-for Layout
                     (vla-get-Layouts
                       (vla-get-activedocument (vlax-get-acad-object))
                     )
      (if
       
          (/= (setq tabName (strcase (vla-get-name layout))) "MODEL")
          (setq tabs (cons (cons (vla-get-taborder layout) tabName) tabs)
        )       
      )
      ;;sort tabs
      (setq tabs (vl-sort tabs '(lambda (lta ltb)(< (car lta)(car ltb)))))
     
    )
 (mapcar 'cdr tabs)
  )
;; change block name here
(setq bname "TB-TEXT")
 
;;Change this list of pairs (tag . value) to your suit
(setq att_data (list
   '("TITLE_1" .  "VALUE OF TITLE_1 IS HERE")
   '("LOCATION" .  "VALUE OF LOCATION IS HERE")
   ;;add other pairs like this
   '("MYTAG" .  "VALUE OF MYTAG  IS HERE")
   ;;;etc etc
   ))
 
(setq tabs (_getsortedtabs))
  (setq acapp(vlax-get-acad-object))
  (setq adoc (vla-get-activedocument acapp))
  (setq olayouts (vla-get-Layouts adoc))
  (vla-put-activespace adoc 0)
(foreach ltname tabs
  (setq lt (vla-item olayouts ltname))
  (vla-put-activelayout (vla-get-activedocument (vlax-get-acad-object)) lt)
  (vla-zoomextents (vlax-get-acad-object));<-- zoom to extents every tab, optional
  (vlax-for obj (vla-get-block lt)
    (if (and (eq "AcDbBlockReference" (vla-get-objectname obj))
      (eq bname (vla-get-effectivename obj))
 )
      (progn
 (foreach attobj (vlax-invoke obj 'getattributes)
   (foreach record att_data
     ;; use exact match:
     (if (eq (car record) (vla-get-tagstring attobj))
       (vla-put-textstring attobj (cdr record))
     )

   )
 )
      )
    )
  )
)
  (setvar "tilemode" 1);<-- switch to model, optional


  (vlax-release-object olayouts)
  (vlax-release-object adoc)
  (vlax-release-object acapp)

  (princ)
  )
(vl-load-com)
(princ)

{code}

 

~'J'~

_____________________________________
C6309D9E0751D165D0934D0621DFF27919

Can't find what you're looking for? Ask the community or share your knowledge.

Post to forums  

Autodesk Design & Make Report

”Boost