Save drawing to new name in Visual Lisp reactor

dvertz · ‎11-29-2022

Been attempting this for weeks now, learned a lot from the internet. Getting the impression this can only be done one way. I don't like the visual outcome. Hoping someone might know a better way, or at least how to suppress visual appearance on the command history.

As being in the reactor, cannot use "COMMAND" or "VL-CMDF" to do "SAVE".

Visual Lisp programmers messed up. They created "VLA-SAVEAS" & "VLA-SAVE". "VLA-SAVE" is actually "QSAVE" and there is no function for "SAVE" in Visual Lisp, that I have found.

Yes. I need to do a "SAVE" as I do not want to "QSAVE" the current drawing. I may not wish to save the changes when I close the drawing.

So, in my search I found one post on the forums where it was suggested to use "VLA-SENDCOMMAND". This function would be fine except by the nature of the function, everything sent is displayed on the command history. And as the SAVE command issues the browse dialog, it is required to turn off the sysvar "filedia" before sending the command "SAVE". In addition, the "VLA-SENDCOMMAND" is asynchronous and therefore does not always execute as laid out in the LISP code. I have found that this works (but sometimes the vla-sendcommand function fails) so I would rather find another way.

(vla-sendcommand (vla-get-activedocument (vlax-get-acad-object)) "(setvar \"filedia\" 0) ")
(vla-sendcommand (vla-get-activedocument (vlax-get-acad-object)) (strcat "_.save " "\"" STR:FOLDER STR:SFNAME "\"" "\r"))
(vla-sendcommand (vla-get-activedocument (vlax-get-acad-object)) "(setvar \"filedia\" 1) ")

But everything else I have tried, does not work.

Something I have tried is:

(setvar "filedia" 0)
(vla-sendcommand (vla-get-activedocument (vlax-get-acad-object)) (strcat "_.save " "\"" STR:FOLDER STR:SFNAME "\"" "\r"))
(setvar "filedia" 1)

Result is "fildia" being set out of order.

I found a suggestion to use a reactor for control of the "filedia".

