Visual LISP, AutoLISP and General Customization

Visual LISP, AutoLISP and General Customization

Reply
Contributor
alan1959
Posts: 25
Registered: ‎12-14-2011
Message 1 of 5 (746 Views)

Global Attribute Change Mulitple Drawings

746 Views, 4 Replies
02-06-2012 01:12 PM

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

*Expert Elite*
pbejse
Posts: 2,460
Registered: ‎11-24-2009
Message 2 of 5 (733 Views)

Re: Global Attribute Change Mulitple Drawings

02-06-2012 10:08 PM 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


 

*Expert Elite*
pbejse
Posts: 2,460
Registered: ‎11-24-2009
Message 3 of 5 (726 Views)

Re: Global Attribute Change Mulitple Drawings

02-07-2012 03:42 AM 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]

 

 

Contributor
alan1959
Posts: 25
Registered: ‎12-14-2011
Message 4 of 5 (702 Views)

Re: Global Attribute Change Mulitple Drawings

02-09-2012 08:22 AM 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

*Expert Elite*
Hallex
Posts: 1,569
Registered: ‎10-08-2008
Message 5 of 5 (691 Views)

Re: Global Attribute Change Mulitple Drawings

02-09-2012 12:25 PM 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:smileyfrustrated:CRPROC(/ 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:smileyfrustrated:CA)" 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:smileyfrustrated:CA (/ 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
Announcements
Are you familiar with the Autodesk Expert Elites? The Expert Elite program is made up of customers that help other customers by sharing knowledge and exemplifying an engaging style of collaboration. To learn more, please visit our Expert Elite website.
Need installation help?

Start with some of our most frequented solutions or visit the Installation and Licensing Forum to get help installing your software.