TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: cmwade77 on November 12, 2010, 11:12:03 AM
-
Ok, so with reference manager, it is easy to handle when we need to move xrefs or rename folders....but I have a different issue......
First, here is our normal workflow:
- Get backgrounds from Architect
- Clean them up (Overkill, color 8, shaded, make everything bylayer, etc.
- Setup sheets with these files xrefed in
We usually try to keep the architect's filenames the same, to make it easier if we need to send CAD files back to them and it's usually how they want it.
Here's the problem though, some architects like to rename the files every time that they send them to us, unfortunately we never know which architects are going to do this and which ones aren't when we setup the projects initially. When we only have one or two files from the architect, this is no real problem; however, there are times where there are 100+ files that the architect has renamed. I can usually get them to fill out a list of old to new filenames fairly quickly when this happens, so I am wondering if anyone has or knows of a routine that can read a file with this list (most likely a .csv, excel or text file) and modify the xrefs inside of drawings or rename the files back to the original names, etc.?
I am going to work on one, but I didn't want to reinvent the wheel if it already exists. I have searched for one, but haven't come across anything that is quite what is needed.
-
Stupid architects...LOL
-
Ah, it happens, just trying to make our life a little easier to deal with it.
-
(vlax-Dump-Object (vlax-Ename->Vla-Object (car (entsel))) T)
; Property values:
; ...
; Name = "XREF-NUMBER-ONE--"
; ...
; Path = "C:\\tmp\\DRAWING-ONE.dwg"
-
I'd talk to the client.
-
I believe you would need to alter the xref name in the block table, but check for duplicate keys first.
Maybe something along these lines... unless I've misunderstood you:
(defun c:XRefUpd ( / b ) (vl-load-com)
(vlax-for x
(vla-get-Blocks
(vla-get-ActiveDocument
(vlax-get-acad-object)
)
)
(if
(and
(eq :vlax-true (vla-get-isXref x))
(setq b (vl-filename-base (vla-get-path x)))
(not (tblsearch "BLOCK" b))
)
(vla-put-name x b)
)
)
(princ)
)
-
This could be a good starting point, once I figure out how it all works.....LOL....basically, I just have to figure out the mapping old filenames to new filenames portion I think now......like I said, a good starting point though, thank you.
-
My 2¢ ... seems to me an improved work flow is in order, so that when a file comes in it is sanitized and then published (and renamed according to the project standards) to a folder (or folders) so that updates automagically and intelligently cascade through the system by virtue of the underlying file structure(s). Initial work to realize that end may involve programatically altering existing pathing.
-
The problem is that many of our clients wouldn't accept that, so I am working it the other way around to address this issue.
-
I humbly submit it sounds like your clients need to be educated. You are the CADD expert, they are coming to you for your expertise, it's an opportunity to demonstrate efficient and intelligent use of AutoCAD -- and leadership. I'd seize it. But hey what do I know, you're working and I'm unemployed, so I'll shadup.
-
I humbly submit it sounds like your clients need to be educated.
http://www.theswamp.org/index.php?topic=35702.msg409327#msg409327
Spot on :-)
It's amazing how many routines we write to fix other peoples bad habits. :-(
-
automagically
:lol:
-
exactly (http://www.theswamp.org/screens/mp/modesty.gif)
-
I humbly submit it sounds like your clients need to be educated.
http://www.theswamp.org/index.php?topic=35702.msg409327#msg409327
Spot on :-)
It's amazing how many routines we write to fix other peoples bad habits. :-(
I know, but I only get so much control over how much we can educate our clients and some of them never quite get it, even when we do try to educate them.
Maybe this would help: :pissed:
-
When considering a "solution" it's good to consider the solution's (1) scalability [will it work on projects with 10, 100, 1000 drawings] (2) frequency [how many times will the "solution" have to be applied to the project as it progresses] (3) adaptability [is it adaptable to other projects, other clients) (4) and ultimately standardization [how do we do our work, regardless the client, recognizing what we turn over is not necessarily the same as interim products] ... yada ad infuckinitum.
But hey, if the client is willing to pay you the extra time required to work dumb AFTER you have attempted to enlighten them let them pay. :evil:
-
I wish they would be willing to pay....they just don't see anything wrong with how they do things.....so basically, I am trying to make the best of a bad situation....like I said, it's easy when it's one or two files, it is a lot more complicated when there are more.
-
ergo item 4
-
I know I am architect and I am stupid. I agree with that line of thought. But from being on the other end of dealing with stupid sub-consultants that never seem to be using the most current xref, I have taken the habit of prefixing my xref file name with the date every time I send them out. It just makes that useless game end a little faster. Now what I won''t rename is are my nested xrefs but we do not have a lot of them to begin with.
I know that that is pita for them (and you) but oh well. But I add by saying that 100 files to be renamed is bit much.
Now if you want them to change hit them them where it hurts, charge them additional services. The will either change their ways or pay you. But I would do that if it is way beyond resonable expectations.
-
A simple prefix, I have no problems with, because I can use a bulk rename utility.
Here's what typically happens in these situations, the filename is set with some sort of convention, then another drafter at the architect's office is assigned to the project, they decide that they don't like how files are named and change them, then send them to us.
I have tried to get my boss to go for extra services when they change all of their filenames, but he will not go for it.
Here is an example of how we get to 100 files easily:
Say we have a project with 3 floor and 8 buildings, each of those buildings have 30 units on 3 floors spread across 20 unit types. Each unit type is an xref, so that is 20 files right there, then each building has nine files (one for the xref of each floor and the roof and each one has the sheet that we have to xref because that is what has the room names, slopes, etc. on it. There is also the gridlines for each bulding), then there are the site plans, then the elevations and sections, which are quite often required these days. The total can quite easily get up to 100.
Now when file names are renamed, they will do something like:
1st flr plan -> First Floor Plan
or
1st flr plan -> A-2.0
or
A-2.0 -> 1st flr plan
But this can change with some architects every single time that they send files.
Also, please note that I never once said Architects are stupid (others may have, but I did not), I only said that this issue causes major problems. As I said, a prefix makes sense, but to educate the Architects on this board, your changing one filename can affect 20+ sheets.
For Example:
You change the filename for Building 1 (3 story), well that file is referenced into the following sheets:
Mechanical
Site Plan
First Floor Plan
Second Floor Plan
Third Floor Plan
Roof Plan
Enlarged Plans (2-3 Sheets worth)
Electrical
Site Plan
First Floor Lighting Plan
First Floor Power and Signal Plan
Second Floor Lighting Plan
Second Floor Power and Signal Plan
Third Floor Lighting Plan
Third Floor Power and Signal Plan
Roof Plan
Enlarged Plans (4-6 Sheets worth)
Plumbing
Site Plan
First Floor Waste & Vent
First Floor Water & Gas
Second Floor Waste & Vent
Second Floor Water & Gas
Third Floor Plan Waste & Vent
Third Floor Water & Gas
Roof Plan
Enlarged Plans (4-6 Sheets worth)
As you can see, it adds up fast and the enlarged plans are enlarged areas of the floor plans, not including the unit plans. If i had my way, every time that a file is changed by the architect, I would charge an extra service, but since it is not my choice, I have to do what I can to make it easier to deal with.
-
Please note that the code has not been fully tested, but here is what I have come up with:
;Thanks to Lee Mac for the starting off point for this at http://www.theswamp.org/index.php?topic=35702.msg409330#msg409330
(defun c:FXP (/ x a fld pth fl oldname newname changed)
(vl-load-com)
(setq Doc (vla-get-activedocument (vlax-get-acad-object)))
(setq space
(if (zerop (vla-get-activespace doc))
(if (= (vla-get-mspace doc) :vlax-true)
(vla-get-modelspace doc) ; active VP
(vla-get-paperspace doc)
)
(vla-get-modelspace doc)
)
)
(setq fld (dos_getdir "" "h:\\BEI-TEMP\\" "Select the folder that has the updated backgrounds:" T))
(vlax-for x (vla-get-blocks Doc)
(cond
((= (vla-get-isXref x) :vlax-true)
(setq a (vl-filename-base (vla-get-path x))
pth (strcat (vl-filename-directory (vla-get-path x)) "\\")
)
(cond
((= (vl-file-size (strcat fld a)) nil)
(cond
((/= (vl-file-size (strcat pth "remap.dat")) nil)
(setq fl (open (strcat pth "remap.dat") "r"))
(while (setq oldname (read-line fl))
(cond
((= (strcase oldname) (strcase a))
(setq newname (read-line fl))
(cond
((/= newname nil)
(vl-file-copy (strcat fld newname ".dwg") (strcat pth newname ".dwg"))
(vl-file-delete (strcat pth oldname ".dwg"))
(vla-put-name x newname)
(vla-put-path x (strcat pth newname ".dwg"))
(vla-reload x)
(setq changed T)
)
)
)
)
)
(close fl)
(cond
((= changed nil)
(setq oldname a)
(while (= newname nil)
(setq newname (vl-filename-base (getfiled (strcat "Select file to replace " a "with") fld "" 8)))
)
(vl-file-copy (strcat fld newname ".dwg") (strcat pth newname ".dwg"))
(vl-file-delete (strcat pth oldname ".dwg"))
(vla-put-name x newname)
(vla-put-path x (strcat pth newname ".dwg"))
(vla-reload x)
)
)
)
(T
(setq oldname a)
(while (= newname nil)
(setq newname (vl-filename-base (getfiled (strcat "Select file to replace " a "with") fld "" 8)))
)
(vl-file-copy (strcat fld newname ".dwg") (strcat pth newname ".dwg"))
(vl-file-delete (strcat pth oldname ".dwg"))
(vla-put-name x newname)
(vla-put-path x (strcat pth newname ".dwg"))
(vla-reload x)
)
)
)
)
)
)
(setq newname nil
oldname nil
changed nil)
)
)
Let me know what you think or if there are improvements that can be made.
Edit: I think I have the problems that I have found fixed now, let me know what you think.
-
Couldn't you just as well write a routine to rename the files vs the xrefs? Since they've already given you the CSV with new & old names? I'm an architect and I don't care how you rename yor copy of my files, I just want you to keep your info separate from mine, so that when you send me your files I don't have to manually separate the data.
Dan
-
Yeah, but this was the path that was started earlier and it was easier to work through it......plus, I think in the long run that this will be more beneficial.
-
That is right I forgot about apartment building's xrefs being set up like that. I have been on Medical and Food industry for so long that I forgot that apartment buildings are architecture too.
:-D
as for the stupid part, there are bad apples in every barrel that make every occupation look bad. :-)
Do I have this right? They are sending you renamed xrefs and host files that are referencing the old xref name? Ohh I would be having a litter of kittens over that one! :pissed: :pissed:
-
Now if you want them to change hit them them where it hurts, charge them additional services. The will either change their ways or pay you. But I would do that if it is way beyond resonable expectations.
Or most likely change consultant :|
dJE
-
Yeah, so the routine that I posted above, should fix most of these issues, still a little bit of a pain, but not too bad.
-
Question:
What does "dos_getdir" do?
-
Dos_getdir is part of doslib and it simply allows you to select a folder......never have quite figured out a good way to do this with pure lisp.
-
I usually use this (http://lee-mac.com/directorydialog.html).
-
I know I am architect and I am stupid. I agree with that line of thought. But from being on the other end of dealing with stupid sub-consultants that never seem to be using the most current xref, I have taken the habit of prefixing my xref file name with the date every time I send them out. It just makes that useless game end a little faster. Now what I won''t rename is are my nested xrefs but we do not have a lot of them to begin with.
I know that that is pita for them (and you) but oh well.
why not put that information in the DRAWING PROPERTIES and stop causing problems you are aware of by renaming XREF files at all?
-
Dos_getdir is part of doslib and it simply allows you to select a folder......never have quite figured out a good way to do this with pure lisp.
Look into the getfiled function.
(getfiled "Select a file" "" "*" 0)
-
Yeah, that selects a files, I am saying select a folder (with or without a file in it)....Lee's setup posted above should work well, thank you Lee.
-
Yeah, that selects a files, I am saying select a folder (with or without a file in it)....Lee's setup posted above should work well, thank you Lee.
You're welcome Chris :-)
-
Yeah, that selects a files, I am saying select a folder (with or without a file in it)....Lee's setup posted above should work well, thank you Lee.
Okay, im confused now; so you're not open to suggestions then.
-
Yeah, that selects a files, I am saying select a folder (with or without a file in it)....Lee's setup posted above should work well, thank you Lee.
Okay, im confused now; so you're not open to suggestions then.
I am; however, I was simply explaining why that method would not work correctly for my needs, unless there is something that I do now know about getfiled, last that I checked, it required the user to select a file, you cannot simply select a folder with it.
-
correct.
Im saying that you are (well, your program is) assuming too much and should be a little more foolproof IMO. If i were writing this, i would search for the 'remap.dat' and search thru some directories (up a few levels from the current maybe) for the "correct" one (and if you cant determine the "correct" one based upon specific rules, or there are several choices, whatever) you can then ask for a drawing. Basically, I would make my program do some basic research before I started modifying a production drawing.
-
That I do agree with; however, I have other tools in place to take care of those issues, such as it actually checks the project number to ensure things are correct, but I never put that part of my code on these boards, as I want to keep it generic so that anyone could use or modify it. In addition, there is only myself and two other people that do drawing setup, so making sure they know what they are doing is fairly easy.
-
I dont trust anything or anyone in my routines. I do my homework before i do ANYTHING to a drawing. And, just to give you a frame of reference, I just did 119 (thats with comments) lines of code to do what i think you should do.
HTH
-
Ok, I am working on putting more error handling and logging into my routine, for some reason when I run the following code, I get Automation Error. Key not found
;Thanks to Lee Mac for the starting off point for this at http://www.theswamp.org/index.php?topic=35702.msg409330#msg409330
(defun c:FXP (/ x a fld pth fl oldname newname changed Doc space)
(vl-load-com)
(setq Doc (vla-get-activedocument (vlax-get-acad-object)))
(setq flog (open (strcat (getvar "dwgprefix") "archupdate.log") "a"))
(setq fld (strcat (LM:DirectoryDialog "Select the folder that has the updated backgrounds:" "" 0) "\\"))
(vlax-for x (vla-get-blocks Doc)
(cond
((= (vla-get-isXref x) :vlax-true)
(setq a (vl-filename-base (vla-get-path x))
pth (strcat (vl-filename-directory (vla-get-path x)) "\\")
)
(cond
((= (vl-file-size (strcat fld a)) nil)
(princ (strcat "\nModifying drawing " (getvar "dwgprefix") (getvar "dwgname") ":") flog)
(cond
((/= (vl-file-size (strcat pth "remap.dat")) nil)
(setq fl (open (strcat pth "remap.dat") "r"))
(while (setq oldname (read-line fl))
(cond
((= (strcase oldname) (strcase a))
(setq newname (read-line fl))
(cond
((/= newname nil)
(setq nbname (blockcheck newname))
(princ (strcat "\n\tOld block name - " x " - changed to new block name - " nbname "to allow renmaing of xref.") flog)
(vl-file-copy (strcat fld newname ".dwg") (strcat pth newname ".dwg"))
(vl-file-delete (strcat pth oldname ".dwg"))
(princ (strcat "\n\tOld xref name - " x " - changed to new xref name - " newname) flog)
(vla-put-name x newname)
(vla-put-path x (strcat pth newname ".dwg"))
(vla-reload x)
(setq changed T)
)
)
)
)
)
(close fl)
(cond
((= changed nil)
(setq oldname a)
(while (= newname nil)
(setq newname (vl-filename-base (getfiled (strcat "Select file to replace " a "with") fld "" 8)))
)
(setq nbname (blockcheck newname))
(princ (strcat "\n\tOld block name - " x " - changed to new block name - " nbname "to allow renmaing of xref.") flog)
(vl-file-copy (strcat fld newname ".dwg") (strcat pth newname ".dwg"))
(vl-file-delete (strcat pth oldname ".dwg"))
(princ (strcat "\n\tOld xref name - " x " - changed to new xref name - " newname) flog)
(vla-put-name x newname)
(vla-put-path x (strcat pth newname ".dwg"))
(vla-reload x)
)
)
)
(T
(setq oldname a)
(while (= newname nil)
(setq newname (vl-filename-base (getfiled (strcat "Select file to replace " a "with") fld "" 8)))
)
(setq nbname (blockcheck newname))
(princ (strcat "\n\tOld block name - " x " - changed to new block name - " nbname "to allow renmaing of xref.") flog)
(vl-file-copy (strcat fld newname ".dwg") (strcat pth newname ".dwg"))
(vl-file-delete (strcat pth oldname ".dwg"))
(princ (strcat "\n\tOld xref name - " x " - changed to new xref name - " newname) flog)
(vla-put-name x newname)
(vla-put-path x (strcat pth newname ".dwg"))
(vla-reload x)
)
)
)
)
)
)
(setq newname nil
oldname nil
changed nil)
)
(close flog)
)
;;; Code below comes from: http://www.jtbworld.com/lisp/axblock.htm
;;; Test if block named "revtext2" exist
;;; (ax:ExistBlock doc "revtext2")
(defun ax:ExistBlock (doc bn / layout i exist)
(setq exist nil)
(vlax-for layout (vla-get-layouts doc)
(vlax-for i (vla-get-block layout)
(if (and
(= (vla-get-objectname i) "AcDbBlockReference")
(= (strcase (vla-get-name i)) (strcase bn))
)
(setq exist T)
)
)
)
exist
)
;;; Rename block from "revtext" to "revtext1"
;;; (ax:RenameBlock doc "revtext" "revtext1")
(defun ax:RenameBlock (doc bn nn / layout i)
(vlax-for layout (vla-get-layouts doc)
(vlax-for i (vla-get-block layout)
(if (and
(= (vla-get-objectname i) "AcDbBlockReference")
(= (strcase (vla-get-name i)) (strcase bn))
)
(vla-put-name i nn)
)
)
)
)
(defun BlockCheck (name / Doc space x i data)
(setq Doc (vla-get-activedocument (vlax-get-acad-object)))
(cond
((= (ax:ExistBlock Doc name) T)
(setq i 1)
)
)
(while (= (ax:ExistBlock Doc (strcat name (rtos i 2 0))) T)
(setq i (+ i 1))
)
(ax:RenameBlock Doc name (strcat name (rtos i 2 0)))
(setq data (strcat name (rtos i 2 0)))
data
)
;; Folder selection routine comes from: http://lee-mac.com/directorydialog.html
;;-------------------=={ Directory Dialog }==-----------------;;
;; ;;
;; Displays a dialog prompting the user to select a folder ;;
;;------------------------------------------------------------;;
;; Author: Lee McDonnell, 2010 ;;
;; ;;
;; Copyright © 2010 by Lee McDonnell, All Rights Reserved. ;;
;; Contact: Lee Mac @ TheSwamp.org, CADTutor.net ;;
;;------------------------------------------------------------;;
;; Arguments: ;;
;; msg - message to display at top of dialog ;;
;; dir - root directory (or nil) ;;
;; flag - bit coded flag specifying dialog display settings ;;
;;------------------------------------------------------------;;
;; Returns: Selected folder filepath, else nil ;;
;;------------------------------------------------------------;;
(defun LM:DirectoryDialog ( msg dir flag / Shell HWND Fold Self Path ac )
(vl-load-com)
;; © Lee Mac 2010
(setq Shell (vla-getInterfaceObject (setq ac (vlax-get-acad-object)) "Shell.Application")
HWND (vl-catch-all-apply 'vla-get-HWND (list ac))
Fold (vlax-invoke-method Shell 'BrowseForFolder (if (vl-catch-all-error-p HWND) 0 HWND) msg flag dir))
(vlax-release-object Shell)
(if Fold
(progn
(setq Self (vlax-get-property Fold 'Self) Path (vlax-get-property Self 'Path))
(vlax-release-object Self)
(vlax-release-object Fold)
(and (= "\\" (substr Path (strlen Path)))
(setq Path (substr Path 1 (1- (strlen Path)))))
)
)
Path
)I get this error when there is a block name that is the same as the new file name for one of the xrefs......any ideas?
-
I get this error when there is a block name that is the same as the new file name for one of the xrefs......any ideas?
I haven't looked properly at your code, but the case you mention should be tested for - as I do in my original routine.
-
Lee, unless I missed something in your original routine (which is quite possible), it test for it, but doesn't allow the xref to be renamed if the block exists, what I am trying to accomplish is:
- Check if there is a block name with the new xref name
- Rename the block name to something unique
- Then continue redoing the xref
Please let me know if I misunderstood how your code handled this.
-
Why don't you take the route suggested here?
http://www.theswamp.org/index.php?topic=35702.msg409391#msg409391
Seems like a MUCH easier solution :?
This might be messing up your routine above:
; === Top statistic:
; Global variables: (FLOG NBNAME)
-
It would be a much easier solution; however, it is not what many of our clients want and I almost have this method completed. In the long run this will be the better solution for us, just a pain in the neck getting it going properly in the first place.
-
My code tested for the case, but you are correct, it did not offer an alternative.
Finding a unique name is pretty easy though, something like this perhaps:
(defun UniqueKey ( collection seed / _isItem )
(defun _isItem ( collection key )
(not
(vl-catch-all-error-p
(vl-catch-all-apply 'vla-item (list collection key))
)
)
)
(
(lambda ( i / n )
(if (_isItem collection seed)
(while
(_isItem collection
(setq n
(strcat seed (itoa (setq i (1+ i))))
)
)
)
(setq n seed)
)
n
)
0
)
)
(UniqueKey <BlocksCollection> <XRefName>)
Hacked together, sorry :|
-
Lee, your hacked together code usually works better than my debugged code....LOL
Ok, here is what I have:
;Thanks to Lee Mac for the starting off point for this at http://www.theswamp.org/index.php?topic=35702.msg409330#msg409330
(defun c:FXP (/ x a fld pth fl oldname newname changed Doc space flog nbname)
(vl-load-com)
(setq Doc (vla-get-activedocument (vlax-get-acad-object)))
(setq fld (strcat (LM:DirectoryDialog "Select the folder that has the updated backgrounds:" "" 0) "\\"))
(cond
((and (/= fld "") (/= fld nil) (/= fld "\\"))
(setq flog (open (strcat (getvar "dwgprefix") "archupdate.log") "a"))
(vlax-for x (vla-get-blocks Doc)
(cond
((= (vla-get-isXref x) :vlax-true)
(setq a (vl-filename-base (vla-get-path x))
pth (strcat (vl-filename-directory (vla-get-path x)) "\\")
)
(cond
((= (vl-file-size (strcat fld a)) nil)
(princ (strcat "\n" (getcdate) " - Modifying drawing " (getvar "dwgprefix") (getvar "dwgname") ":") flog)
(cond
((/= (vl-file-size (strcat pth "remap.dat")) nil)
(setq fl (open (strcat pth "remap.dat") "r"))
(while (setq oldname (read-line fl))
(cond
((= (strcase oldname) (strcase a))
(setq newname (read-line fl))
(cond
((/= newname nil)
(setq nbname (blockcheck newname))
(cond
((/= (strcase nbname) (strcase newname))
(princ (strcat "\n\t" (getcdate) " - Old block name - " newname " - changed to new block name - " nbname " to allow renmaing of xref.") flog)
)
)
(vl-file-copy (strcat fld newname ".dwg") (strcat pth newname ".dwg"))
(vl-file-delete (strcat pth oldname ".dwg"))
(princ (strcat "\n\t" (getcdate) " - File " fld newname ".dwg" " copied to " pth newname ".dwg") flog)
(princ (strcat "\n\t" (getcdate) " - File " pth oldname ".dwg" " was deleted.") flog)
(princ (strcat "\n\t" (getcdate) " - Old xref name - " newname " - changed to new xref name - " newname) flog)
(vla-put-name x newname)
(vla-put-path x (strcat pth newname ".dwg"))
(vla-reload x)
(setq changed T)
)
)
)
)
)
(close fl)
(cond
((= changed nil)
(setq oldname a)
(while (= newname nil)
(setq newname (vl-filename-base (getfiled (strcat "Select file to replace " a "with") fld "" 8)))
)
(setq nbname (blockcheck newname))
(cond
((/= (strcase nbname) (strcase newname))
(princ (strcat "\n\t" (getcdate) " - Old block name - " newname " - changed to new block name - " nbname " to allow renmaing of xref.") flog)
)
)
(vl-file-copy (strcat fld newname ".dwg") (strcat pth newname ".dwg"))
(vl-file-delete (strcat pth oldname ".dwg"))
(princ (strcat "\n\t" (getcdate) " - File " fld newname ".dwg" " copied to " pth newname ".dwg") flog)
(princ (strcat "\n\t" (getcdate) " - File " pth oldname ".dwg" " was deleted.") flog)
(princ (strcat "\n\t" (getcdate) " - Old xref name - " newname " - changed to new xref name - " newname) flog)
(vla-put-name x newname)
(vla-put-path x (strcat pth newname ".dwg"))
(vla-reload x)
)
)
)
(T
(setq oldname a)
(while (= newname nil)
(setq newname (vl-filename-base (getfiled (strcat "Select file to replace " a "with") fld "" 8)))
)
(setq nbname (blockcheck newname))
(cond
((/= (strcase nbname) (strcase newname))
(princ (strcat "\n\t" (getcdate) " - Old block name - " newname " - changed to new block name - " nbname " to allow renmaing of xref.") flog)
)
)
(vl-file-copy (strcat fld newname ".dwg") (strcat pth newname ".dwg"))
(vl-file-delete (strcat pth oldname ".dwg"))
(princ (strcat "\n\t" (getcdate) " - File " fld newname ".dwg" " copied to " pth newname ".dwg") flog)
(princ (strcat "\n\t" (getcdate) " - File " pth oldname ".dwg" " was deleted.") flog)
(princ (strcat "\n\t" (getcdate) " - Old xref name - " newname " - changed to new xref name - " newname) flog)
(vla-put-name x newname)
(vla-put-path x (strcat pth newname ".dwg"))
(vla-reload x)
)
)
)
)
)
)
(setq newname nil
oldname nil
changed nil)
)
(close flog)
)
)
(princ)
)
;UniqueKey Code from LeeMac at http://www.theswamp.org/index.php?topic=35702.msg409606#msg409606
(defun UniqueKey ( collection seed / _isItem )
(defun _isItem ( collection key )
(not
(vl-catch-all-error-p
(vl-catch-all-apply 'vla-item (list collection key))
)
)
)
(
(lambda ( i / n )
(if (_isItem collection seed)
(while
(_isItem collection
(setq n
(strcat seed (itoa (setq i (1+ i))))
)
)
)
(setq n seed)
)
n
)
0
)
)
(defun BlockCheck (name2 / data)
(setq Doc (vla-get-activedocument (vlax-get-acad-object)))
(cond
((/= (tblsearch "BLOCK" name2) nil)
(setq data (UniqueKey (vla-get-blocks Doc) name2))
(vl-cmdf "._rename" "block" name2 data)
)
(T
(setq data name2)
)
)
data
)
;; Folder selection routine comes from: http://lee-mac.com/directorydialog.html
;;-------------------=={ Directory Dialog }==-----------------;;
;; ;;
;; Displays a dialog prompting the user to select a folder ;;
;;------------------------------------------------------------;;
;; Author: Lee McDonnell, 2010 ;;
;; ;;
;; Copyright © 2010 by Lee McDonnell, All Rights Reserved. ;;
;; Contact: Lee Mac @ TheSwamp.org, CADTutor.net ;;
;;------------------------------------------------------------;;
;; Arguments: ;;
;; msg - message to display at top of dialog ;;
;; dir - root directory (or nil) ;;
;; flag - bit coded flag specifying dialog display settings ;;
;;------------------------------------------------------------;;
;; Returns: Selected folder filepath, else nil ;;
;;------------------------------------------------------------;;
(defun GETCDATE (/ CDATE)
(setq CDATE (rtos (getvar "CDATE") 2 6)
CDATE (strcat
(substr CDATE 5 2)
"/"
(substr CDATE 7 2)
"/"
(substr CDATE 1 4)
" @ "
(substr CDATE 10 2)
":"
(substr CDATE 12 2)
)
)
cdate
)
(defun LM:DirectoryDialog ( msg dir flag / Shell HWND Fold Self Path ac )
(vl-load-com)
;; © Lee Mac 2010
(setq Shell (vla-getInterfaceObject (setq ac (vlax-get-acad-object)) "Shell.Application")
HWND (vl-catch-all-apply 'vla-get-HWND (list ac))
Fold (vlax-invoke-method Shell 'BrowseForFolder (if (vl-catch-all-error-p HWND) 0 HWND) msg flag dir))
(vlax-release-object Shell)
(if Fold
(progn
(setq Self (vlax-get-property Fold 'Self) Path (vlax-get-property Self 'Path))
(vlax-release-object Self)
(vlax-release-object Fold)
(and (= "\\" (substr Path (strlen Path)))
(setq Path (substr Path 1 (1- (strlen Path)))))
)
)
(cond
((= PATH nil)
(setq path "")
)
)
Path
)
The last thing that doesn't work correctly for me is when it prompts for a filename, I want it to loop until one is provided, right now if the user hits Cancel, the command errors out.
-
Chris,
You shouldn't need to modify the directory dialog routine whatsoever.
Just test for a selected directory:
(if (setq Directory (LM:DirectoryDialog ... ))
...
Be sure to know the returns of my function - all the information is listed on my site - you cannot 'strcat' a nil value.
-
Ok, I see where the problem was now, thank you.....I still want to know about the select files portion though, why it errors out when pressing cancel....doesn't make sense to me on that one.
-
Didnt you already dismiss the idea from me about re-arranging your routine saying that you had some other standard checks and stuff? I dont think you understood any of my intentions.
-
You mean the getfiled section? Because (vl-filename-base nil) will error.
You need to know what files can accept a nil argument, and which will need more error trapping. IMO quite a lot of the code needs rewriting, you assume too much without sufficient error trapping.
-
Didnt you already dismiss the idea from me about re-arranging your routine saying that you had some other standard checks and stuff? I dont think you understood any of my intentions.
I was referring to the checking for folders with standards....I did realize that checking blocks was needed, as well as logs of what changes took place.
-
You mean the getfiled section? Because (vl-filename-base nil) will error.
You need to know what files can accept a nil argument, and which will need more error trapping. IMO quite a lot of the code needs rewriting, you assume too much without sufficient error trapping.
You are probably correct on that, I know it is no where near as neat and tidy as it should be, I just haven't had the time to do so.
-
You are probably correct on that, I know it is no where near as neat and tidy as it should be, I just haven't had the time to do so.
I might be alone on this, but when I write a routine, I don't write a fully operational program and subsequently attempt to tidy it up with regards to error trapping - that's way too much work, and you are effectively doing the job twice over.
The way I approach the task is to evaluate, at every stage, what assumptions I am making, and to account for them. Hence, at every prompt or position at which the program doesn't hold all the cards, think about every eventuality and provide an error-free backdoor for it. For example, if there is just the slightest possibility that an argument for a function might be nil, account for this case, and check for a valid value before proceeding.
Honestly, overall, it doesn't take much more time - if anything, you spend less time searching for bugs and you have a more robust program to show for it.
My 2 cents,
Lee
-
;Thanks to Lee Mac for the starting off point for this at http://www.theswamp.org/index.php?topic=35702.msg409330#msg409330
(defun c:FXP (/ x a fld pth fl oldname newname changed Doc space flog nbname dwgpth)
(vl-load-com)
(setq Doc (vla-get-activedocument (vlax-get-acad-object)))
(if (setq fld (LM:DirectoryDialog "Select the folder that has the updated backgrounds:" "" 0)) (setq fld (strcat fld "\\")))
(cond
((and (/= fld "") (/= fld nil) (/= fld "\\"))
(setq fld (bei:path fld))
(setq flog (open (strcat (getvar "dwgprefix") "archupdate.log") "a"))
(vlax-for x (vla-get-blocks Doc)
(cond
((= (vla-get-isXref x) :vlax-true)
(setq a (vl-filename-base (vla-get-path x))
pth (strcat (vl-filename-directory (vla-get-path x)) "\\")
)
(setq pth (bei:path pth)
dwgpth (bei:path (getvar "dwgprefix"))
)
(cond
((and (= (vl-file-size (strcat fld a)) nil) (/= (strcase pth) (strcase dwgpth)))
(princ (strcat "\n" (getcdate) " - Modifying drawing " (getvar "dwgprefix") (getvar "dwgname") ":") flog)
(cond
((/= (vl-file-size (strcat pth "remap.dat")) nil)
(setq fl (open (strcat pth "remap.dat") "r"))
(while (setq oldname (read-line fl))
(cond
((= (strcase oldname) (strcase a))
(setq newname (read-line fl))
(cond
((/= newname nil)
(setq nbname (blockcheck newname))
(cond
((/= (strcase nbname) (strcase newname))
(princ (strcat "\n\t" (getcdate) " - Old block name - " newname " - changed to new block name - " nbname " to allow renmaing of xref.") flog)
)
)
(vl-file-copy (strcat fld newname ".dwg") (strcat pth newname ".dwg"))
(vl-file-delete (strcat pth oldname ".dwg"))
(princ (strcat "\n\t" (getcdate) " - File " fld newname ".dwg" " copied to " pth newname ".dwg") flog)
(princ (strcat "\n\t" (getcdate) " - File " pth oldname ".dwg" " was deleted.") flog)
(princ (strcat "\n\t" (getcdate) " - Old xref name - " newname " - changed to new xref name - " newname) flog)
(vla-put-name x newname)
(vla-put-path x (strcat pth newname ".dwg"))
(vla-reload x)
(setq changed T)
)
)
)
)
)
(close fl)
(cond
((= changed nil)
(setq oldname a)
(while (= newname nil)
(if (setq newname (getfiled (strcat "Select file to replace " a "with") fld "" 8)) (setq newname (vl-filename-base newname)))
)
(setq nbname (blockcheck newname))
(cond
((/= (strcase nbname) (strcase newname))
(princ (strcat "\n\t" (getcdate) " - Old block name - " newname " - changed to new block name - " nbname " to allow renmaing of xref.") flog)
)
)
(vl-file-copy (strcat fld newname ".dwg") (strcat pth newname ".dwg"))
(vl-file-delete (strcat pth oldname ".dwg"))
(princ (strcat "\n\t" (getcdate) " - File " fld newname ".dwg" " copied to " pth newname ".dwg") flog)
(princ (strcat "\n\t" (getcdate) " - File " pth oldname ".dwg" " was deleted.") flog)
(princ (strcat "\n\t" (getcdate) " - Old xref name - " newname " - changed to new xref name - " newname) flog)
(vla-put-name x newname)
(vla-put-path x (strcat pth newname ".dwg"))
(vla-reload x)
)
)
)
(T
(setq oldname a)
(while (= newname nil)
(if (setq newname (getfiled (strcat "Select file to replace " a "with") fld "" 8)) (setq newname (vl-filename-base newname)))
)
(setq nbname (blockcheck newname))
(cond
((/= (strcase nbname) (strcase newname))
(princ (strcat "\n\t" (getcdate) " - Old block name - " newname " - changed to new block name - " nbname " to allow renmaing of xref.") flog)
)
)
(vl-file-copy (strcat fld newname ".dwg") (strcat pth newname ".dwg"))
(vl-file-delete (strcat pth oldname ".dwg"))
(princ (strcat "\n\t" (getcdate) " - File " fld newname ".dwg" " copied to " pth newname ".dwg") flog)
(princ (strcat "\n\t" (getcdate) " - File " pth oldname ".dwg" " was deleted.") flog)
(princ (strcat "\n\t" (getcdate) " - Old xref name - " newname " - changed to new xref name - " newname) flog)
(vla-put-name x newname)
(vla-put-path x (strcat pth newname ".dwg"))
(vla-reload x)
)
)
)
)
)
)
(setq newname nil
oldname nil
changed nil)
)
(close flog)
)
)
(princ)
)
;UniqueKey Code from LeeMac at http://www.theswamp.org/index.php?topic=35702.msg409606#msg409606
(defun UniqueKey ( collection seed / _isItem )
(defun _isItem ( collection key )
(not
(vl-catch-all-error-p
(vl-catch-all-apply 'vla-item (list collection key))
)
)
)
(
(lambda ( i / n )
(if (_isItem collection seed)
(while
(_isItem collection
(setq n
(strcat seed (itoa (setq i (1+ i))))
)
)
)
(setq n seed)
)
n
)
0
)
)
(DEFUN bei:path (pth /)
(cond
((/= (substr pth (strlen pth) 1) "\\")
(setq pth (strcat pth "\\"))
)
)
pth
)
(defun BlockCheck (name2 / data)
(setq Doc (vla-get-activedocument (vlax-get-acad-object)))
(cond
((/= (tblsearch "BLOCK" name2) nil)
(setq data (UniqueKey (vla-get-blocks Doc) name2))
(vl-cmdf "._rename" "block" name2 data)
)
(T
(setq data name2)
)
)
data
)
;; Folder selection routine comes from: http://lee-mac.com/directorydialog.html
;;-------------------=={ Directory Dialog }==-----------------;;
;; ;;
;; Displays a dialog prompting the user to select a folder ;;
;;------------------------------------------------------------;;
;; Author: Lee McDonnell, 2010 ;;
;; ;;
;; Copyright © 2010 by Lee McDonnell, All Rights Reserved. ;;
;; Contact: Lee Mac @ TheSwamp.org, CADTutor.net ;;
;;------------------------------------------------------------;;
;; Arguments: ;;
;; msg - message to display at top of dialog ;;
;; dir - root directory (or nil) ;;
;; flag - bit coded flag specifying dialog display settings ;;
;;------------------------------------------------------------;;
;; Returns: Selected folder filepath, else nil ;;
;;------------------------------------------------------------;;
(defun GETCDATE (/ CDATE)
(setq CDATE (rtos (getvar "CDATE") 2 6)
CDATE (strcat
(substr CDATE 5 2)
"/"
(substr CDATE 7 2)
"/"
(substr CDATE 1 4)
" @ "
(substr CDATE 10 2)
":"
(substr CDATE 12 2)
)
)
cdate
)
(defun LM:DirectoryDialog ( msg dir flag / Shell HWND Fold Self Path ac )
(vl-load-com)
;; © Lee Mac 2010
(setq Shell (vla-getInterfaceObject (setq ac (vlax-get-acad-object)) "Shell.Application")
HWND (vl-catch-all-apply 'vla-get-HWND (list ac))
Fold (vlax-invoke-method Shell 'BrowseForFolder (if (vl-catch-all-error-p HWND) 0 HWND) msg flag dir))
(vlax-release-object Shell)
(if Fold
(progn
(setq Self (vlax-get-property Fold 'Self) Path (vlax-get-property Self 'Path))
(vlax-release-object Self)
(vlax-release-object Fold)
(and (= "\\" (substr Path (strlen Path)))
(setq Path (substr Path 1 (1- (strlen Path)))))
)
)
Path
)
Alright, I have corrected those items, but I know I am missing something that would be useful for error handling here, I just can't put m,y finger on it......I know he remap.dat file will always be correct when available, so I don't have to worry about that.
Lee,
I think you are correct on that as well, just sometimes I don't catch my mistakes until I am done.....but, as I have said before, I am constantly learning with LISP.
EDIT: I think I have caught all of the assumptions and error checked them properly now, I have updated the code above. Please let me know if I missed something.
-
Actually, there is one more thing that I need to check and I am not sure how to do this......I need to determine if the xref is loaded or unloaded.
-
Actually, there is one more thing that I need to check and I am not sure how to do this......I need to determine if the xref is loaded or unloaded.
Wouldn't you want to rename regardless if it's loaded or not (or does it chuck a wobbly?).
-
Actually, there is one more thing that I need to check and I am not sure how to do this......I need to determine if the xref is loaded or unloaded and maintain that status.
Wouldn't you want to rename regardless if it's loaded or not (or does it chuck a wobbly?).
Yes, but I don't want them reloaded, but I was able to find another thread that helped me get the routine working, here is what I have:
;Thanks to Lee Mac for the starting off point for this at http://www.theswamp.org/index.php?topic=35702.msg409330#msg409330
(defun c:FXP (/ x a fld pth fl oldname newname changed Doc space flog nbname dwgpth LoadTst)
(vl-load-com)
(setq Doc (vla-get-activedocument (vlax-get-acad-object)))
(if (setq fld (LM:DirectoryDialog "Select the folder that has the updated backgrounds:" "" 0)) (setq fld (strcat fld "\\")))
(cond
((and (/= fld "") (/= fld nil) (/= fld "\\"))
(setq fld (bei:path fld))
(setq flog (open (strcat (getvar "dwgprefix") "archupdate.log") "a"))
(vlax-for x (vla-get-blocks Doc)
(cond
((= (vla-get-isXref x) :vlax-true)
(setq a (vl-filename-base (vla-get-path x))
pth (strcat (vl-filename-directory (vla-get-path x)) "\\")
LoadTst (Isloaded Doc a)
)
(setq pth (bei:path pth)
dwgpth (bei:path (getvar "dwgprefix"))
)
(cond
((and (= (vl-file-size (strcat fld a)) nil) (/= (strcase pth) (strcase dwgpth)))
(princ (strcat "\n" (getcdate) " - Modifying drawing " (getvar "dwgprefix") (getvar "dwgname") ":") flog)
(cond
((/= (vl-file-size (strcat pth "remap.dat")) nil)
(setq fl (open (strcat pth "remap.dat") "r"))
(while (setq oldname (read-line fl))
(cond
((= (strcase oldname) (strcase a))
(setq newname (read-line fl))
(cond
((/= newname nil)
(setq nbname (blockcheck newname))
(cond
((/= (strcase nbname) (strcase newname))
(princ (strcat "\n\t" (getcdate) " - Old block name - " newname " - changed to new block name - " nbname " to allow renmaing of xref.") flog)
)
)
(bei:xrwork fld newname pth flog x LoadTst)
(setq changed T)
)
)
)
)
)
(close fl)
(cond
((= changed nil)
(setq oldname a)
(if (setq newname (getfiled (strcat "Select file to replace " a "with") fld "" 8)) (setq newname (vl-filename-base newname)))
(cond
((/= newname nil)
(setq nbname (blockcheck newname))
(cond
((/= (strcase nbname) (strcase newname))
(princ (strcat "\n\t" (getcdate) " - Old block name - " newname " - changed to new block name - " nbname " to allow renmaing of xref.") flog)
)
)
(bei:xrwork fld newname pth flog x LoadTst)
)
(T
(princ (strcat "\n\t" (getcdate) " - File " pth oldname " was not modified, because the user pressed cancel.") flog)
)
)
)
)
)
(T
(setq oldname a)
(if (setq newname (getfiled (strcat "Select file to replace " a "with") fld "" 8)) (setq newname (vl-filename-base newname)))
(cond
((/= newname nil)
(setq nbname (blockcheck newname))
(cond
((/= (strcase nbname) (strcase newname))
(princ (strcat "\n\t" (getcdate) " - Old block name - " newname " - changed to new block name - " nbname " to allow renmaing of xref.") flog)
)
)
(bei:xrwork fld newname pth flog x LoadTst)
)
(T
(princ (strcat "\n\t" (getcdate) " - File " pth oldname " was not modified, because the user pressed cancel.") flog)
)
)
)
)
)
)
)
)
(setq newname nil
oldname nil
changed nil)
)
(close flog)
)
)
(princ)
)
(defun bei:xrwork (fld newname pth flog x LoadTst /)
(vl-file-copy (strcat fld newname ".dwg") (strcat pth newname ".dwg"))
(vl-file-delete (strcat pth oldname ".dwg"))
(princ (strcat "\n\t" (getcdate) " - File " fld newname ".dwg" " copied to " pth newname ".dwg") flog)
(princ (strcat "\n\t" (getcdate) " - File " pth oldname ".dwg" " was deleted.") flog)
(princ (strcat "\n\t" (getcdate) " - Old xref name - " newname " - changed to new xref name - " newname) flog)
(vla-put-name x newname)
(vla-put-path x (strcat pth newname ".dwg"))
(cond
((= LoadTst T)
(vla-reload x)
)
(T
(vla-unload x)
)
)
)
; Code Modifed from T. Willey's code at: http://www.theswamp.org/index.php?topic=4103.msg103206#msg103206
(defun IsLoaded (Doc BL / tmpObj Layout i)
(vlax-for Layout (vla-get-Layouts Doc)
(vlax-for i (vla-get-Block Layout)
(cond
((= (strcase (vla-get-name i)) (strcase BL))
(if
(and
(= (vla-get-ObjectName i) "AcDbBlockReference")
(vlax-property-available-p i 'Path)
(setq tmpObj (vla-Item (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-Acad-Object))) (vla-get-Name i)))
(assoc 71 (entget (tblobjname "block" (vla-get-Name i))))
)
(setq LD nil)
(setq LD T)
)
)
)
)
)
LD
)
;UniqueKey Code from LeeMac at http://www.theswamp.org/index.php?topic=35702.msg409606#msg409606
(defun UniqueKey ( collection seed / _isItem )
(defun _isItem ( collection key )
(not
(vl-catch-all-error-p
(vl-catch-all-apply 'vla-item (list collection key))
)
)
)
(
(lambda ( i / n )
(if (_isItem collection seed)
(while
(_isItem collection
(setq n
(strcat seed (itoa (setq i (1+ i))))
)
)
)
(setq n seed)
)
n
)
0
)
)
(DEFUN bei:path (pth /)
(cond
((/= (substr pth (strlen pth) 1) "\\")
(setq pth (strcat pth "\\"))
)
)
pth
)
(defun BlockCheck (name2 / data)
(setq Doc (vla-get-activedocument (vlax-get-acad-object)))
(cond
((/= (tblsearch "BLOCK" name2) nil)
(setq data (UniqueKey (vla-get-blocks Doc) name2))
(vl-cmdf "._rename" "block" name2 data)
)
(T
(setq data name2)
)
)
data
)
;; Folder selection routine comes from: http://lee-mac.com/directorydialog.html
;;-------------------=={ Directory Dialog }==-----------------;;
;; ;;
;; Displays a dialog prompting the user to select a folder ;;
;;------------------------------------------------------------;;
;; Author: Lee McDonnell, 2010 ;;
;; ;;
;; Copyright © 2010 by Lee McDonnell, All Rights Reserved. ;;
;; Contact: Lee Mac @ TheSwamp.org, CADTutor.net ;;
;;------------------------------------------------------------;;
;; Arguments: ;;
;; msg - message to display at top of dialog ;;
;; dir - root directory (or nil) ;;
;; flag - bit coded flag specifying dialog display settings ;;
;;------------------------------------------------------------;;
;; Returns: Selected folder filepath, else nil ;;
;;------------------------------------------------------------;;
(defun GETCDATE (/ CDATE)
(setq CDATE (rtos (getvar "CDATE") 2 6)
CDATE (strcat
(substr CDATE 5 2)
"/"
(substr CDATE 7 2)
"/"
(substr CDATE 1 4)
" @ "
(substr CDATE 10 2)
":"
(substr CDATE 12 2)
)
)
cdate
)
(defun LM:DirectoryDialog ( msg dir flag / Shell HWND Fold Self Path ac )
(vl-load-com)
;; © Lee Mac 2010
(setq Shell (vla-getInterfaceObject (setq ac (vlax-get-acad-object)) "Shell.Application")
HWND (vl-catch-all-apply 'vla-get-HWND (list ac))
Fold (vlax-invoke-method Shell 'BrowseForFolder (if (vl-catch-all-error-p HWND) 0 HWND) msg flag dir))
(vlax-release-object Shell)
(if Fold
(progn
(setq Self (vlax-get-property Fold 'Self) Path (vlax-get-property Self 'Path))
(vlax-release-object Self)
(vlax-release-object Fold)
(and (= "\\" (substr Path (strlen Path)))
(setq Path (substr Path 1 (1- (strlen Path)))))
)
)
Path
)Thank you all for your help with this.