;;--------------------=={ TabSort.lsp }==---------------------;;
;; ;;
;; A program designed with the intention to aid in the ;;
;; organisation of layout tabs in a drawing. ;;
;; ;;
;; The program enables the user to organise each layout tab ;;
;; using buttons to move the tabs up, down, to the top, and ;;
;; to the bottom of a list. ;;
;; ;;
;; The user may rename any layout by double clicking on it, ;;
;; and can also add a Prefix and/or Suffix to selected/every ;;
;; layout tab. ;;
;; ;;
;; The program offers the facility to add and delete a ;;
;; layout tab, and also sort the tabs alphabetically, ;;
;; numerically, architecturally; or reverse the order in ;;
;; which they appear. ;;
;; ;;
;; A Find and Replace function is incorporated to allow the ;;
;; user to quickly replace a text string in multiple tabs. ;;
;; ;;
;; The user can also Copy a layout tab, and set the Selected ;;
;; layout tab as the current tab. ;;
;; ;;
;; The Help Dialog can be access by pressing "H" at the Main ;;
;; Dialog. ;;
;; ;;
;;------------------------------------------------------------;;
;; ;;
;; FUNCTION SYNTAX: TABSORT ;;
;; ;;
;; Notes:- ;;
;; The Reset button will reset Tab Order and Tab Names, but ;;
;; will not affect newly created tabs and will not recreate ;;
;; deleted tabs. ;;
;; ;;
;; In the case that multiple tabs are selected, the Current ;;
;; button will set the tab with the lowest index (highest in ;;
;; the list) as the current tab. ;;
;; ;;
;;------------------------------------------------------------;;
;; Author: Lee Mac, Copyright © 2011 - www.lee-mac.com ;;
;;------------------------------------------------------------;;
;; ;;
;; With Thanks To: ;;
;; -------------------- ;;
;; Gilles Chanteau (Gile) ;;
;; ;;
;; For his fantastic contribution to the list manipulation ;;
;; required for multiple DCL selections, and effort towards ;;
;; the Architectural Sort functions. ;;
;; ;;
;;------------------------------------------------------------;;
;; Charles Alan Butler (CAB) ;;
;; ;;
;; For his excellent idea to incorporate the Help button for ;;
;; those who need it. ;;
;; ;;
;;------------------------------------------------------------;;
;; Version: ;;
;; ;;
;; 1.0 - 13th September 2009 ;;
;; ;;
;; First Release ;;
;;------------------------------------------------------------;;
;; 1.1 - 14th September 2009 ;;
;; ;;
;; Added Mnemonics to Tiles ;;
;; Added text to notify of double-click availability ;;
;; Added option to only pref/suff selected tab ;;
;;------------------------------------------------------------;;
;; 1.2 - 15th September 2009 ;;
;; ;;
;; Added Numerical Sort ;;
;; General Bug Fixes ;;
;;------------------------------------------------------------;;
;; 1.3 - 15th September 2009 ;;
;; ;;
;; Multi-tab Selection Functionality ;;
;;------------------------------------------------------------;;
;; 1.4 - 16th September 2009 ;;
;; ;;
;; Added Button to Set Current Tab ;;
;; Added Copy Tab Functionality ;;
;;------------------------------------------------------------;;
;; 1.5 - 17th September 2009 ;;
;; ;;
;; Fixed Bug to Copy Layout Plot Settings ;;
;;------------------------------------------------------------;;
;; 1.6 - 18th September 2009 ;;
;; ;;
;; Modified Action_Tile Stmts ~ Thanks VovKa ;;
;; Added Architectural Sort Button ;;
;;------------------------------------------------------------;;
;; 1.6.1 - 19th September 2009 ;;
;; ;;
;; Fixed Bugs ~ Thanks for feedback CAB ;;
;;------------------------------------------------------------;;
;; 1.7 - 20th September 2009 ;;
;; ;;
;; Added Find & Replace Functionality ;;
;; Organised buttons/Added Sort Dialog ;;
;;------------------------------------------------------------;;
;; 1.7.1 - 20th September 2009 ;;
;; ;;
;; Replaced StrBrk sub with SplitStr (Gile) ;;
;;------------------------------------------------------------;;
;; 1.8 - 21st September 2009 ;;
;; ;;
;; Added hidden Help Button (CAB) ;;
;; Added Help Dialog Definition ;;
;;------------------------------------------------------------;;
;; 1.8.1 - 22nd September 2009 ;;
;; ;;
;; General Bug Fixes ;;
;;------------------------------------------------------------;;
;; 1.8.2 - 23rd September 2009 ;;
;; ;;
;; Fixed Bug causing crash when Deleting all ;;
;; Tabs ~ thanks VovKa ;;
;;------------------------------------------------------------;;
;; 1.9 - 2nd October 2009 ;;
;; ;;
;; Modified Reverse function to only apply to selected Tabs. ;;
;; Altered Help Dialog to ok_only button ;;
;;------------------------------------------------------------;;
;; 2.0 - 22nd July 2010 ;;
;; ;;
;; Fixed Bug with Find/Replace. ;;
;;------------------------------------------------------------;;
;; 2.1 - 9th December 2010 ;;
;; ;;
;; Fixed Bug with Double Reversal ;;
;;------------------------------------------------------------;;
;; 2.2 - 16th May 2011 ;;
;; ;;
;; Program completely rewritten to update formatting. ;;
;; Upgraded Find & Replace engine to allow for ;;
;; self-referencing find and replace terms and improved ;;
;; visual feedback. ;;
;; Updated list manipulation subfunctions. ;;
;;------------------------------------------------------------;;
("A23" "C22" "B3" "E7")Becomes ~ ("A23" "B3" "C22" "E7")("A23" "C22" "B3" "E7")Becomes ~ ("B3" "E7" "C22" "A23")("A-1A" "B-3" "A-10C" "B-1.2" "B-1")Becomes ~ ("A-1A" "A-10C" "B-1" "B-1.2" "B-3")Lee the double click is a great feature. I also like the prefix/suffix options.
I'll have to add those to my TabMover! :)
Notice on mine you may select a group of tabs. This would be useful when adding prefix/suffix to a selected group.
Nice functionality. I like all the options.
1. Add a piece of text to the dialog to inform the user of the option to rename by double-clicking.
2. Utilizes a few of the bonus tool, I mean express tool functions. You could have a check at the beginning to ensure ET is loaded.
3. vla-get-activedocument and vlax-get-acad-object are called a few times.
4. You have a lot of subs that are not localized, not really a problem, except that I've noticed the DCL_Write function used by you quite a bit. If a user is running another program utilizing DCL_Write, problems are going to occur.
With that being said, I will, again say that I really like the program and will be adding it to my tool belt. Thanks for sharing.
Lee the double click is a great feature. I also like the prefix/suffix options.
I'll have to add those to my TabMover! :)
Notice on mine you may select a group of tabs. This would be useful when adding prefix/suffix to a selected group.
Thanks Alan - I had a bit of help with the double click from Andrea in the other recent thread - but I'm surprised that the list_box doesn't have an attribute already in place to aid with this functionality - all I could find was allow_accept...
I think the multiple selection of tabs is the next logical step for this - although it may mean a major overhaul in the coding... but thanks for the comments :-)Nice functionality. I like all the options.
Thanks Al 8-)1. Add a piece of text to the dialog to inform the user of the option to rename by double-clicking.
Good idea, I was thinking the same thing - I didn't want to spoil the "clean" look of the dialog, but I think it should be added.2. Utilizes a few of the bonus tool, I mean express tool functions. You could have a check at the beginning to ensure ET is loaded.
There is a check at the top of the LISP - using the variable "et" :wink:3. vla-get-activedocument and vlax-get-acad-object are called a few times.
I only call it once actually, and use lexical scoping (got that term from Se7en :P ) to prevent calling it loads of times :-)4. You have a lot of subs that are not localized, not really a problem, except that I've noticed the DCL_Write function used by you quite a bit. If a user is running another program utilizing DCL_Write, problems are going to occur.
Ahh, yes - that could cause a problem, I may include the DCL_Write function within the Main Function definition and localise it.With that being said, I will, again say that I really like the program and will be adding it to my tool belt. Thanks for sharing.
Thanks Alan, I feel honoured 8-)
Nicely done Lee!! Very handy
Lee Response #:
1. Yeah, I don't know where you would put it. Just a thought.
2 & 3. I stand corrected, completely overlooked.
4. No reason not to, or at least add a prefix/suffix 'TabMover' to it.
Seriously, nice work.
This will be strike 3 for me today, I went back and looked at Alan's (Cab) Dcl2Lisp and you are working on the same principals. I found and have been using his since 07, without any issues. Just ignore what I've said. Probably just that I like to localize as many of my functions as possible. I do have a folder of them (ones I've written for day-to-day use) that I have loaded at every startup. That way, I can act as if they're additional commands in Autocad (sadly, you can't register lisp subs in Vlide), everything gets to use the most updated version of the sub. and I don't have to place them in each program file.Nicely done Lee!! Very handy
Thanks Willie :-)Lee Response #:
1. Yeah, I don't know where you would put it. Just a thought.
2 & 3. I stand corrected, completely overlooked.
4. No reason not to, or at least add a prefix/suffix 'TabMover' to it.
Seriously, nice work.
Cheers Alan, I'll see to those improvements :-)
I'm glad you like it mate :-)
(defun c:nlay( / size name)
(setq size (getstring (strcat "\nWhat size do you want your new layout to be ?? : ")))
(setq name (getstring T (strcat "\nPlease give a name for the new layout : ")))
(command "-layout" "t" "standards.dwg" size)
(command "-layout" "r" size name)
(princ)
);I forgot to mention it, but the ability to add a new layout was genius (should switch to newly created one though).
Hmm, that brings up an interesting question: I wonder if it's possible to replicate the 'copy layout' option (probably not in Lisp). I think I'll do a little research and digging.
This is a great piece of coding ! Thank you for sharing it with us.You know I'm not that great of a programmer so I will only judge it by the functionality.
First of all I wonder; how did you come up with the idea? I know you study math and you are no drafter. Are you inspecting the screen for items to modify in a rondom way? :lol:
95% of my project (*.dwg's) contain more than 3 layouts. Some of them contain like 20 layouts and I know there are people amongst us that go far beyond 20 :ugly:. Whenever I want to sort or rename it takes time. Therefore this routine comes in handy, ie. if in modelspace, it stays in modelspace.
1. the use of the "CTRL" key so one can select multiple layouts to edit / sort.
3. A "cancel" button to finish the dialog?
Hmm, that brings up an interesting question: I wonder if it's possible to replicate the 'copy layout' option (probably not in Lisp). I think I'll do a little research and digging.
I think you would have to manually copy all the objects from the layout space into the new layout... I don't think there would be an elegant solution to it. :|
Just use the ' CopyObjects ' method of the document. You might have to turn on viewports in the new layout, but you should be able to copy all content from one tab to another, even if it is one you just created. Just make sure you don't grab the very first viewport, as that is the paperspace viewport.
Lee,
That is a real timesaver. Nice one.
I have just tried it on Civil 3D 2009 but it didn't switch to the new tab whenever I hit the ADD button.
One question though?
Would it be possible to include a numerical sort as well as the Alpha, as in that it will show 99, 100, 101 in order?
Thanks for sharing.
John
Oops! :oops:
Yes it does, I was looking at the actual Tabs.
Sorry about that.
That's great Lee, Thanks!
My only request would be to have the ability to select several (but not all) tabs to sort or apply a prefix/suffix.
Just updated a minor bug in the code to switch to the new tab when the user clicks "Add".;-)
("A32" "C23" "A22" "E7")
("E7" "A22" "C23" "A32")
What do you think of the "nlay" function I mentioned?
Wouldn't that be a nice add on?
V 1.2 looks nice to me. A handy tool I say. :kewl:
When you say "export to single drawings" do you mean make each tab a new drawing?
QuoteWhen you say "export to single drawings" do you mean make each tab a new drawing?
Yeah, I know its a big task but this tool would then be the ultimate one stop shop for layout tabs.
How do you get the time to do all this code?
QuoteWhen you say "export to single drawings" do you mean make each tab a new drawing?
Yeah, I know its a big task but this tool would then be the ultimate one stop shop for layout tabs.
That would be a big task :lol: I'm currently working on the Multiple Tab Selection, so I'll see if I have the time :-)
Hmm, that brings up an interesting question: I wonder if it's possible to replicate the 'copy layout' option (probably not in Lisp). I think I'll do a little research and digging.
I think you would have to manually copy all the objects from the layout space into the new layout... I don't think there would be an elegant solution to it. :|
Just use the ' CopyObjects ' method of the document. You might have to turn on viewports in the new layout, but you should be able to copy all content from one tab to another, even if it is one you just created. Just make sure you don't grab the very first viewport, as that is the paperspace viewport.
(vlax-for Obj (vla-get-Block <layout>)
...
Hmm, that brings up an interesting question: I wonder if it's possible to replicate the 'copy layout' option (probably not in Lisp). I think I'll do a little research and digging.
I think you would have to manually copy all the objects from the layout space into the new layout... I don't think there would be an elegant solution to it. :|
Just use the ' CopyObjects ' method of the document. You might have to turn on viewports in the new layout, but you should be able to copy all content from one tab to another, even if it is one you just created. Just make sure you don't grab the very first viewport, as that is the paperspace viewport.
Hi Tim,
I am currently attempting to add this feature to the program, but I am falling down when it comes to viewports.
When I try to filter the first viewport out, I end up with one viewport missing. But, if I do not filter out any objects, I end up with the Paperspace viewport, but still missing one of the user-drawn viewports... :|
So, my question is, how can I tell which viewport to filter out in my:Code: [Select](vlax-for Obj (vla-get-Block <layout>)
...
Advice is appreciated as always :-)
The paper space viewport is the first object within the layout's block table record, so just skip the first item.
With that said, you can look at this thread for more information on viewports. Lots of good info.
[ http://www.theswamp.org/index.php?topic=10992.0 ]
If more than a push is needed, let me know. :wink:
Sussed!
OK, you do need the paperspace viewport!
But I forgot that my code was reversing the Object List - after keeping the Paperspace Viewport and reversing the list, all is fine 8-)
Sussed!
OK, you do need the paperspace viewport!
But I forgot that my code was reversing the Object List - after keeping the Paperspace Viewport and reversing the list, all is fine 8-)
Good to hear. It's always the small items. " The devil is in the details. " - Whoever....
Very impressive Lee.
Your comments/criticism is always welcome, and, of course, the inevitable bug reports!
QuoteYour comments/criticism is always welcome, and, of course, the inevitable bug reports!
Lee,
This just gets better and better.
One thing though, The copy function, while it does copy the tab, does not copy the page setup information
as it does when copying the tab manually.
I hate to be picky considering the amount of work you have put into this, and there is now way you can keep everybody happy,
but I thought you would want to know.
(defun c:TabSortClean (/ wPath)
(vl-load-com)
(if (setq wPath (findfile "ACAD.PAT"))
(progn
(setq wPath (vl-filename-directory wPath))
(or (eq "\\" (substr wPath (strlen wPath)))
(setq wPath (strcat wPath "\\")))
(foreach file (vl-directory-files wPath "TabSortV1.*.dcl" 1)
(initget "Yes No")
(if (/= "No" (getkword (strcat "\nDelete file: " file " ? [Yes/No] <Yes> : ")))
(vl-file-delete (strcat wPath file))))))
(princ))
I have updated the first post to version 1.5, this should resolve the issue with copying Plot settings.
Hi Lee,
Can't you delete the temp dcl file when you close the dialog?
Lee,
FYI, In architectural DWGs the tab names need to be sorted like this:
A1
A2
A3
A10
Thanks Lee, I found it quite useful today!
Lee,
Sorry for my poor example, I did not type all the tabs I have.
A1
A2
A3
A10
E1
E2
M1
M2
I'm not sure that I want to completely replace my Numerical Sort with one that would sort the tabs in that order though...perhaps I should add an option to make the Numerical Sort perform in that way? But what would I call it...A10 should not precede A2 though.
Surely that is not a true Numerical Sort, rather it prioritises Alphabetical over Numerical...
"Arch Sort" 8-)
or
"Architectural Sort"
A10 should not precede A2 though.
Maybe have the sort button pull up a little dialog box, where the user could type in the sort criteria.
/idea
Maybe have the sort button pull up a little dialog box, where the user could type in the sort criteria.
/idea
Hmm... nice idea Tim, I could make the "Alpha" and "#Sort" buttons into one "Sort.." button - and make a dialog with a popup_list [?] containing "Alphabetical" "Numerical" "Architectural"... [ but then I would be one button short on the dialog and would have to think up another idea to add to it... :P ]
(action_tile
"tabs"
(vl-prin1-to-string
(quote
(progn
(setq #st (getvar "DATE")
ptr $value
)
(if (and (eq dbptr $value) (< (abs (read (rtos (- #en #st) 2 10))) 0.0000011667))
(progn (Makelst "tabs" (setq dclst (tab_rename (atoi ptr) dclst)))
(setq dbptr nil)
(set_tile "tabs" ptr)
)
(setq #en (getvar "DATE")
dbptr $value
)
)
)
)
)
)
("AB12F" "AB07E" "AA24D" "ABC1P" "AB07D" "BA1")
("AA24D" "AB07D" "AB07E" "AB12F" "ABC1P" "BA1")
(defun StrBrk (str / x slst nLst rLst aLst)
(setq slst (vl-string->list str))
(while (setq x (car slst))
(setq slst (cdr slst))
(cond ( (< 47 x 58)
(setq nLst (cons x nLst))
(setq rLst (cons (reverse aLst) rLst) aLst nil))
(t (setq aLst (cons x aLst))
(setq rLst (cons (reverse nLst) rLst) nLst nil))))
(mapcar 'vl-list->string
(vl-remove nil
(reverse
(cons (reverse aLst)
(cons (reverse nLst) rLst))))))
(StrBrk "NJ2346NJ2B6BB2B6B2U")
("NJ" "2346" "NJ" "2" "B" "6" "BB" "2" "B" "6" "B" "2" "U")
(defun StrBrk (str / x slst nLst rLst aLst)
(setq slst (vl-string->list str))
(while (setq x (car slst))
(setq slst (cdr slst))
(cond ( (< 47 x 58)
(setq nLst (cons x nLst))
(setq rLst (cons (reverse aLst) rLst) aLst nil))
(t (setq aLst (cons x aLst))
(setq rLst (cons (reverse nLst) rLst) nLst nil))))
(mapcar 'vl-list->string
(vl-remove nil
(reverse
(cons (reverse aLst)
(cons (reverse nLst) rLst))))))
(defun ArchSort (lst)
(vl-sort lst
(function
(lambda (a b / a b)
(setq a (StrBrk a) b (StrBrk b))
(while (and a b (or (not
(apply '=
(mapcar 'type
(mapcar 'read
(mapcar 'car (list a b))))))
(apply '= (mapcar 'car (list a b)))))
(setq a (cdr a) b (cdr b)))
(cond ( (not a) (car b))
( (not b) (car a))
( (apply 'and
(mapcar 'numberp
(mapcar 'read
(mapcar 'car (list a b)))))
(< (read (car a)) (read (car b))))
(t (< (car a) (car b))))))))
keep it up, Lee
p.s.
it's much easier to write "action_tile" code with the help of vl-prin1-to-string
;; ArchSort by Lee McDonnell ~ 18/09/2009
(defun StrBrk (str / x slst nLst rLst aLst)
(setq slst (vl-string->list str))
(while (setq x (car slst))
(setq slst (cdr slst))
(cond ( (< 47 x 58)
(setq nLst (cons x nLst))
(setq rLst (cons (reverse aLst) rLst) aLst nil))
(t (setq aLst (cons x aLst))
(setq rLst (cons (reverse nLst) rLst) nLst nil))))
(mapcar 'vl-list->string
(vl-remove nil
(reverse
(cons (reverse aLst)
(cons (reverse nLst) rLst))))))
(defun ArchSort2 (lst)
(vl-sort lst
(function
(lambda (a b / a b)
(setq a (StrBrk a) b (StrBrk b))
(while (and a b (or (/= (type (read (car a)))
(type (read (car b))))
(= (car a) (car b))))
(setq a (cdr a) b (cdr b)))
(cond ( (not a) (car b))
( (not b) (car a))
( (and (numberp (car a))
(numberp (car b)))
(< (read (car a)) (read (car b))))
(t (< (car a) (car b))))))))
Elapsed milliseconds / relative speed for 1024 iteration(s):
(ARCHSORT2 LST).....1622 / 3.39 <fastest>
(ARCHSORT LST)......5491 / 1.00 <slowest>
;; ArchSort by Lee McDonnell ~ 18/09/2009
(defun StrBrk (str / x slst nLst rLst aLst)
(setq slst (vl-string->list str))
(while (setq x (car slst))
(setq slst (cdr slst))
(cond ( (and nLst (= 46 x))
(setq nLst (cons x nLst)))
( (< 47 x 58)
(setq nLst (cons x nLst))
(setq rLst (cons (reverse aLst) rLst) aLst nil))
(t (setq aLst (cons x aLst))
(setq rLst (cons (reverse nLst) rLst) nLst nil))))
(mapcar 'vl-list->string
(vl-remove nil
(reverse
(cons (reverse aLst)
(cons (reverse nLst) rLst))))))
(defun ArchSort2 (lst)
(vl-sort lst
(function
(lambda (a b / a b t1 t2)
(setq a (StrBrk a) b (StrBrk b))
(while (and a b (or (not (or (= 'SYM (setq t1 (type (read (car a))))
(setq t2 (type (read (car b)))))
(and (vl-position t1 '(INT REAL))
(vl-position t2 '(INT REAL)))))
(= (car a) (car b))))
(setq a (cdr a) b (cdr b)))
(cond ( (not a) (car b))
( (not b) (car a))
( (and (numberp (read (car a)))
(numberp (read (car b))))
(< (read (car a)) (read (car b))))
(t (< (car a) (car b))))))))
(ArchSort2 '("E-2" "M-4" "M10" "A-11" "A-2" "A-1" "E-1" "AC3" "AC12" "A-1.2"))
("A-1" "A-1.2" "A-2" "A-11" "AC3" "AC12" "E-1" "E-2" "M10" "M-4")
(defun archSort (lst / NumSuff)
(defun NumSuff (str / slst loop x num dot)
(setq slst (reverse (vl-string->list str))
loop T
)
(while loop
(setq x (car slst))
(cond
((< 47 x 58)
(setq num (cons x num)
slst (cdr slst)
)
)
((and (= x 46) (not dot))
(setq num (cons x num)
slst (cdr slst)
dot T
)
)
(T (setq loop nil))
)
)
(cons (vl-list->string (reverse slst)) (read (vl-list->string num)))
)
(mapcar
(function
(lambda (x)
(nth x lst)
)
)
(vl-sort-i (mapcar 'NumSuff lst)
(function
(lambda (x1 x2)
(if (= (car x1) (car x2))
(< (cdr x1) (cdr x2))
(< (car x1) (car x2))
)
)
)
)
)
)_$ (setq lst '("E-2" "M-4" "M10" "A-11" "A-2" "A-1" "E-1" "AC3" "AC12" "A-1.2"))
("E-2" "M-4" "M10" "A-11" "A-2" "A-1" "E-1" "AC3" "AC12" "A-1.2")
_$ (BENCHMARK '((ArchSort2_Lee lst) (ArchSort_gile lst)))
Benchmarking ................Elapsed milliseconds / relative speed for 8192 iteration(s):
(ARCHSORT_GILE LST)......1578 / 6.46 <fastest>
(ARCHSORT2_LEE LST).....10188 / 1.00 <slowest>
(archsort2 '("A-1A" "A-10A" "A-2B" "A-10B"))
("A-1A" "A-2B" "A-10A" "A-10B")
(archsort '("A-1A" "A-10A" "A-2B" "A-10B"))
("A-10A" "A-10B" "A-1A" "A-2B")
(defun archSort_gile2 (lst / SplitStr lst)
(defun SplitStr (str / num-sub str-sub lst)
(defun str-sub (char lst)
(if lst
(if (< 47 (car lst) 58)
(cons char (num-sub (chr (car lst)) (cdr lst)))
(str-sub (strcat char (chr (car lst))) (cdr lst))
)
(list char)
)
)
(defun num-sub (char lst / tmp)
(cond
((null lst) (list char))
((= 46 (car lst))
(if (and (cadr lst)
(numberp
(read (setq tmp (strcat char "." (chr (cadr lst)))))
)
)
(num-sub tmp (cddr lst))
(cons char (str-sub (chr (car lst)) (cdr lst)))
)
)
((< 47 (car lst) 58)
(num-sub (strcat char (chr (car lst))) (cdr lst))
)
(T (cons char (str-sub (chr (car lst)) (cdr lst))))
)
)
(setq lst (vl-string->list str))
(if (< 47 (car lst) 58)
(num-sub (chr (car lst)) (cdr lst))
(str-sub (chr (car lst)) (cdr lst))
)
)
(mapcar
(function
(lambda (x)
(nth x lst)
)
)
(vl-sort-i
(mapcar 'SplitStr lst)
(function
(lambda (x1 x2 / s1 s2 n1 n2)
(while (= (setq s1 (car x1)) (setq s2 (car x2)))
(setq x1 (cdr x1)
x2 (cdr x2)
)
)
(if (and (numberp (setq n1 (read s1))) (numberp (setq n2 (read s2))))
(< n1 n2)
(< s1 s2)
)
)
)
)
)
)_$ (BENCHMARK '((ArchSort2_Lee lst) (ArchSort_gile2 lst)))
Benchmarking ...............Elapsed milliseconds / relative speed for 4096 iteration(s):
(ARCHSORT_GILE2 LST).....1140 / 4.43 <fastest>
(ARCHSORT2_LEE LST)......5047 / 1.00 <slowest>
(defun ArchSort3_lee (lst / StrBrk)
(defun StrBrk (Str / x sLst nLst rLst aLst)
(setq sLst (vl-string->list Str))
(while (setq x (car sLst))
(setq sLst (cdr sLst))
(cond ( (and nLst (= 46 x))
(setq nLst (cons x nLst)))
( (< 47 x 58)
(setq nLst (cons x nLst))
(setq rLst (cons (reverse aLst) rLst) aLst nil))
(t (setq aLst (cons x aLst))
(setq rLst (cons (reverse nLst) rLst) nLst nil))))
(mapcar 'vl-list->string
(reverse
(vl-remove nil
(cons (reverse aLst)
(cons (reverse nLst) rLst))))))
(mapcar
(function
(lambda (x)
(nth x lst)))
(vl-sort-i (mapcar 'StrBrk lst)
(function
(lambda (a b / a b t1 t2)
(while (and a b (or (not (or (= 'SYM (setq t1 (type (read (car a))))
(setq t2 (type (read (car b)))))
(and (vl-position t1 '(INT REAL))
(vl-position t2 '(INT REAL)))))
(= (car a) (car b))))
(setq a (cdr a) b (cdr b)))
(cond ( (not a) (car b))
( (not b) (car a))
( (and (numberp (read (car a)))
(numberp (read (car b))))
(< (read (car a)) (read (car b))))
(t (< (car a) (car b)))))))))
Benchmarking ...............Elapsed milliseconds / relative speed for 4096 iteration(s):
(ARCHSORT_GILE2 LST).....1045 / 1.97 <fastest>
(ARCHSORT3_LEE LST)......2059 / 1.00 <slowest>
(defun archSort_gile3 (lst / SplitStr lst)
(defun SplitStr (str / lst test rslt num tmp)
(setq lst (vl-string->list str)
test (chr (car lst))
)
(if (< 47 (car lst) 58)
(setq num T)
)
(while (setq lst (cdr lst))
(if num
(cond
((= 46 (car lst))
(if (and (cadr lst)
(setq tmp (strcat test "." (chr (cadr lst))))
(numberp (read tmp))
)
(setq test tmp
lst (cdr lst)
)
(setq rslt (cons test rslt)
test "."
num nil
)
)
)
((< 47 (car lst) 58)
(setq test (strcat test (chr (car lst))))
)
(T
(setq rslt (cons test rslt)
test (chr (car lst))
num nil
)
)
)
(if (< 47 (car lst) 58)
(setq rslt (cons test rslt)
test (chr (car lst))
num T
)
(setq test (strcat test (chr (car lst))))
)
)
)
(setq rslt (cons test rslt))
(reverse rslt)
)
(mapcar
(function
(lambda (x)
(nth x lst)
)
)
(vl-sort-i
(mapcar 'SplitStr lst)
(function
(lambda (x1 x2 / s1 s2)
(while (= (setq s1 (car x1)) (setq s2 (car x2)))
(setq x1 (cdr x1)
x2 (cdr x2)
)
)
(if (and (numberp (read s1)) (numberp (read s2)))
(< (read s1) (read s2))
(< s1 s2)
)
)
)
)
)
)_$ (BENCHMARK '((ArchSort3_Lee lst) (ArchSort_gile2 lst) (ArchSort_gile3 lst)))
Benchmarking ................Elapsed milliseconds / relative speed for 8192 iteration(s):
(ARCHSORT_GILE3 LST).....1296 / 1.25 <fastest>
(ARCHSORT_GILE2 LST).....1453 / 1.12
(ARCHSORT3_LEE LST)......1625 / 1.00 <slowest>
(ArchSort_gile3 '("E-2" "M-4" "M10" "A-11" "A-2" "A-1" "E-1" "AC3" "AC12" "A-1.2"))
; error: bad argument type: stringp 1
(defun ArchSort_lee6 (lst / StrBrk)
(defun StrBrk (Str / x sLst nLst rLst aLst)
(setq sLst (vl-string->list Str) aLst "" nLst "")
(while (setq x (car sLst))
(setq sLst (cdr sLst))
(cond ( (and nLst (= 46 x))
(setq nLst (strcat nLst (chr x))))
( (< 47 x 58)
(setq nLst (strcat nLst (chr x)))
(setq rLst (cons aLst rLst) aLst ""))
(t (setq aLst (strcat aLst (chr x)))
(setq rLst (cons (cond ((read nLst)) ("")) rLst) nLst ""))))
(reverse
(vl-remove ""
(cons aLst
(cons (cond ((read nLst)) ("")) rLst)))))
(mapcar
(function
(lambda (x)
(nth x lst)))
(vl-sort-i (mapcar 'StrBrk lst)
(function
(lambda (a b / a b x1 x2)
(while (and (setq x1 (car a))
(setq x2 (car b))
(or (= x1 x2)
(not (or (= 'STR (type x1) (type x2))
(and (numberp x1) (numberp x2))))))
(setq a (cdr a) b (cdr b)))
(< (car a) (car b)))))))
Benchmarking ...............Elapsed milliseconds / relative speed for 4096 iteration(s):
(ARCHSORT_GILE2 LST).....1232 / 1.25 <fastest>
(ARCHSORT_LEE6 LST)......1544 / 1.00 <slowest>
Lee, Awesome tool - thanks.
Have you considered adding the ability to remove/replace an existing prefix/sufix (in addition to the add feature you have)?
Hallo Lee
Bekomme folgende Meldung
** DCL File Could not be Written **
Danke
(findfile "ACAD.PAT")
(findfile "ACAD.PAT")
Lee, Awesome tool - thanks.
Have you considered adding the ability to remove/replace an existing prefix/sufix (in addition to the add feature you have)?
Thanks Cary 8-)
I hadn't considered it - I suppose it would be part of the Rename function, but I am not certain as to how the user would specify what he/she wanted to remove (i.e. how would I recognise a prefix...)
Lee, Awesome tool - thanks.
Have you considered adding the ability to remove/replace an existing prefix/sufix (in addition to the add feature you have)?
Thanks Cary 8-)
I hadn't considered it - I suppose it would be part of the Rename function, but I am not certain as to how the user would specify what he/she wanted to remove (i.e. how would I recognise a prefix...)
Well, I don't know. But the example I have is is this:
TP1
TP2
TP3
TP4
I need to change the "TP" to "L-" for example.
Not sure how it might work though.
Beware of remaming multiple tabs the same name ie.:
"layout01" "layout02" "layout03" minus a suffix of 2 letters will give you 3 x "layout".
Hallo Lee
Sorry ivh habe es auf zwcad getestet.
Auf Autocad läuft es super.
Danke für die rasche Antwort
:-) :-)
(foreach tab lst
(vla-put-TabOrder tab
(1+ (vl-position
(strcase (vla-get-Name tab)) dclst)))))) Thanks for all you hard work Lee.
When you select more than one tab & go to Prefix, unchecking the "Apply to All Tabs" does not
prevent renaming all the tabs.
Also crashed the routine when I copied a tab, added a prefix, reset (which also revoved the copied tab from the list but it was still in the DWG)
then I added the prefix again. When I hit DONE.
Crashed here at line 333:Code: [Select](foreach tab lst
(vla-put-TabOrder tab
(1+ (vl-position
(strcase (vla-get-Name tab)) dclst))))))
because the name was not in the dclst & returned nil
(defun SplitStr (str / lst test rslt num tmp)
(setq lst (vl-string->list str)
test (chr (car lst))
)
(if (< 47 (car lst) 58)
(setq num T)
)
(while (setq lst (cdr lst))
(if num
(cond
((= 46 (car lst))
(if (and (cadr lst)
(setq tmp (strcat "0" "." (chr (cadr lst))))
(numberp (read tmp))
)
(setq rslt (cons (read test) rslt)
test tmp
lst (cdr lst)
)
(setq rslt (cons (read test) rslt)
test "."
num nil
)
)
)
((< 47 (car lst) 58)
(setq test (strcat test (chr (car lst))))
)
(T
(setq rslt (cons (read test) rslt)
test (chr (car lst))
num nil
)
)
)
(if (< 47 (car lst) 58)
(setq rslt (cons test rslt)
test (chr (car lst))
num T
)
(setq test (strcat test (chr (car lst))))
)
)
)
(if num
(setq rslt (cons (read test) rslt))
(setq rslt (cons test rslt))
)
(reverse rslt)
)
(defun ArchSort (lst / comparable)
(defun comparable (e1 e2)
(or (and (numberp e1) (numberp e2))
(= 'STR (type e1) (type e2))
(not e1)
(not e2)
)
)
(mapcar
(function
(lambda (x)
(nth x lst)
)
)
(vl-sort-i
(mapcar 'SplitStr lst)
(function
(lambda (x1 x2 / n1 n2 comp)
(while
(and
(setq comp (comparable (setq n1 (car x1)) (setq n2 (car x2))))
(= n1 n2)
)
(setq x1 (cdr x1)
x2 (cdr x2)
)
)
(if comp
(< n1 n2)
(numberp n1)
)
)
)
)
)
)
(StrBrk "A1.2.3") Returns: ("A" 1)
(SplitStr "A1.2.3") Returns: ("A" 1 0.2 0.3)
OK where is the HELP button to explain all this? :evil:
Command:
TABSORT Backtrace:
[0.93] (VL-BT)
[1.89] (*ERROR* "bad argument type: numberp: -")
[2.84] (_call-err-hook #<SUBR @1e913d48 *ERROR*> "bad argument type: numberp:
-")
[3.78] (sys-error "bad argument type: numberp: -")
:ERROR-BREAK.73 "bad argument type: numberp: -"
[4.70] (ABS -)
[5.65] (#<SUBR @1e44458c -lambda-> "tabs" "1" "" 4 75 14)
[6.56] (#<SUBR @173399ec -application-envelope->)
:ENTRY-NAMESPACE.53 (:ENTRY-NAMESPACE)
[7.50] (#<SUBR @17339a14 -unwind-protect->)
[8.47] (_lisplet-apply #<Document-LISPLET> #<SUBR @173399ec
-application-envelope-> nil nil)
[9.39] (_lisplet-app-apply #<Document-LISPLET> #<SUBR @1e44458c -lambda->
("tabs" "1" "" 4 75 14))
[10.32] (dcl-call-back ("tabs" "1" "" 4 75 14) T)
:DCL-ACTION.26 (((:DCL-ACTION "tabsort" "tabs" 4)))
[11.23] (START_DIALOG)
[12.19] (C:TABSORT)
[13.15] (#<SUBR @1e444550 -rts_top->)
[14.12] (#<SUBR @1733435c veval-str-body> "(C:TABSORT)" T #<FILE internal>)
:CALLBACK-ENTRY.6 (:CALLBACK-ENTRY)
:ARQ-SUBR-CALLBACK.3 (nil 0)
** Error: bad argument type: numberp: - **
(< (abs (read (rtos (- #en #st) 2 10))) 0.0000011667))Maybe the read returned the minus sign and no number to evaluate.Thanks Alan 8-)I couldn't get past the double-click.
I can't quite follow the backtrace too well - when exactly did it crash, and what did you try to rename the tab to (if you got that far)?
Good point CAB - I notice the ABS in the backtrace and I believe that is the only line that uses it.LoL
Did AJ maybe double click too fast :evil:
(abs (read (rtos -1.01887e-006 2 10)))
((<[color=red]=[/color] (setq dcTag (load_dialog fname)) 0)should be ((< (setq dcTag (load_dialog fname)) 0)
I have not been able to reproduce the error.Odd, I'll have to try it when I can get back on the PC (wife is using it). Perhaps it was an isolated incident. I did only run it one session; should have restarted AutoCAD.
I have not been able to reproduce the error.
BTW Lee, The = is causing the DCL not to fire the first time when it is createdCode: [Select]((<[color=red]=[/color] (setq dcTag (load_dialog fname)) 0)should beCode: [Select]((< (setq dcTag (load_dialog fname)) 0)
I have not been able to reproduce the error.Odd, I'll have to try it when I can get back on the PC (wife is using it). Perhaps it was an isolated incident. I did only run it one session; should have restarted AutoCAD.
I have not been able to reproduce the error.
BTW Lee, The = is causing the DCL not to fire the first time when it is createdCode: [Select]((<[color=red]=[/color] (setq dcTag (load_dialog fname)) 0)should beCode: [Select]((< (setq dcTag (load_dialog fname)) 0)
Thats funny - the equals makes no difference to mine :? - but I shall change it anyway.I have not been able to reproduce the error.Odd, I'll have to try it when I can get back on the PC (wife is using it). Perhaps it was an isolated incident. I did only run it one session; should have restarted AutoCAD.
I couldn't reproduce the error either, unless your DATE sys var is somehow "corrupted", I can't think of any other explanation... :-(
Ahhh of couse!It's an easy-to-squash bug.
Ok, then I suppose an easy fix would be to just set the DIMZIN to say 0, and reset it after program completion ;-)
Bug Squashed 8-)We're buggy people. :-o :lol:
First post updated to Version 1.8.1 to include the bug fixes for the two Alans :-)
I have not been able to reproduce the error.
BTW Lee, The = is causing the DCL not to fire the first time when it is createdCode: [Select]((<[color=red]=[/color] (setq dcTag (load_dialog fname)) 0)should beCode: [Select]((< (setq dcTag (load_dialog fname)) 0)
Thats funny - the equals makes no difference to mine :? - but I shall change it anyway.
I have not been able to reproduce the error.
BTW Lee, The = is causing the DCL not to fire the first time when it is createdCode: [Select]((<[color=red]=[/color] (setq dcTag (load_dialog fname)) 0)should beCode: [Select]((< (setq dcTag (load_dialog fname)) 0)
Thats funny - the equals makes no difference to mine :? - but I shall change it anyway.
Maybe it's ACAD2000 but the help says negative numbers signal failure so zero is returned on my system.
While the Help DCL looks great I would change to ok_cancel button to on_only in you next revision. 8-)
Lee,
I've finally had some time to play with your latest version and I must say, very nice. Thank You Sir!
3. why is this tool not a original acad one
As for the New Copy of a layout, the end position is my logical choice. Hard to guess where each user wants it.
I suggest a hard coded variable the user could set for beginning of list/below original/end of list.
Regarding the Group selection, I for one think each operation should respond to this selection.
That is to say sort, reverse, etc should operate on the selected group. That said I'm not sure how
I would treat a non-continuous selection. What to do with the items in the middle of the group.
You've done a good job with the routine as it is Lee.
Great program Lee, thanks. :-)Actually none of the mnemonics work WHILE the DCL focus is in the LIST Box. This is normal. select any button & the focus is changed and the mnemonics work again.
It's hardly worth mentioning but once I click on one of the tabs the 'H' for help doesn't work. Who cares really, but just so you know.
but, if you create a new TAB and than press a diffrent Key
this will change the order of the TAB list.
I have updated the first post to Version 1.9, the Reverse Function will now only reverse Selected Tabs.sensational thats nice thx *thumbs up*
I've actually just started University now, and don't have a lot of time or access to the internet at home, so I can't spend as much time programming as I used to :-( But I shall still try to stay in touch as and when I can. :-)
I have updated the first post to Version 1.9, the Reverse Function will now only reverse Selected Tabs.sensational thats nice thx *thumbs up*I've actually just started University now, and don't have a lot of time or access to the internet at home, so I can't spend as much time programming as I used to :-( But I shall still try to stay in touch as and when I can. :-)
I wish you much success and a good time see you next time 8-)
bye björn :)
Lee,
Not that this tool isn't already a HUGE help and timesaver, because it really is. And thank you for it.
But, would it be possible to add the ability to remove or edit a prefix or sufix (not just add one)?
Thanks
Lee,
Not that this tool isn't already a HUGE help and timesaver, because it really is. And thank you for it.
But, would it be possible to add the ability to remove or edit a prefix or sufix (not just add one)?
Thanks
Hi Cary,
I think you asked something like this before - I added a 'Find & Replace' which should, I hope, accomplish what you wish :-)
Lee
Lee,
Not that this tool isn't already a HUGE help and timesaver, because it really is. And thank you for it.
But, would it be possible to add the ability to remove or edit a prefix or sufix (not just add one)?
Thanks
Hi Cary,
I think you asked something like this before - I added a 'Find & Replace' which should, I hope, accomplish what you wish :-)
Lee
Ooh - you're right, I forgot that :oops:
Sorry
i'm not sure this one was reported but when we select few layouts and click REVERSE, REVERSE then autocad freeze.
Updated to Version 2.1 to provide a quick fix for the issue Kruuger reported.it might be old but program is a really good tool :)
Yuck... I hate my old code :ugly: If I had the time I would rewrite the whole program. :|
Updated to Version 2.1 to provide a quick fix for the issue Kruuger reported.it might be old but program is a really good tool :)
Yuck... I hate my old code :ugly: If I had the time I would rewrite the whole program. :|
thank you
kruuger
Oohhh Sure! Come out with the revamp a day after I could really used it. :roll:
I used it yesterday to rename 37 layout tabs in 5 files. Very handy. I only need it once in a great while but when I used it is a great time saver. Thank you.
Now where is that virtual bar tender. I need to buy you a beer.
Dear Lee,
Could you possibly add publish function to TABSORT?
Thanks,
Miquan