Script. Save, Open, Close, Switch back to original DWG

[svorgodne]

I am creating a copy from a drawing with Autolisp and creating a script which will be dettaching all xrefs on the copy. After saving the copy, the last command of the script is "close", then I would like to go back to the original drawing from where the copy was made from. This is not happening if there are some other drawings opened, then it makes active the last opened drawing. I need an automatic process since I will not be the final user and they might get confused.

 

Here it is the code:

 

(defun run
 (/ mc_scr)
 (setq switch_dwg
   (strcat
     (getvar 'dwgprefix)
     (getvar 'dwgname)
   )
 )
 (setq mc_scr (open (strcat (getenv "temp") "\\mc.scr") "w"))
 (foreach mem0
   (list
     "open"
     (strcat "\"" new_c "\"")
     "(setq opn_dwg_lst nil)"
     "(vlax-for"
     "  x"
     "  (vla-get-documents"
     "    (vlax-get-acad-object)"
     "  )"
     "  (setq opn_dwg_lst (cons x opn_dwg_lst))"
     ")"
     "-xref"
     "d"
     "*"
     "-purge"
     "a"
     "*"
     "n"
     "_ucs"
     "_w"
     "_plan"
     "_w"        
     "_zoom"
     "_e"
     "(foreach SYM_MEM opn_dwg_lst"
     "  (if "
     "    (="
     "      (strcat"
     "        \"A\""
     "        (substr"
     "          (getvar \"dwgname\")"
     "          2"
     "        )"
     "      )"
     "      (vla-get-name SYM_MEM)"
     "    )"
     "    (setq SYM_A SYM_MEM)"
     "  )"
     ")"
     "qsave"
     "close"
     "(vla-activate SYM_A)"
   )
   (write-line mem0 mc_scr)
 )
 (close mc_scr)
)
(defun mc
   (/ new_c mc)
   (setvar 'CMDECHO 0)
 (if 
   (=
     (substr
       (getvar 'dwgname)
       1 2
     )
     "A_"
   )
   (progn
     (command "qsave")
     (setq new_c 
       (strcat
         (getvar 'dwgprefix)
         (vl-string-subst "B_" "A_" (getvar 'dwgname))
       )
     )
     (cond
       (
         (/= (findfile new_c) nil)
         (command "save" new_c "y")
         (run)
       )
       (T
         (command "save" new_c)
         (run)
       )
     )
     (command "script" (strcat (getenv "temp") "\\mc.scr"))
   )
 )
 (setvar 'CMDECHO 1)
 (princ)
)
(mc)

 

Any clue?

 

thanks in advance

 

Svorgodne

[Cad64]

Your question has been moved to the Autolisp section. Please post your lisp related questions here: http://www.cadtutor.net/forum/forumdisplay.php?21-AutoLISP-Visual-LISP-amp-DCL

[rlx]

I dont really see how your routine would work but maybe I could recommend Lee's script writer program?

 

http://lee-mac.com/scriptwriter.html

 

I'm not sure if you could go back to the last drawing. If Lee's program doesn't work for you I might have a plan b but it's part of a larger program I wrote for scripts so I would first have to isolate the part that would be of interest to you but I'm kinda busy right now with another program I'm working on. Can tell you what it does , first make a list of all open drawings and save all open drawings , then start a new drawing and close all open drawings , after that open all drawings you want to process and when that's done open all drawings that were previously open. But all that information must be written to the scriptfile before you execute it.

 

Gr. Rlx

[BIGAL]

One way is to use two scripts upon starting overwrite a script but has only one line

Open originaldrawing

 

Just add script originaldwg as last line.

[svorgodne]

So far what I have achieved is this

I have drawing

"A.dwg"

 

Save it adding a prefix

"PREFIX-A.dwg"

 

Open

"PREFIX-A.dwg"

via vla-open or script

 

Delete some entity (layer) in

"PREFIX-A.dwg"

 

Go back to Drawing

"A.dwg"

Using vla-activate

 

But not being able to close drawing

"PREFIX-A.dwg"

(vla-close maybe?)

 

or viceversa

 

Close drawing

"PREFIX-A.dwg"

(vla-close maybe?)

 

But not being able to go back to Drawing

"A.dwg"

Using vla-activate

 

 

Of course in any case the problem remains if there are more drawings opened at the same time. gone through that already.

 

Thanks again in advance

Svorgodne

[Happy Hobbit]

Why actually close A.dwg ?

 

I suggest using vl-file-copy to make a copy, a suffix can easily be coded in, the file opened (within the lisp), the layer deleted the file saved then closed

[rlx]

May this is what your looking 4?

 

 

; RlxScript made by Rlx 16-feb-2016
; CadTutor example to run a script when in mdi mode
(defun c:RlxScript ( / RlxScript-MasterScript fp script-lines open-drawing-list restore-list script-cmd)
 (setq RlxScript-MasterScript (strcat (getvar "savefilepath") "RlxScript.scr")
fp (open RlxScript-MasterScript "w")
script-lines (RlxScript_SelectScript)
open-drawing-list (ListAllOpenDrawings)
restore-list (mapcar '(lambda(x)(if (= (vla-get-ReadOnly (cdr x)) :vlax-true)
      (cons (car x) " y")(cons (car x) ""))) open-drawing-list))
 ; Here you could also pass your own list of drawings. As it is now it will run the script on all open
 ; drawings and moste things could therefore also be done using vla- commands
 ;
 ; Suppose you place a select folder here , something like (setq dwgs2bscripted (getdwgsfromfolder)) , then
 ; replace 'open-drawing-list' with 'dwgs2bscripted'.
 ;
 ; Script will now start new dwg (for script to be able to run)
 ; it will then close all the open drawings , saving their names in the restore-list
 ; Then the script will run on all dwg's in the folder you selected en finally restore all previously open drawings
 ; This routine is basicly ment for working in mdi mode , usually I prefer to run my scripts in sdi mode.
 (if (and fp script-lines open-drawing-list)
   (progn
     (write-line (strcat "(setvar \"filedia\" 0)\n.new\n\n(close_all_but_current)") fp)
     (mapcar '(lambda (open-dwg)
  (write-line (Open_Cmd (car open-dwg)) fp)
    (mapcar '(lambda (script-cmd) (write-line script-cmd fp)) script-lines)
      (write-line (Close_Cmd) fp))
      open-drawing-list)
     (mapcar '(lambda (x)(write-line (strcat ".open " (car x)(cdr x)) fp)) restore-list)))
 (if fp
   (progn (close fp)(gc)(command "._script" RlxScript-MasterScript))
   (alert"Couldn't make script file")))
(defun ListAllOpenDrawings (/ lst each dwg doclist)
 (setq doclist (vla-get-documents (vlax-get-acad-object)))
 (vlax-for each doclist
   (setq dwg (strcase
 (vl-string-translate "\\" "/"
   (strcat (vla-get-path each) "/" (vla-get-name each))) t))
   (if (not (wcmatch (strcase dwg) "*DRAWING*"))
     (setq lst (append lst (list (cons dwg each))))
   )
 )
 lst
)
(defun Open_Cmd (fn / open-cmd fp-tmp)
 (cond ((void fn)(setq open-cmd ""))
((not (findfile fn))
 (setq open-cmd
 (strcat ".new\n\n(setvar \"texteval\" 1)\n"
  "text m (getvar \"viewctr\") (/ (getvar\"viewsize\") 25) 0 "
  "\"Not Found " fn "\"")))
((assoc fn restore-list)
 (setq open-cmd (strcat ".open " fn (cdr (assoc fn restore-list)))))
((IsRO fn)
 (setq open-cmd (strcat ".open " fn " Y")))
(t (setq open-cmd (strcat ".open " fn)))) open-cmd)
(defun Close_Cmd ()
 (strcat "(if (= (getvar \"writestat\") 1)(command \".qsave\" \".close\")"
  "(if (> (getvar \"dbmod\") 0)(command \"close\" \"Y\")(command \"close\")))"))
(defun IsRO (fn / fp)(cond ((setq fp (open fn "a"))(close fp)))(not fp))
(defun RlxScript_SelectScript ( / script-name script-fp input script-data)
 (if (and (setq script-name (findfile (getfiled "Select a script file" "" "scr" ))
   (setq script-fp (open script-name "r"))
   (setq input (read-line script-fp)))
   (while input (setq script-data (cons input script-data) input (read-line script-fp))))
 (if script-fp (close script-fp))
 (reverse script-data)
)

Gr. Rlx

 

 

b.t.w. if you want to be able to select a folder you can find an example here : http://www.cadtutor.net/forum/showthread.php?95337-Batch-rename-with-info-from-block-attributte

Edited February 18, 2016 by rlx

[Steven P]

Good afternoon, Really busy today.. so I have gone back to  post nearly 4 years old.. I can't get it to work, it looks like it is stopping after "Defun Open_CMD" , it stops for me at the  (void fn) condition, any ideas?

[rlx]

probably add this to the code

 (defun void (x) (or (null x) (and (= (type x) 'STR) (= "" (vl-string-trim " \t\r\n" x))))) 

[Steven P]

Thanks, I'll try it in the morning