Edit Batch LISP

[AQucsaiJr]

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.

[AQucsaiJr]

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?

[Lee Mac]

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...

[AQucsaiJr]

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...

[Lee Mac]

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?

[AQucsaiJr]

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

[AQucsaiJr]

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.

[Lee Mac]

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.

[AQucsaiJr]

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.

[Lee Mac]

No, you just need to call

 

(repstring "OldString" "NewString")

 

In the batch code.

[AQucsaiJr]

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

[AQucsaiJr]

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.

[Lee Mac]

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

[Lee Mac]

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

[AQucsaiJr]

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

[Lee Mac]

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.

[Lee Mac]

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 }

[AQucsaiJr]

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

[Lee Mac]

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

[AQucsaiJr]

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.