Edit Batch LISP

January 22, 2010

I have this program that was written by Tony Tanzillo and it works exactly the way I want my batch program to work only I want to run a text replace program on each drawing it opens before it saves and closes it.

;    Function from Tony Tanzillo Maestro Guru    ;


         ;;here will your batch function:
         (vla-setvariable file_obj "mirrtext" 0)
;          (vla-setvariable file_obj "insunits" 0)
;          (vla-setvariable file_obj "annotativedwg" 0)
         (vla-close file_obj :vlax-true)
         (vlax-release-object file_obj)
         (setq file_obj nil)
       )
     )
   )

I have been trying some things but I cant seem to figure out what I need to add to have this happen.

I guess I am not experienced enough to know which command to use. I know I would need to add this command line in the ";;here will your batch function:" area, but I don't know what command to use so that it will run my program when it opens.

The program I am trying to call out is REPSTRING, another LISP I use for text replacing.

January 22, 2010

I don't know if it is possible, but what if the program is paused long enough to run a command and then resumed after the command has been run?

January 22, 2010

I don't know if it is possible, but what if the program is paused long enough to run a command and then resumed after the command has been run?

This is not necessary when calling a function from within a LISP... but I don't really have enough code to work with here...

It depends whether your Text Replacement takes arguments, is invoked from the command line etc...

January 22, 2010

This is not necessary when calling a function from within a LISP... but I don't really have enough code to work with here...

It depends whether your Text Replacement takes arguments, is invoked from the command line etc...

How about this:

(defun C:OPB (/ *good-files* acapp adoc file_obj full-names-list osd)
 (alert
   "\nPlease wait a minute
\nto ending of batch file operation"
 )
  (vl-load-com)

 (setq    acapp (vlax-get-acad-object)
   adoc  (vla-get-activedocument acapp)
 )

 (vla-startundomark adoc)
 (setq osd (vla-getvariable adoc "SDI"))
 (vla-setvariable adoc "SDI" 0)
 (setq olsp (vla-getvariable adoc "LISPINIT"))
 (vla-setvariable adoc "LISPINIT" 0)
 (if (setq full-names-list
        (list-dwg (browse-folder "SELECT FOLDER" "C:\\"))
     )
   ; change on your start path folder 
   (progn
     (mapcar
   (function
     (lambda (i)
       (progn
         (setq file_obj (vla-open (vla-get-documents acapp) i))
         (setq *good-files* (cons file_obj *good-files*))
         ;;here will your batch function:
         (vla-setvariable file_obj "mirrtext" 0)
;          (vla-setvariable file_obj "insunits" 0)
;          (vla-setvariable file_obj "annotativedwg" 0)
         (vla-close file_obj :vlax-true)
         (vlax-release-object file_obj)
         (setq file_obj nil)
       )
     )
   )
   full-names-list
     )

     (cond ((zerop (length *good-files*))
        (princ "\nThere isn't opened files\n")
       )
       ((not (eq (length full-names-list) (length *good-files*)))
        (princ "\nSome files is not opened\n")
       )
       (T nil)
     )
   )
   (princ "\nThere isn't .DWG files in selected directory\n")
 )
 (vla-setvariable adoc "SDI" osd)
 (vla-setvariable adoc "LISPINIT" olsp)  
 (vla-endundomark adoc)
 (princ)
)

I am trying to avoid breaking any of Tony's rules...

January 22, 2010

So, yes, it does tell you where to put the function to operate on the drawing, so it depends on your format of the function you want to invoke - does it take arguments?

January 22, 2010

Yes... The command I am trying to run is called up by REPSTRING and has two arguments, what text to replace and what to replace it with.

I believe something like this:

REPSTRING

TEXT1

TEXT2

January 22, 2010

I tried to just plug in the line:

(command "REPSTRING" "TEXT1" "TEXT2" )

but this keeps coming up with unknown command, but I can type REPSTRING into the command line and it works fine every time.

January 22, 2010

No No, I mean is the function invoked at the command line, or is it a sub-function, taking arguments.

But, from your response I can see that it is invoked from the command line.

