svorgodne Posted February 8, 2016 Share Posted February 8, 2016 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 Quote Link to comment Share on other sites More sharing options...
Cad64 Posted February 8, 2016 Share Posted February 8, 2016 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 Quote Link to comment Share on other sites More sharing options...
rlx Posted February 10, 2016 Share Posted February 10, 2016 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 Quote Link to comment Share on other sites More sharing options...
BIGAL Posted February 11, 2016 Share Posted February 11, 2016 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. Quote Link to comment Share on other sites More sharing options...
svorgodne Posted February 16, 2016 Author Share Posted February 16, 2016 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 Quote Link to comment Share on other sites More sharing options...
Happy Hobbit Posted February 16, 2016 Share Posted February 16, 2016 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 Quote Link to comment Share on other sites More sharing options...
rlx Posted February 17, 2016 Share Posted February 17, 2016 (edited) 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 Quote Link to comment Share on other sites More sharing options...
Steven P Posted January 21, 2020 Share Posted January 21, 2020 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? Quote Link to comment Share on other sites More sharing options...
rlx Posted January 21, 2020 Share Posted January 21, 2020 probably add this to the code (defun void (x) (or (null x) (and (= (type x) 'STR) (= "" (vl-string-trim " \t\r\n" x))))) Quote Link to comment Share on other sites More sharing options...
Steven P Posted January 21, 2020 Share Posted January 21, 2020 Thanks, I'll try it in the morning Quote Link to comment Share on other sites More sharing options...
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.