(vlr-lisp-reactor (cons FD (getvar "filedia")) '((:vlr-lispended . SG-RESTORE-FD)))

However, it did not fire as expected.

Civil 3D 2022,
Windows 10 Pro, x64, Nvidia Quadro P1000
Intel Core i9-11900k; 3.50GHz, 32 GB RAM, 500GB WD BLACK M.2

Moshe-A · ‎11-29-2022

@dvertz hi,

why can you use (getfiled) + (vla-saveas FileName) ?

Moshe

hmsilva · ‎11-30-2022

@dvertz try

(setvar "filedia" 0)
(vla-sendcommand (vla-get-activedocument (vlax-get-acad-object)) (strcat "_.save " "\"" STR:FOLDER STR:SFNAME "\"" "\rfiledia\r1\r"))

Hope this helps,
Henrique

dvertz · ‎11-30-2022

Moshe-A,

Thank you for your suggestion. But I don't see how this helps. As being inside a reactor, the GETFILED would be just the same as not setting FILDIA. All dialogs need suppression. SAVEAS would also present a problem as it sets the current drawing to that file. I would like to keep the current file path and name as it currently is.

Civil 3D 2022,
Windows 10 Pro, x64, Nvidia Quadro P1000
Intel Core i9-11900k; 3.50GHz, 32 GB RAM, 500GB WD BLACK M.2

dvertz · ‎11-30-2022

hmsilva, Thank you for your suggestion.

I have tried many things and this was one of them. I had also tried placing the value of FILDIA in a variable to restore to whatever the user could have it currently set to. This does work for the most part. The larger issue is sometimes VLA-SENDCOMMAND fails with the only way to restore the function is to close the drawing and re-open. When that happens, it leaves FILEDIA in the incorrect state. Would you know why VLA-SENDCOMMAND might sometimes fail?

I was hoping for an answer that could take me away from VLA-SENDCOMMAND. I was looking at using vla-wblock instead (posted to another thread).

Civil 3D 2022,
Windows 10 Pro, x64, Nvidia Quadro P1000
Intel Core i9-11900k; 3.50GHz, 32 GB RAM, 500GB WD BLACK M.2

ВeekeeCZ · ‎11-30-2022

THIS add-on does not work for you?

dvertz · ‎11-30-2022

Ah, You found the one I am currently using and have been for years. When CAD-Studio sold to Arkance, they started changing the Add-On. It is currently in a very annoying Trial state where it keeps poping up the web browser. Plus I wanted to add some features they don't have. So, I have been writing my own. My interface is done and working great (including the reactors that fire). But its the saving part I am having trouble with. I think I am going to find that Visual Lisp cannot do it.

Civil 3D 2022,
Windows 10 Pro, x64, Nvidia Quadro P1000
Intel Core i9-11900k; 3.50GHz, 32 GB RAM, 500GB WD BLACK M.2

ВeekeeCZ · ‎11-30-2022

And those features you're talking about, does it makes sense to suggest to them to include those in it? Have you tried to ask them?

dvertz · ‎11-30-2022

BeekeeCZ,

I have not tried to ask them or make suggestions. I gave up on emailing them when they would not reply to other emails I sent them.

Civil 3D 2022,
Windows 10 Pro, x64, Nvidia Quadro P1000
Intel Core i9-11900k; 3.50GHz, 32 GB RAM, 500GB WD BLACK M.2

hmsilva · ‎11-30-2022

@dvertz wrote:

...

I have tried many things and this was one of them. I had also tried placing the value of FILDIA in a variable to restore to whatever the user could have it currently set to. This does work for the most part. The larger issue is sometimes VLA-SENDCOMMAND fails with the only way to restore the function is to close the drawing and re-open. When that happens, it leaves FILEDIA in the incorrect state. Would you know why VLA-SENDCOMMAND might sometimes fail?

...

I don't recall sendcommand fail
Are you using a command reactor, to catch the save, qsave?
Show us a code snippet.

Henrique

dvertz · ‎11-30-2022

hmsilva,

No. Not a command reactor, yes a reactor. The editor reactor. Should it be the command reactor instead?

My code is a disarray of comments right now as I work through this situation. So I have copied and pasted the pertinent code. It is not all of the code.

(defun SG-REACTOR ()
  (if (or (= STR:QSAVES "1") (= STR:AUTOSV "1"))
    (progn
      (if (not *DSReactor*) (setq *DSReactor* (vlr-editor-reactor nil '((:vlr-beginSave . DS-changed)))))
      (if (not *SCReactor*) (setq *SCReactor* (vlr-editor-reactor nil '((:vlr-saveComplete . SC-changed)))))
    )
  )
)

(defun DS-changed (DS-data DS-callback / )

  (setq STR:SFNAME STR:FORMAT)
  (SG-DATETIME)
  (SG-SFNAME)
  (if (and (= STR:QSAVES "1") (= (getvar "cmdnames") "QSAVE"))
    (progn
      (princ (strcat "\nSafeGuard> Performing QSAVE " STR:FOLDER STR:SFNAME " ... "))
      (SG-SAVEDWG)
    )
  )
  (if (and (= STR:AUTOSV "1")(= (getvar "cmdnames") nil))
    (progn
      (princ (strcat "\nSafeGuard> Performing AutoSAVE " STR:FOLDER STR:SFNAME " ... "))
      (SG-SAVEDWG)
    )
  )
)
(defun SG-SAVEDWG ( / )
  (cond ((= STR:METHOD "0")
          (setq temp (strcat "_.save " "\"" STR:FOLDER STR:SFNAME "\"" "\r"))
          (vla-sendcommand (vla-get-activedocument (vlax-get-acad-object)) "(setvar \"filedia\" 0) ")
          (vla-sendcommand (vla-get-activedocument (vlax-get-acad-object)) temp) ; (strcat "_.save" " " temp " "))
          (vla-sendcommand (vla-get-activedocument (vlax-get-acad-object)) "(setvar \"filedia\" 1) ")
          ;(vla-sendcommand (vla-get-activedocument (vlax-get-acad-object)) (strcat "(setvar \"filedia\" " (itoa FD) ") "))
        )
  )
)
(defun SG-DATETIME ()
      (setq STR:NOW (rtos (getvar "cdate") 2 8)) ;20031119.173505
      (setq STR:YEAR (substr STR:NOW 1 4)) ;2003
      (setq STR:YR (substr STR:NOW 3 2)) ;03
      (setq STR:MNTH (substr STR:NOW 5 2)) ;11
      (setq STR:DAY (substr STR:NOW 7 2)) ;19
      (setq STR:HOUR (substr STR:NOW 10 2)) ;17
      (setq STR:MIN (substr STR:NOW 12 2)) ;35
      (setq STR:SEC (substr STR:NOW 14 2)) ;05
)
(defun SG-SFNAME ()
  ;; (setq STR:FORMAT "SG $yyyy$mm$dd-$HH$MM$SS_$n$e") (C:\\temp\\SG 20031119-173505-PreSubPlat.dwg)
  (setq STR:MONTH (list "January" "February" "March" "April" "May" "June" "July" "August" "September" "October" "November" "December"))
  (setq STR:MMM (list "Jan" "Feb" "Mar" "Apr" "May" "Jun" "Jul" "Aug" "Sept" "Oct" "Nov" "Dec"))
  (setq STR:DDD (nth (fix (rem (1+ (getvar "date")) 7)) '("Sun" "Mon" "Tue" "Wed" "Thu" "Fri" "Sat")))
  (setq STR:DAYS (nth (fix (rem (1+ (getvar "date")) 7)) '("Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday" "Sunday")))

  (setq STR:SFNAME (vl-string-subst STR:YEAR "$yyyy" STR:SFNAME)) ;2003
  (setq STR:SFNAME (vl-string-subst STR:YR "$yy" STR:SFNAME))     ;03

  (if (= (substr STR:MNTH 1 1) "0") (setq STR:MON (substr STR:MNTH 2 1))(setq STR:MON STR:MNTH))
  (setq STR:SFNAME (vl-string-subst (nth (1- (atoi STR:MON)) STR:MMM) "$mmm" STR:SFNAME)) ;Mar
  (setq STR:SFNAME (vl-string-subst (nth (1- (atoi STR:MON)) STR:MONTH) "$mon" STR:SFNAME)) ;March

  (setq STR:SFNAME (vl-string-subst STR:MNTH "$mm" STR:SFNAME))   ;11
  (if (= (substr STR:MNTH 1 1) "0") (setq STR:MNTH (substr STR:MNTH 2 1)))
  (setq STR:SFNAME (vl-string-subst STR:MNTH "$m" STR:SFNAME))   ;1

  (setq STR:SFNAME (vl-string-subst STR:DDD "$ddd" STR:SFNAME)) ;Mon
  (setq STR:SFNAME (vl-string-subst STR:DAYS "$day" STR:SFNAME)) ;Monday

  (setq STR:SFNAME (vl-string-subst STR:DAY "$dd" STR:SFNAME))    ;19
  (if (= (substr STR:DAY 1 1) "0") (setq STR:DAY (substr STR:DAY 2 1)))
  (setq STR:SFNAME (vl-string-subst STR:DAY "$d" STR:SFNAME))   ;1

  (setq STR:SFNAME (vl-string-subst STR:HOUR "$HH" STR:SFNAME))   ;17
  (if (= (substr STR:HOUR 1 1) "0") (setq STR:HOUR (substr STR:HOUR 2 1)))
  (setq STR:SFNAME (vl-string-subst STR:HOUR "$H" STR:SFNAME))   ;1

  (setq STR:SFNAME (vl-string-subst STR:MIN "$MM" STR:SFNAME))    ;35
  (if (= (substr STR:MIN 1 1) "0") (setq STR:MIN (substr STR:MIN 2 1)))
  (setq STR:SFNAME (vl-string-subst STR:MIN "$M" STR:SFNAME))   ;3

  (setq STR:SFNAME (vl-string-subst STR:SEC "$SS" STR:SFNAME))    ;05
  (if (= (substr STR:SEC 1 1) "0") (setq STR:SEC (substr STR:SEC 2 1)))
  (setq STR:SFNAME (vl-string-subst STR:SEC "$S" STR:SFNAME))   ;5

  (setq STR:SFNAME (vl-string-subst (vl-filename-base (getvar "DWGNAME")) "$n" STR:SFNAME))
  (setq STR:SFNAME (vl-string-subst (vl-filename-extension (getvar "DWGNAME")) "$e" STR:SFNAME))
)

Civil 3D 2022,
Windows 10 Pro, x64, Nvidia Quadro P1000
Intel Core i9-11900k; 3.50GHz, 32 GB RAM, 500GB WD BLACK M.2

ronjonp · ‎11-30-2022

I put this together a while back. It makes 15 minute backups of a drawing stored like so:

"C:\AutoCAD-BAK\2022.11.30\12-15\PROJECT.FOLDER1.FOLDER2\Drawing.dwg"

Maybe you can find a use for it.

(defun rjp-backupdwg (/ _date bd copyp d date dcp dp dwgp h m)
  ;; RJP » 2016-05-10
  (defun _date (f) (menucmd (strcat "M=$(edtime,$(getvar,date)," f ")")))
  (cond	((and (= 1 (getvar 'dwgtitled) (getvar 'writestat))
	      (or (vl-file-directory-p (setq bd (strcat (getenv "homedrive") "\\AutoCAD-BAK\\")))
		  (vl-mkdir bd)
	      )
	 )
	 (setq dp    (getvar 'dwgprefix)
	       date  (_date "YYYY.MO.DD/")
	       m     (itoa (abs (- (rem (setq m (atoi (_date "MM"))) 15) m)))
	       h     (strcat (_date "HH")
			     "-"
			     (if (= m "0")
			       "0"
			       ""
			     )
			     m
			     "/"
		     )
	       dcp   (strcat (vl-string-right-trim "." (substr (vl-string-translate "\\\"" "." dp) 4)) "/")
	       copyp (strcat bd date h dcp (getvar 'dwgname))
	       dwgp  (strcat dp (getvar 'dwgname))
	 )
	 (vl-mkdir (setq d (strcat bd date)))
	 (vl-mkdir (setq d (strcat d h)))
	 (vl-mkdir (setq d (strcat d dcp)))
	 (and (findfile copyp) (vl-file-delete copyp))
	 (and (vl-file-directory-p d) (vl-file-copy dwgp copyp))
	)
  )
  (princ)
)

dvertz · ‎12-01-2022

ronjonp,

Thanks for the code. It appears to be making a copy of the the last time the current drawing was saved. I am looking to save changes up to the latest changes which may not have been saved yet.

One thing I see in the code that will be helpful is the variable I didn't know about "writestat". Nice way to check for read-only status, Thank you.

Civil 3D 2022,
Windows 10 Pro, x64, Nvidia Quadro P1000
Intel Core i9-11900k; 3.50GHz, 32 GB RAM, 500GB WD BLACK M.2

hmsilva · ‎12-01-2022

@dvertz wrote:

...

I am looking to save changes up to the latest changes which may not have been saved yet.

...

@dvertz it's your goal to save a copy each time a change is made in the current dwg?

dvertz · ‎12-01-2022

Yes. And No. Copy being the key.

Not to save the current drawing. Save a copy of the current drawing in the current state.

Not with a change of the drawing but when the reactor is fired.

Civil 3D 2022,
Windows 10 Pro, x64, Nvidia Quadro P1000
Intel Core i9-11900k; 3.50GHz, 32 GB RAM, 500GB WD BLACK M.2

hmsilva · ‎12-01-2022

@dvertz wrote:

Yes. And No. Copy being the key.

Not to save the current drawing. Save a copy of the current drawing in the current state.

Not with a change of the drawing but when the reactor is fired.

@dvertz if the dwg is too big it will be painful to save a copy in every command...

As a demo...

(vl-load-com)
(defun c:demo ()
    (defun MY_BK (rea clb)
	(if (and (not (wcmatch (strcase (car clb)) "*SAVE*,*ZOOM*,*PAN*,*REGEN*"))
		 (eq 1 (logand 1 (getvar 'DBMOD)))
	    )
	    (progn
		(setq dwg (vla-get-activedocument (vlax-get-acad-object)))
		(vla-sendcommand dwg "Backuping\r")
	    )
	)
    )
    (if	*BKReactor
	(progn
	    (vlr-remove *BKReactor)
	    (setq *BKReactor nil
		  MY_BK	nil
	    )
	    (prompt "\n>>>>>>>> MY_BK reactor is stopped!!! ")
	)
	(progn
	    (setq *BKReactor (vlr-command-reactor "Backup reactor" '((:vlr-commandEnded . MY_BK))))
	    (prompt "\n>>>>>>>> MY_BK reactor is starting!!! ")
	)
    )
    (princ)
)

(defun c:backuping (/ *error* old_echo)
    (defun *error* (msg)
	(if old_echo
	    (setvar 'CMDECHO old_echo)
	)
	(cond
	    ((not msg))
	    ((wcmatch (strcase msg) "*QUIT*,*CANCEL*"))
	    (T (princ (strcat "\nError: " msg)))
	)
	(princ)
    )
    (setq old_echo (getvar 'CMDECHO))
    (setvar 'CMDECHO 0)
    (setq date (rtos (getvar 'CDATE) 2 6))
    (command "_.save" (strcat (getvar 'DWGPREFIX) (vl-filename-base (getvar 'DWGNAME)) "_" (substr date 5 2) "-" (substr date 7 2) "-" (substr date 1 4) "-" (substr date 10 2) "-" (substr date 12 2) "-" (substr date 14 2) ".dwg"))
    (setvar 'CMDECHO 1)
    (command)
    (princ)
)

Hope this helps,
Henrique

vladimir_michl · ‎12-05-2022

Hello,

there is no dead trial state of SureSave, this addon is still being updated (see the History on https://www.cadstudio.cz/en/apps/suresave/). The web "pop-up" just reminds you that there is a newer, updated version of the app for download. Just download and install it - you will see no more pop-ups and you will get new functionality.

Regards

Vladimir Michl, www.arkance-systems.cz - www.cadforum.cz

Community

Save drawing to new name in Visual Lisp reactor

Save drawing to new name in Visual Lisp reactor

Save drawing to new name in Visual Lisp reactor