You can invoke these using

(c:repstring)

But, I would be inclined to change the code to a sub, taking arguments, as it will be more robust this way.

January 22, 2010

Ok so what if I added the REPSTRING LISP to this BATCH LISP:

(defun repstring (ostring nstring)
(setq ss (ssget "X" (list (cons 0 "INSERT,TEXT,MTEXT,RTEXT,DTEXT,DIMENSION"))))
    (if ss
        (progn
             (repeat (sslength ss)
             (setq ent (ssname ss 0))
             (setq en (entget ent))
             (setq etype (cdr (Assoc 0 en)))
                  (if (= etype "INSERT")
                     (PROGN
                          (IF (ASSOC 66 EN)
                               (PROGN
                               (SETQ SUB1 (ENTNEXT ENT))
                                    (WHILE (= (CDR (ASSOC 0 (ENTGET SUB1))) "ATTRIB")
                                    (SETQ SUBEN (ENTGET SUB1))
                                    (SETQ STG (CDR (aSSOC 1 SUBEN)))
                                    (SETQ STG (vl-string-subst NSTRING OSTRING STG))
                                    (ENTMOD (sUBST (cONS 1 STG) (aSSOC 1 SUBEN) SUBEN))
                                    (SETQ SUB1 (eNTNEXT SUB1))
                                    )
                               (ENTUPD ENT)
                               )
                          )
                     )
                     (PROGN
                     (SETQ STG (CDR (aSSOC 1 EN)))
                     (SETQ STG (vl-string-subst NSTRING OSTRING STG))
                     (ENTMOD (SUBST (CONS 1 STG) (ASSOC 1 EN) EN))
                     )
                  )
                  

             (ssdel ent ss)
             )
        )
    )
)

And then, in the section of the BATCH LISP where it calls to add batch function I place this:

(c:repstring ()
(REPSTRING OSTRING NSTRING)
)

Would that work?

I guess I would need to add this:

(SETQ OSTRING (GETSTRING T "\nSTRING TO BE REPLACED: "))
(SETQ NSTRING (GETSTRING T "\nSTRING TO REPLACE WITH: "))

Towards the begining of the OPB program.

January 22, 2010

No, you just need to call

(repstring "OldString" "NewString")

In the batch code.

January 22, 2010

So this should work?

(defun C:OPB (/ *good-files* acapp adoc file_obj full-names-list osd)
 (alert
   "\nPlease wait a minute
\nto ending of batch file operation"
 )
  (vl-load-com)

 (setq    acapp (vlax-get-acad-object)
   adoc  (vla-get-activedocument acapp)
 )

 (vla-startundomark adoc)
 (setq osd (vla-getvariable adoc "SDI"))
 (vla-setvariable adoc "SDI" 0)
 (setq olsp (vla-getvariable adoc "LISPINIT"))
 (vla-setvariable adoc "LISPINIT" 0)
 (if (setq full-names-list
        (list-dwg (browse-folder "SELECT FOLDER" "C:\\"))
     )
   ; change on your start path folder 
   (progn
     (mapcar
   (function
     (lambda (i)
       (progn
         (setq file_obj (vla-open (vla-get-documents acapp) i))
         (setq *good-files* (cons file_obj *good-files*))
         ;;here will your batch function:
       (REPSTRING "TEXT1" "TEXT2")
         (vla-setvariable file_obj "mirrtext" 0)
;          (vla-setvariable file_obj "insunits" 0)
;          (vla-setvariable file_obj "annotativedwg" 0)
         (vla-close file_obj :vlax-true)
         (vlax-release-object file_obj)
         (setq file_obj nil)
       )
     )
   )
   full-names-list
     )

     (cond ((zerop (length *good-files*))
        (princ "\nThere isn't opened files\n")
       )
       ((not (eq (length full-names-list) (length *good-files*)))
        (princ "\nSome files is not opened\n")
       )
       (T nil)
     )
   )
   (princ "\nThere isn't .DWG files in selected directory\n")
 )
 (vla-setvariable adoc "SDI" osd)
 (vla-setvariable adoc "LISPINIT" olsp)  
 (vla-endundomark adoc)
 (princ)
)

