One I've been thinking about for a long time, but have never done anything about it...
In addition to Save and Saveas, it would be nice to have a Rename function which would basically SaveAs, then delete the original... with an 'Are you sure' message, of course.
/idea
;;;COMMAND: RENDWG
;;;FUNCTION: Save current drawing as a new one with user specified name and
;;; delete original drawing if successful.
;;;NOTES: Current drawing should have been saved prior to using this command.
;;;By: Kelie Feng, April 2006.
;;;
(defun C:RENDWG (/ *ERROR* app saveAsType doc oPath oDwgName dir nDwgName nPath)
(setq app (vlax-get-acad-object)
saveAsType (vla-get-saveastype
(vla-get-opensave
(vla-get-preferences app)
)
)
doc (vla-get-activedocument app)
oPath (vla-get-fullname doc)
oDwgName (vla-get-name doc)
dir (getvar "DWGPREFIX")
)
(setq nDwgName (getstring 1 "\nType new drawing name w/o extension: ")
nPath (strcat dir nDwgName ".dwg")
)
(if (or (not (findfile nPath))
(KF:Yes? nil
(strcat "File \"" nDwgName ".dwg\"" " exists. Overwrite?")
)
)
(if (not
(vl-catch-all-error-p
(vl-catch-all-apply
(function
(lambda ()
(vla-saveas doc nPath saveAsType)
(vl-file-delete oPath)
)
)
)
)
)
(prompt "\nDone.")
(prompt "\nRename/delete failed.")
)
)
(princ)
)
(defun KF:Yes? (default msg / input)
(initget "Yes No")
(setq input (getkword (strcat "\n"
msg
" [Yes/No] <"
(if default
"Y"
"N"
)
">: "
)
)
)
(cond
((= input "Yes") t)
((= input "No") nil)
(t default)
)
)
(princ)
;;;
;;; TITLE:moddwg.lsp
;;;
;;; Copyright (C) 2005 by Andy Hudson
;;;
;;; Permission to use, copy, modify, and distribute this
;;; software and its documentation for any purpose and without
;;; fee is hereby granted
;;;
;;; THIS SOFTWARE IS PROVIDED "AS IS" WITHOUT EXPRESS OR
;;; IMPLIED WARRANTY. ALL IMPLIED WARRANTIES OF FITNESS FOR ANY
;;; PARTICULAR PURPOSE AND OF MERCHANTABILITY ARE HEREBY
;;; DISCLAIMED.
;;;
;;; Andy Hudson
;;; April 2005
;;;
;;;-------------------------------------------------------------
;;; Description:
;;;
;;; Routine to make modifying a drawing comply with company
;;; Standards the routine Moves the file to a Mods folder to
;;; ensure only current drawings remain in the current folder
;;;
;;;
;;;-------------------------------------------------------------
;;; COMMAND
;;; moddwg
;;;-------------------------------------------------------------
;;;
;;error checker from www.afralisp.com
;;;
(LOAD "R:/DWG/aids/blocks/rybka_blocks/lisps/ERROR.LSP")
;;
(defun c:moddwg (/ oldname olddir oldrev newrev newname newdir origfile combined)
;;change filename to show new revision
(setq oldname (getvar "dwgname")
olddir (getvar "dwgprefix")
oldrev (getstring T "\nEnter Drawing number and current revision: ")
newrev (Getstring T "\nEnter drawing number and New Revision: ")
newname (vl-string-subst newrev oldrev oldname)
newdir (strcat olddir "Mods\\")
origfile (STRCAT olddir oldname))
;;;COMBINE INFORMATION
(SETQ combined (STRCAT newdir newname))
;;MAKE MODS FOLDER
(if (not (member "Mods" (vl-directory-files (getvar "dwgprefix") nil -1)))
(vl-mkdir (strcat (getvar "dwgprefix") "Mods")))
;;check if file exists
(if (findfile combined)
(alert (strcat "File " combined " already exists In Mods Folder! "))
(progn);progn
);if
;;SAVE DRAWING
(COMMAND "_.SAVEAS" "" combined)
;;DELETE THE OLD FILE
(VL-FILE-DELETE ORIGFILE)
(princ)
)
(prompt "\nModify Drawing Lisp Loaded, enter moddwg to run.")
(princ)
(DEFUN C:copy_backup_as
(/ *error* activedoc docfullname backuppath archivename)
;; codehimbelonga kwb@theSwamp
;; requires the DosLib Library.
;;
;; IAcadDocument Object
(SETQ activedoc (VLA-GET-ACTIVEDOCUMENT (VLAX-GET-ACAD-OBJECT)))
;;
;;------ Set Error Trap --------------------------
;;
(DEFUN *error* (msg /) (kb:on-error msg))
(VLA-ENDUNDOMARK activedoc) ; end any open undo group
(VLA-STARTUNDOMARK activedoc) ; start new group
;;
;;----- Main --------------------------
;;
(VLA-SAVE activedoc)
(IF
(AND
(NOT (= 0 (STRLEN (SETQ docfullname (VLA-GET-FULLNAME activedoc))))
)
(SETQ backuppath (DOS_MKDIR
(STRCAT (VL-FILENAME-DIRECTORY docfullname)
"\\DRAWINGArchive"
)
)
)
(SETQ archivename
(STRCAT backuppath
(VL-FILENAME-BASE (VLA-GET-NAME activedoc))
"-"
(RTOS (* (GETVAR "cdate") 1000000) 2 0)
".dwg"
)
)
)
(VL-FILE-COPY docfullname archivename)
;; else
(ALERT "Ooooops. Unable to establish ArchiveName.")
)
(PROMPT (STRCAT "\n Archived file : " archivename))
(*error* nil)
(PRINC)
)
One I've been thinking about for a long time, but have never done anything about it...
In addition to Save and Saveas, it would be nice to have a Rename function which would basically SaveAs, then delete the original... with an 'Are you sure' message, of course.
/idea
Well, Kelie was nice enough to take this one on and sent me the following. I thought that since we had one person interested in it, that I'd open it up to everyone. (With Kelie's permission, of course)
Again, Thanks a lot! :)Code: [Select];;;COMMAND: RENDWG
;;;FUNCTION: Save current drawing as a new one with user specified name and
;;; delete original drawing if successful.
;;;NOTES: Current drawing should have been saved prior to using this command.
;;;By: Kelie Feng, April 2006.
;;;
(defun C:RENDWG (/ *ERROR* app saveAsType doc oPath oDwgName dir nDwgName nPath)
(setq app (vlax-get-acad-object)
saveAsType (vla-get-saveastype
(vla-get-opensave
(vla-get-preferences app)
)
)
doc (vla-get-activedocument app)
oPath (vla-get-fullname doc)
oDwgName (vla-get-name doc)
dir (getvar "DWGPREFIX")
)
(setq nDwgName (getstring 1 "\nType new drawing name w/o extension: ")
nPath (strcat dir nDwgName ".dwg")
)
(if (or (not (findfile nPath))
(KF:Yes? nil
(strcat "File \"" nDwgName ".dwg\"" " exists. Overwrite?")
)
)
(if (not
(vl-catch-all-error-p
(vl-catch-all-apply
(function
(lambda ()
(vla-saveas doc nPath saveAsType)
(vl-file-delete oPath)
)
)
)
)
)
(prompt "\nDone.")
(prompt "\nRename/delete failed.")
)
)
(princ)
)
(defun KF:Yes? (default msg / input)
(initget "Yes No")
(setq input (getkword (strcat "\n"
msg
" [Yes/No] <"
(if default
"Y"
"N"
)
">: "
)
)
)
(cond
((= input "Yes") t)
((= input "No") nil)
(t default)
)
)
(princ)
(if (not AH:getvalsm)(load "Multi Getvals.lsp"))
(setq ans (AH:getvalsm (list "Enter value " "Length " 25 24 (getvar 'dwgname) )))
(http://)
You can use a simple dialog box to get the string.
Something like:Code - Auto/Visual Lisp: [Select]
label = \"Enter String\";" fo) label = \"\"; edit_width = 30; key = \"stringdlg\"; is_default = true; " fo) alignment = centered; fixed_width = true; : button { label = \"OK\"; key = \"dcl_accept\"; width = 10; allow_accept = true; } } }" fo) str ) ;; Use the above like this:
I am sure I have seen a command that lets you do a edit string with a couple of lines of code trying to remember what it was. May be one of the acet commands. Will have a look around.
Just a comment, I use my library function Multi getvals.lsp as it can be used in any code. The number of values to enter is controlled by the list input, 1-about 20.Code: [Select](if (not AH:getvalsm)(load "Multi Getvals.lsp"))
(http://)
(setq ans (AH:getvalsm (list "Enter value " "Length " 25 24 (getvar 'dwgname) )))
;;;COMMAND: RENDWG
;;;FUNCTION: Save current drawing as a new one with user specified name and
;;; delete original drawing if successful.
;;;NOTES: Current drawing should have been saved prior to using this command.
;;;By: Kelie Feng, April 2006.
;;;
(defun C:RENDWG (/ *ERROR* app saveAsType doc oPath oDwgName dir nDwgName nPath)
(setq app (vlax-get-acad-object)
saveAsType (vla-get-saveastype
(vla-get-opensave
(vla-get-preferences app)
)
)
doc (vla-get-activedocument app)
oPath (vla-get-fullname doc)
oDwgName (vla-get-name doc)
dir (getvar "DWGPREFIX")
)
(if (not AH:getvalsm) (load "Multi Getvals.lsp"))
; (setq nDwgName (getstring 1 "\nType new drawing name w/o extension: ")
(setq nDwgName (getstring 1 (AH:getvalsm (list "Enter Drawing Number " "Number " 25 24 (strcase (acet-filename-ext-remove (getvar 'DWGNAME))))))
nPath (strcat dir nDwgName ".dwg")
)
(if (or (not (findfile nPath))
(KF:Yes? nil
(strcat "File \"" nDwgName ".dwg\"" " exists. Overwrite?")
)
)
(if (not
(vl-catch-all-error-p
(vl-catch-all-apply
(function
(lambda ()
(vla-saveas doc nPath saveAsType)
(vl-file-delete oPath)
)
)
)
)
)
(prompt "\nDone.")
(prompt "\nRename/delete failed.")
)
)
(princ)
)
(defun KF:Yes? (default msg / input)
(initget "Yes No")
(setq input (getkword (strcat "\n"
msg
" [Yes/No] <"
(if default
"Y"
"N"
)
">: "
)
)
)
(cond
((= input "Yes") t)
((= input "No") nil)
(t default)
)
)
(princ)
Thanks Bigal,
This looks simple but I have no idea how to use it.
regardsI am sure I have seen a command that lets you do a edit string with a couple of lines of code trying to remember what it was. May be one of the acet commands. Will have a look around.
Just a comment, I use my library function Multi getvals.lsp as it can be used in any code. The number of values to enter is controlled by the list input, 1-about 20.Code: [Select](if (not AH:getvalsm)(load "Multi Getvals.lsp"))
(http://)
(setq ans (AH:getvalsm (list "Enter value " "Length " 25 24 (getvar 'dwgname) )))
;;;COMMAND: RENDWG
;;;FUNCTION: Save current drawing as a new one with user specified name and
;;; delete original drawing if successful.
;;;NOTES: Current drawing should have been saved prior to using this command.
;;;By: Kelie Feng, April 2006.
;;;Revised C.Potter December 2023. (https://www.theswamp.org/index.php?topic=9696.0)
;;;
(defun GetString-dlg (str / dcl_id fn fo)
(setq fn (vl-filename-mktemp "" "" ".dcl"))
(setq fo (open fn "w"))
(setq ValueStr (strcat "value = \"" str "\";"))
(write-line "stringdlg : dialog {
label = \"Enter New Filename\";" fo
)
(write-line ": edit_box {
label = \"\";
edit_width = 30;
key = \"stringdlg\";
is_default = true; " fo
)
(write-line ValueStr fo)
(write-line "}" fo)
(write-line ": row {
alignment = centered;
fixed_width = true;
: button {
label = \"OK\";
key = \"dcl_accept\";
width = 10;
allow_accept = true;
}
}
}" fo
)
(close fo)
(setq dcl_id (load_dialog fn))
(new_dialog "stringdlg" dcl_id)
(action_tile "stringdlg" "(setq str $value)(done_dialog)")
(start_dialog)
(unload_dialog dcl_id)
str
)
(defun C:RENDWG1 (/ *ERROR* app saveAsType doc oPath oDwgName dir nDwgName nPath)
(setq app (vlax-get-acad-object)
saveAsType (vla-get-saveastype
(vla-get-opensave
(vla-get-preferences app)
)
)
doc (vla-get-activedocument app)
oPath (vla-get-fullname doc)
oDwgName (vla-get-name doc)
dir (getvar "DWGPREFIX")
)
(setq nDwgName (getstring 1 (getstring-dlg (strcase (acet-filename-ext-remove (getvar 'DWGNAME)))))
nPath (strcat dir nDwgName ".dwg")
)
(if (or (not (findfile nPath))
(KF:Yes? nil
(strcat "File \"" nDwgName ".dwg\"" " exists. Overwrite?")
)
)
(if (not
(vl-catch-all-error-p
(vl-catch-all-apply
(function
(lambda ()
(vla-saveas doc nPath saveAsType)
(vl-file-delete oPath)
)
)
)
)
)
(prompt "\nDone.")
(prompt "\nRename/delete failed.")
)
)
(princ)
)
(defun KF:Yes? (default msg / input)
(initget "Yes No")
(setq input (getkword (strcat "\n"
msg
" [Yes/No] <"
(if default
"Y"
"N"
)
">: "
)
)
)
(cond
((= input "Yes") t)
((= input "No") nil)
(t default)
)
)
(princ)
I am so lost now...
I managed to incorporate Johns code and have the pop-up populated with the current filename but something is still not right.
I type the new filename in the dialog, hit enter. The new filename appears on the command line, and I must hit enter again.
Then I end up with a file called ".dwg.dwg"
I am so lost now...
I managed to incorporate Johns code and have the pop-up populated with the current filename but something is still not right.
I type the new filename in the dialog, hit enter. The new filename appears on the command line, and I must hit enter again.
Then I end up with a file called ".dwg.dwg"
Can you please help
--->%
Here is a version using powershell to create a saveFileDialog.
It falls back on getfiled when something doesn't work.
I should have spent less time on this, but I got a bit obsessed with getting a resizable file dialog.
Here is a complete code that should work. Although, there are some other areas of the code which I think should be corrected but I do not have the time at the moment, and this should work fine for now.
I am so lost now...
I managed to incorporate Johns code and have the pop-up populated with the current filename but something is still not right.
I type the new filename in the dialog, hit enter. The new filename appears on the command line, and I must hit enter again.
Then I end up with a file called ".dwg.dwg"
Can you please help
--->%
You are very close. The line you had wrong was:
(setq nDwgName (getstring 1 (getstring-dlg (strcase (acet-filename-ext-remove (getvar 'DWGNAME)))))
it should be:
(setq nDwgName (getstring-dlg (strcase (acet-filename-ext-remove (getvar 'DWGNAME))))
Here is a complete code that should work. Although, there are some other areas of the code which I think should be corrected but I do not have the time at the moment, and this should work fine for now.Code - Auto/Visual Lisp: [Select]
;;;COMMAND: RENDWG ;;;FUNCTION: Save current drawing as a new one with user specified name and ;;; delete original drawing if successful. ;;;NOTES: Current drawing should have been saved prior to using this command. ;;;By: Kelie Feng, April 2006. ;;;Revised C.Potter December 2023. (https://www.theswamp.org/index.php?topic=9696.0) ;;; label = \"Enter New Filename\";" fo ) label = \"\"; edit_width = 30; key = \"stringdlg\"; is_default = true; " fo ) alignment = centered; fixed_width = true; : button { label = \"OK\"; key = \"dcl_accept\"; width = 10; allow_accept = true; } } }" fo ) str ) saveAsType (vla-get-saveastype ) ) ) ) (KF:Yes? nil ) ) ) ) ) ) ) ) ) ) msg " [Yes/No] <" (if default "Y" "N" ) ">: " ) ) ) (cond ((= input "Yes") t) ((= input "No") nil) (t default) ) )
Oops, I removed the dependencies. Could you give it another try?Here is a version using powershell to create a saveFileDialog.
It falls back on getfiled when something doesn't work.
I should have spent less time on this, but I got a bit obsessed with getting a resizable file dialog.
Was not able to find copies of LM:acobj or LM:acdoc called in your program.
Can you share these?
Steve
Oops, I removed the dependencies. Could you give it another try?Here is a version using powershell to create a saveFileDialog.
It falls back on getfiled when something doesn't work.
I should have spent less time on this, but I got a bit obsessed with getting a resizable file dialog.
Was not able to find copies of LM:acobj or LM:acdoc called in your program.
Can you share these?
Steve