January 22, 2010

So this should work?

(defun C:OPB (/ *good-files* acapp adoc file_obj full-names-list osd)
 (alert
   "\nPlease wait a minute
\nto ending of batch file operation"
 )
  (vl-load-com)

 (setq    acapp (vlax-get-acad-object)
   adoc  (vla-get-activedocument acapp)
 )

 (vla-startundomark adoc)
 (setq osd (vla-getvariable adoc "SDI"))
 (vla-setvariable adoc "SDI" 0)
 (setq olsp (vla-getvariable adoc "LISPINIT"))
 (vla-setvariable adoc "LISPINIT" 0)
 (if (setq full-names-list
        (list-dwg (browse-folder "SELECT FOLDER" "C:\\"))
     )
   ; change on your start path folder 
   (progn
     (mapcar
   (function
     (lambda (i)
       (progn
         (setq file_obj (vla-open (vla-get-documents acapp) i))
         (setq *good-files* (cons file_obj *good-files*))
         ;;here will your batch function:
       (REPSTRING "TEXT1" "TEXT2")
         (vla-setvariable file_obj "mirrtext" 0)
;          (vla-setvariable file_obj "insunits" 0)
;          (vla-setvariable file_obj "annotativedwg" 0)
         (vla-close file_obj :vlax-true)
         (vlax-release-object file_obj)
         (setq file_obj nil)
       )
     )
   )
   full-names-list
     )

     (cond ((zerop (length *good-files*))
        (princ "\nThere isn't opened files\n")
       )
       ((not (eq (length full-names-list) (length *good-files*)))
        (princ "\nSome files is not opened\n")
       )
       (T nil)
     )
   )
   (princ "\nThere isn't .DWG files in selected directory\n")
 )
 (vla-setvariable adoc "SDI" osd)
 (vla-setvariable adoc "LISPINIT" olsp)  
 (vla-endundomark adoc)
 (princ)
)

I ran this program in this form but it does not do the text replace, but it does not get any errors.

January 22, 2010

It looks like your string replace function is case sensitive - bear this in mind.

January 22, 2010

This may work better for you:

(defun rstring (old new / *error* StringRep sel uFlag)
 (vl-load-com)
 ;; Lee Mac  ~  22.01.10

 
 (defun *error* (msg)
   (and uFlag (vla-EndUndoMark doc))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ))
 

 (defun StringRep (old new str)
   (while (vl-string-search old str)
     (setq str (vl-string-subst new old str)))
   str)

 (setq *doc (cond (*doc) ((vla-get-ActiveDocument (vlax-get-acad-object)))))    

 (if (ssget "_X" '((-4 . "<OR")
                     (0 . "*TEXT,*DIMENSION,MULTILEADER")
                     (-4 . "<AND")
                       (0 . "INSERT")
                       (66 . 1)
                     (-4 . "AND>")
                   (-4 . "OR>")))
   
   (if (not (vl-string-search old new))
     (progn
       (setq uFlag (not (vla-StartUndoMark *doc)))
       
       (vlax-for Obj (setq sel (vla-get-ActiveSelectionSet *doc))
       
         (cond (  (eq "AcDbBlockReference" (vla-get-ObjectName Obj))

                  (foreach att (vlax-invoke Obj 'GetAttributes)
                    (vla-put-TextString att (StringRep old new (vla-get-TextString att)))))
             
               (  (wcmatch (strcase (vla-get-ObjectName obj)) "*DIMENSION*")

                  (if (not (eq "" (vla-get-TextOverride obj)))
                    (vla-put-TextOverride obj (StringRep old new (vla-get-TextOverride obj)))))

               (t (vla-put-TextString obj (StringRep old new (vla-get-TextString obj))))))

       (vla-delete sel)
       (setq uFlag (vla-EndUndoMark *doc)))
     
     (princ "\n** New String Cannot Contain Old String **"))
   
   (princ "\n** No Text or Attributed Blocks Found **"))
 
 (princ))


;; Test Function

(defun c:test (/ old new)
 (setq old (getstring t "\nOld String: ")
       new (getstring t "\nNew String: "))
 (rstring old new)
 (princ))

Your old code only substituted the first occurrence of the string, this replaces all occurrences.

Also, this includes MultiLeaders.

Lee

January 22, 2010

This is what I set up:

(defun rstring (old new / *error* StringRep sel uFlag)
 (vl-load-com)
 ;; Lee Mac  ~  22.01.10

 
 (defun *error* (msg)
   (and uFlag (vla-EndUndoMark doc))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ))
 

 (defun StringRep (old new str)
   (while (vl-string-search old str)
     (setq str (vl-string-subst new old str)))
   str)

 (setq *doc (cond (*doc) ((vla-get-ActiveDocument (vlax-get-acad-object)))))    

 (if (ssget "_X" '((-4 . "<OR")
                     (0 . "*TEXT,*DIMENSION,MULTILEADER")
                     (-4 . "<AND")
                       (0 . "INSERT")
                       (66 . 1)
                     (-4 . "AND>")
                   (-4 . "OR>")))
   
   (if (not (vl-string-search old new))
     (progn
       (setq uFlag (not (vla-StartUndoMark *doc)))
       
       (vlax-for Obj (setq sel (vla-get-ActiveSelectionSet *doc))
       
         (cond (  (eq "AcDbBlockReference" (vla-get-ObjectName Obj))

                  (foreach att (vlax-invoke Obj 'GetAttributes)
                    (vla-put-TextString att (StringRep old new (vla-get-TextString att)))))
             
               (  (wcmatch (strcase (vla-get-ObjectName obj)) "*DIMENSION*")

                  (if (not (eq "" (vla-get-TextOverride obj)))
                    (vla-put-TextOverride obj (StringRep old new (vla-get-TextOverride obj)))))

               (t (vla-put-TextString obj (StringRep old new (vla-get-TextString obj))))))

       (vla-delete sel)
       (setq uFlag (vla-EndUndoMark *doc)))
     
     (princ "\n** New String Cannot Contain Old String **"))
   
   (princ "\n** No Text or Attributed Blocks Found **"))
 
 (princ))
;;;;;
;                            ;
(prompt "\n********************************************")
(prompt "\n    Enter OPB to run batch file operation\n")
(prompt "\n********************************************")
;                            ;
(defun C:OPB (/ *good-files* acapp adoc file_obj full-names-list osd)

  (vl-load-com)

 (setq    acapp (vlax-get-acad-object)
   adoc  (vla-get-activedocument acapp)
 )

 (vla-startundomark adoc)
 (setq osd (vla-getvariable adoc "SDI"))
 (vla-setvariable adoc "SDI" 0)
 (setq olsp (vla-getvariable adoc "LISPINIT"))
 (vla-setvariable adoc "LISPINIT" 0)
 (if (setq full-names-list
        (list-dwg (browse-folder "SELECT FOLDER" "C:\\"))
     )
   ; change on your start path folder 
   (progn
     (mapcar
   (function
     (lambda (i)
       (progn
         (setq file_obj (vla-open (vla-get-documents acapp) i))
         (setq *good-files* (cons file_obj *good-files*))
         ;;here will your batch function:
       (rstring "LINENAME1" "THIS WORKED")
;          (vla-setvariable file_obj "mirrtext" 0)
;          (vla-setvariable file_obj "insunits" 0)
;          (vla-setvariable file_obj "annotativedwg" 0)
         (vla-close file_obj :vlax-true)
         (vlax-release-object file_obj)
         (setq file_obj nil)
       )
     )
   )
   full-names-list
     )

     (cond ((zerop (length *good-files*))
        (princ "\nThere isn't opened files\n")
       )
       ((not (eq (length full-names-list) (length *good-files*)))
        (princ "\nSome files is not opened\n")
       )
       (T nil)
     )
   )
   (princ "\nThere isn't .DWG files in selected directory\n")
 )
 (vla-setvariable adoc "SDI" osd)
 (vla-setvariable adoc "LISPINIT" olsp)  
 (vla-endundomark adoc)
 (princ)
)

I just keep getting ** No Text or Attributed Blocks Found **

and no text has been changed

January 22, 2010

Ahh, of course!

You are operating outside of the activedoc... this disallows all command calls/ent* methods and SelSets..

Ok, bear with me for a bit.

January 22, 2010

Try this:

(defun rstring (old new doc / StringRep)
 (vl-load-com)
 ;; Lee Mac  ~  22.01.10

 (defun StringRep (old new str)
   (while (vl-string-search old str)
     (setq str (vl-string-subst new old str)))
   str)

 (if (not (vl-string-search old new))

   (vlax-for lay (vla-get-layouts doc)
 
     (vlax-for obj (vla-get-Block lay)
       
       (cond (  (and (eq "AcDbBlockReference" (vla-get-ObjectName Obj))
                     (eq :vlax-true (vla-get-HasAttributes obj)))

                (foreach att (vlax-invoke Obj 'GetAttributes)
                  (vla-put-TextString att (StringRep old new (vla-get-TextString att)))))
             
             (  (wcmatch (strcase (vla-get-ObjectName obj)) "*DIMENSION*")
              
                (if (not (eq "" (vla-get-TextOverride obj)))
                  (vla-put-TextOverride obj (StringRep old new (vla-get-TextOverride obj)))))
             
             (  (if (vlax-property-available-p obj 'TextString)
                  (vla-put-TextString obj (StringRep old new (vla-get-TextString obj))))))))
     
     (princ "\n** New String Cannot Contain Old String **"))

 (princ))


;;----------------------------------------------------------------------------------------------
(prompt "\n********************************************")
(prompt "\n    Enter OPB to run batch file operation \n")
(prompt "\n********************************************")



(defun C:OPB (/ *good-files* acapp adoc file_obj full-names-list osd)

  (vl-load-com)

 (setq acapp (vlax-get-acad-object)
       adoc  (vla-get-activedocument acapp))

 (vla-startundomark adoc)
 (setq osd (vla-getvariable adoc "SDI"))
 (vla-setvariable adoc "SDI" 0)
 (setq olsp (vla-getvariable adoc "LISPINIT"))
 (vla-setvariable adoc "LISPINIT" 0)
 
 (if (setq full-names-list (list-dwg (browse-folder "SELECT FOLDER" "C:\\")))
   (progn
     (mapcar
       (function
         (lambda (i)
           (progn
             (if (not (vl-catch-all-error-p
                        (setq file_obj
                          (vl-catch-all-apply (function vla-open)
                            (list (vla-get-documents acApp) i)))))
               (progn
                 (rstring "LINENAME1" "THIS WORKED" file_obj)
                 (vla-save file_obj)
                 (vla-close file_obj :vlax-true)
                 (vlax-release-object file_obj)
                 (setq file_obj nil))
                 
               (princ (strcat "\n** Error Opening File: " i " **"))))))
       
       full-names-list))
   
   (princ "\nThere aren't .DWG files in selected directory\n"))
 
 (vla-setvariable adoc "SDI" osd)
 (vla-setvariable adoc "LISPINIT" olsp)
 (vla-endundomark adoc)
 (princ))

{ Untested }

January 22, 2010

It went through with no erors and without that message, however none of the text was changed.

January 23, 2010

Sorry, code updated, an extra line for the save may be needed as the drawings are opened using the documents collection.

January 25, 2010

Sorry, code updated, an extra line for the save may be needed as the drawings are opened using the documents collection.

Perfect... Thank You Lee.

Sign In

Edit Batch LISP

Recommended Posts

AQucsaiJr

Top Posters In This Topic

Popular Days

Top Posters In This Topic

Popular Days

AQucsaiJr

Lee Mac

AQucsaiJr

Lee Mac

AQucsaiJr

AQucsaiJr

Lee Mac

AQucsaiJr

Lee Mac

AQucsaiJr

AQucsaiJr

Lee Mac

Lee Mac

AQucsaiJr

Lee Mac

Lee Mac

AQucsaiJr

Lee Mac

AQucsaiJr

Join the conversation

Tutorials

Forums

Activity