TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: daron on November 24, 2003, 04:30:01 PM
-
Let's say you need to get a selection set of a group of text objects all on a specific layer and you need to sort these objects by their text string number, i.e. "1" "2" "3"... All text objects will only have numbers in the string. What would be a quick way to sort the objects into a list of selection sets by this number from smallest to largest? I'm muddling through some ideas, but the one I've got takes a great deal of time during the sorted selection phase.
-
Well, lets see, you want to sort a selection set based on the text value of DXF 1.
I don't see a simple solution right off the top of my head, but, how about this.
Extract the text value of each text entity and append them one to another in a list... i.e. ("23" "31" "3" "42" "18" .......) ignoring the entity that they came from. At the same time create a list using the numeric values of the text....i.e. (23 31 3 42 18 .......)
then foreach N in the numbered list.....
(setq X -1)
(foreach N numbered_list (setq X (max X N)))
Now you have the maximum number of digits in the highest number in the list, lets say 14361
Now you take each string in the text_list and prepend the correct number of "0" to the beginning of each string.
(foreach n text_list (while (<(strlen n)(strlen (rtos X 2 0))) (setq n(strcat "0" n)))
(setq new_list (append new_list n))
)
Use acad_strlsort to sort the new_list
(setq sorted_list (acad_strlsort new_list))
Now lets order the entities...
.....
to be continued......
-
Okay, this is what I currently have. sslist is a list of vla-objects that are text. I probably should not start out with vla-objects, but this is a routine I wrote about 6 months ago and am trying to improve. Currently, the portion that slows everything down is the part that re-sorts every object back into the list, not the sorting of the numbers. I probably should have shown this in the beginning, but it is so big, I wanted to see what others could come up with.
(defun selection-set-sorter (sslist) ;(setq sslist vla-list)
(setq vl-string-list nil)
(foreach string sslist
(setq vl-string-list
(append vl-string-list
(list (atoi (vla-get-textstring string)))
)
)
)
(setq vl-sort-list (mapcar 'itoa
(vl-sort vl-string-list '<))
vla-list-sorted nil
)
(foreach item vl-sort-list
(setq vla-list-sorted
(append vla-list-sorted
(list (ssget "x"
(list (cons 1 item))
)
)
)
)
)
(setq index 0
vla-list-new nil
index (1- (vl-list-length vla-list-sorted)
)
)
(repeat (vl-list-length vla-list-sorted)
(setq vla-list-new
(cons
(vlax-ename->vla-object
(ssname
(nth index
vla-list-sorted
)
0
)
)
vla-list-new
)
index (1- index)
)
)
)
-
(defun ss->vla-list (ss lst)
(cond ((ssname ss 0)
(setq lst (append (list
(vlax-ename->vla-object (ssname ss 0))) lst))
(ss->vla-list (ssdel (ssname ss 0) ss) lst)); 1st cond
((null (ssname ss 0)) lst); 2nd cond
); cond
)
(setq ss (ssget '((0 . "TExT"))))
(setq obj-lst (SS->VLA-LIST ss nil))
(setq obj-lst-s
(vl-sort obj-lst
'(lambda (x y)
(<
(atof (vla-get-TextString x))
(atof (vla-get-TextString y))
)
)
)
)
-
Daron,
Here is my version. Can't tell how fast it is?
Not what you were looking for I sure but I thought I'd try to do anyway.
Mark, you show off :lol:
(defun c:srt (/ x cnt item NewList RawList)
(setq ss (ssget '((0 . "TEXT"))))
(setq x 0
cnt (sslength ss)
)
(cond
((/= ss nil)
(repeat cnt
(setq RawList (append
RawList
(list (cons (ssname ss x)
(cdr (assoc 1 (entget (ssname ss x))))
)
)
)
x (1+ x)
)
)
;sort list
(setq NewList
(vl-sort RawList '(lambda (E1 E2) (< (cdr E1) (cdr E2))))
x 0
NewSs (ssadd)
)
(foreach item NewList
(setq NewSs (ssadd (car item) NewSs))
)
) ; end cond 1
)
(princ)
)
-
WOW Mark. Im in awe! That is just perdy!
-
Daron,
I'm at a complete loss as to what you're trying to do. The routine you posted returns an integer and what it is doing otherwise is a complete mystery :D
Is it CAB's routine you're after, i.e. returning (or "should be" returning) a selection set with items sorted according to strings representing numbers? Or do you want it as a list of vla-objects sorted in the same manner like Mark's solution?
CAB, your routine doesn't return anything, but leaves a global sset to be picked up. That might not be the best way to do it. But, if I read Daron's original request correctly I think that is perhaps what comes closest. I would put a couple of features into it, though. Such as checking if text holds a number, adding the layer functionality that Daron talked about and returning the new sset instead of leaving a global variable:
(defun selsort (ss lyr / elst a ent num? newSs)
(defun getss (l)
(ssget "X" (list '(0 . "TEXT")
(cons 8 (cond (l)("*")))))
)
(cond ((or ss (setq ss (getss lyr)))
(setq a 0 newSs (ssadd))
(repeat (sslength ss)
(setq ent (ssname ss a))
(if (numberp (setq num? (read (cdr (assoc 1 (entget ent))))))
(setq elst (cons (cons ent num?) elst))
)
(setq a (1+ a))
)
(setq elst (vl-sort elst (function (lambda (x y) (< (cdr x) (cdr y))))))
(foreach n elst
(ssadd (car n) newSs)
)
)
)
)
Daron, if your intention is to return a list of sorted vla-objects then you could replace the last FOREACH with something like
(mapcar (function (lambda (n)(vlax-ename->vla-object (car n)))) elst)
.. or, for a sorted list of enames, a simple thing like (mapcar 'car elst)
-
Maybe this? Weeds out none numeric strings and returns a list ov vla-objects.
;; selection set to vla-object list
(defun ss->vla-list (ss lst)
(cond ((ssname ss 0)
(setq lst (append (list
(vlax-ename->vla-object (ssname ss 0))) lst))
(ss->vla-list (ssdel (ssname ss 0) ss) lst)); 1st cond
((null (ssname ss 0)) lst); 2nd cond
); cond
)
;; test each item in a list of integers for a value
;; of between 48-57 (ascii for 0-9)
;; returns T if the list contins ONLY values 48-57
(defun is_eq_only_num (lst)
(vl-every
'(lambda (i) (and (> i 47)(< i 58)))
lst
)
)
;; remove those vla-objects in the list(vl-lst) that are
;; NOT numbers or contain ANY letters. i.e. "4square"
;; would be removed were "456" would not.
(defun ret_only_num (vl-lst / nlst)
(setq nlst
(vl-remove-if-not
'(lambda (x)
(is_eq_only_num (vl-string->list (vla-get-textstring x)))
)
vl-lst
)
)
(sort_lst_by_num nlst)
)
;; sort a list of vla-objects that equal ONLY numbers
(defun sort_lst_by_num (vl-lst / vl-lst-s)
(setq vl-lst-s
(vl-sort vl-lst
'(lambda (x y)
(<
(atof (vla-get-TextString x))
(atof (vla-get-TextString y))
)
)
)
)
)
;; testing function
(defun funs-test ( / ss obj-lst sorted-lst)
(if (setq ss (ssget '((0 . "TEXT"))))
(if (setq obj-lst (SS->VLA-LIST ss nil))
(setq sorted-lst (ret_only_num obj-lst))
)
)
sorted-lst
)
-
You've heard the expression "you learn something new everyday", I got an early start! Looking at SMadsen's getss function above. I saw this (cons 8 (cond (l)("*"))). Thanks Mr. Madsen, that is excellent.
-
Just another way to say (if this this that)
I like your VL-EVERY stuff. It's not vl-every day one gets to see that function in use.
But what if the number is negative? I know Daron said integers only but what if it's a real?
-
>But what if the number is negative?
>but what if it's a real?
Excellent question. Let's ask D-A-R-O-N.....
-
OK, lets see if I understand the routine correctly.
;; Sort function by SMadsen
;; function called with sel set and layer name
;; note, values ss or lay may be nil
(defun selsort (ss lyr / elst a ent num? newSs)
;; sub function here
(defun getss (l) ; if sel set nil, go get one
(ssget "X" ; use all of drawing with the following filter in a list
(list '(0 . "TEXT") ; get only TEXT objects
(cons 8 ;(8 . layername)
(cond (l) ; COND test for nil layername, returns layer NAME
("*") ; OR returns the wildcard character to get ALL Layers
)
)
)
)
)
;;; main function starts here
(cond ; ss has sel set already OR go get a sel set
((or ss (setq ss (getss lyr))) ; if ss nil and can't find any on layer do nothing
(setq a 0 ; set pointer to 0
newSs (ssadd) ; create an empty sel set
)
(repeat (sslength ss) ; loop for each item in the sel set
(setq ent (ssname ss a)) ; get the name of each item in the set one at a time
(if (numberp ; test num? to see if it is a number, skip (setq elst if not number
(setq num? ; store the word in var num?
(read ; get the first word if text has a space character
(cdr ; get the TEXT only
(assoc 1 ; get the TEXT doted pair
(entget ent) ; get entity data
)))))
(setq elst ; build a list of name and text
(cons ; add doted pair list to elst ((ename . "25") (ename . "40"))
(cons ent num?) ; create a doted pair of name & number (ename . "25")
elst))
)
(setq a (1+ a)) ; increment pointer
)
(setq elst ; rebuild list of sorted name & text
;;; you got me, don't understand yet how this works
(vl-sort elst (function (lambda (x y) (< (cdr x) (cdr y)))))
)
(foreach n elst ; step through newly sorted doted pair list, n = (ename . "25")
(ssadd ; add ename to end of new sel set newSs
(car n) ; get ename only from doted pair
newSs)
)
)
)
;; "foreach" returns the last value & "ssadd" returns the sel set after each add
;; therfore the sorted sel set is returned when the function is complete
;; EXCEPT if no ss was passed AND no ss was found on the layer
;; THEN nil is returned
)
;; routine to call function
(defun C:srt ()
;; cal selsort with layer only so All text on that layer will be analized
(setq NewSs (selsort nil "zDtl xLight 3"))
(princ)
)
-
Ah, a code analysis. That's cool, CAB!
In (if (numberp (setq num? .... , it uses READ to test for a number. It's the result from READ that gets dotted with the ename ((ename . 25)(ename . 40)...), not the string. This means that if a string holds a unit or some other text, it is still being regarded as a number, e.g. "25 mm" would be stored as (ename . 25). Thought that might be a cool feature but it all depends on the specific use, of course.
You say that you don't get how the LAMBDA works? Hmm, you did it the same way in your routine :) What part of it is unclear?
All your other comments are correct. Nicely spotted that it can be called with nil arguments :) E.g. (selsort nil nil) grabs all TEXTs and sort those that contains a number.
-
Well, since you're asking, I'll elaborate. Most of you guys here deal with land. Well, I deal with taking the land you guys set up and ripping it apart into individual lots. Each object I'm selecting here is a lot number. I've never seen a negative lot number, a real number or one's with letters contained in them, so I'm not too worried about getting lettered, negative or real numbered strings.
Here's the entire job that is happening with this routine. Certain things are set up before hand, like separating each individual lot and setting objects on specific layers. The layer of the lot numbers is, LOTNO2. Don't ask. Enter the routine. I call it Super Write Block. It runs a page setup, sets the limits of the page, inserts a titleblock specific to certain city requirements and selects each object on LOTNO2, sorts them, zooms to the center of each lot, one at a time. It then allows the user to select the lot and other objects, moves them to the middle of the titleblock, allows the user to move the objects to fit better. When the user hits enter, the routine moves the lot number to the upper right corner of the titleblock, moves a predefined north arrow into a block where it belongs, then reads a txt file, looking for a match of the lot number with whatever line it finds, then reads the next line as the lot address and puts it in place where it belongs and many other things. When all is finished, it should plot it and then write block it out using the lot number as the drawing name, i.e 01.dwg. To keep all the drawings sorted, I use C for any drawing < 9 and > 100. For 100 > I use L. Haven't had to worry about 1000, yet.
As far as this function goes, it takes all the objects that have been selected and sorts them based on their lot number. I think the problem I'm having with speed has to do with converting ename's to vla-objects, then sorting, then re-selecting ename's by their sort order and re-converting them to vla-objects. I think I know what I need to do, but when you spend all day looking at something, it's nice to get some fresh ideas from others. Thank you all for your input and ideas. I like them all.
-
(cons 8 ;(8 . layername)
(cond (l) ; COND test for nil layername, returns layer NAME
("*") ; OR returns the wildcard character to get ALL Layers
)
) You remember that OPTION argument question I asked a while ago? This is what I would consider an optional argument. That is cool.
-
After you have sorted the "objects" what do you want in return, vla-objects?
-
smad
You say that you don't get how the LAMBDA works? Hmm, you did it the same way in your routine What part of it is unclear?
I'm a poor coder but a Master Code Thief :lol:
I'll have to get back to you this afternoon, duity calls.
CAB
-
After you have sorted the "objects" what do you want in return, vla-objects?
Oh yeah.
-
Hehe CAB .. as long as you share what you 'borrow' :D
Daron, that made sense, thanks.
-
>But what if the number is negative?
>but what if it's a real?
This is tough! I can do a negitive (sorta) and a real using a combination of 'vl-string->list' and 'vl-remove-if BUT, if you have something like 15.2A-B, hahaha......... or AS1.2DF.S forget it. :D
BTW check this out.
(vl-remove-if
'(lambda (z)
(cond ((> z 58))
((< z 45))
((= z 47))
)
)
lst
)
-
Thanks Mark, but I highly doubt negatives, real, or alpha strings will ever give a problem.
-
Mark, your first set that you put out is beautiful and useful for this job with just a little tweaking. Blink of an eye.
-
As a casual viewer of this thread I must say I agree with Stig regarding not knowing what was actually required untill well into the thread.
Finding answers is sometimes difficult.
Finding the correct question is harder.
... this is not meant to pick on anybody, just an observation of something I am becoming increasingly aware of. :)
Regards
Kerry
-
Well, I wasn't trying to be too vague. I just wasn't sure how much info was too much. I thought what I had written was enough. I wasn't asking for anybody to do the work for me, just throw out some ideas, similar to the time Stig helped just by throwing out a couple of functions I hadn't considered. At the same time I knew I'd get a few different responses and thought it would be a good way of showing those who are just learning, something different. As far as not knowing until well into the thread, I'm sorry. At the same time, everybody had the right general idea and even though I stopped at the first one I tried, I'm sure they all work well. Mark's was able to take a function that would take 10 seconds to process for 112 lots and using parts of his I now notice no delay. All that was required was some input. Thank you.
-
Stig
i posted my comments or questions about lambda over in the Teach Me forum.
When and if you have time :)
CAB
-
What, you can't hi-jack this thread like most people? You gotta go create your own, and in a different forum even. I see how it is. :lol:
Good work over there. I normally would be moving it back into this forum, but you set it up in such a way that it seems to start off as a tutorial.
*edited to make my intention more clear.
-
No hijacking here, I just didn't want to interfere with your theme.
The lambda & other functions are an area I have been wanting to explore
because I didn't understand how they worked but your routine caused me
to look harder at them. Looking at how they preform in VLIDE during
trace I have begun to see how they function. I have used
'(lambda (E1 E2) (< (cdr E1) (cdr E2)) and it did not trace but
this did (function(lambda (E1 E2) (< (cdr E1) (cdr E2))))) and I was
able to see it.
You all speak the language so fluently and I only know enough words to
get the jest of what you are saying. It is frustrating at times but I have
learned enough to steal peaces of code and reuse them. :)
CAB
-
Cab...me thinks that was another issue of sarcasm
-
I thought so, but you can't always tell :D
CAB
-
SMadsen,
I'm at it again. :)
Here is your routine with corrections to my comments
Also added a few more & added to the calling routine
This is the first time I have looked hard at the OR statement
((or ss (setq ss (getss lyr)))
if the first condition is true nothing else is processed and True is returned
Can't believe how much I have learned from this one routine, Thanks
As Se7en said looking at each line in TRACE mode will tell you volumes.
I think I'll search out a few more of your routines to look at if you don't mind?
(as soon as I can get time)
;; Sort function by SMadsen
;; function called with sel set and layer name
;; note, values ss or lay may be nil
(defun selsort (ss lyr / elst a n ent num? newSs) ; entry point of routine
;; ======================================================
;; LOCAL subroutine getss attempts to get a selection set
;; ======================================================
(defun getss (l) ; if sel set nil, go get one
(ssget "X" ; get all of drawing in a list with the following filter
(list '(0 . "TEXT") ; get only TEXT objects
(cons 8 ; get only items on this layer (8 . layername)
(cond (l) ; COND test for nil layername, returns layer NAME
("*") ; OR returns the wildcard character to get ALL Layers
)
)
)
)
)
;; ========================
;; Main routine starts here
;; ========================
(cond ; this cond stmt has only one condition & return nil if false
; if ss is not nil skip (setq ss (getss lyr))) and proceed to the next line
; if is nil, call subroutine getss and if can't find any on layer do nothing
((or ss (setq ss (getss lyr)))
(setq a 0 ; set pointer to 0
newSs (ssadd) ; create an empty sel set
)
(repeat (sslength ss) ; loop for each item in the sel set
(setq ent (ssname ss a)) ; get the name of each item in the set one at a time
(if (numberp ; test num? to see if it is a number, skip (setq elst if not number
(setq num? ; store the word in var num?
(read ; get the first word if text has a space character
(cdr ; get the TEXT only
(assoc 1 ; get the TEXT doted pair
(entget ent) ; get entity data
))))) ; end of the "if test"
;; if test is true do this next setq
(setq elst ; build a list of name and text
(cons ; add dotted pair list to elst ((ename . 25) (ename . 40))
(cons ent num?) ; create a dotted pair of name & number (ename . 25)
elst))
) ; end if
(setq a (1+ a)) ; increment pointer
) ; end repeat
(setq elst ; rebuild list of sorted name & text
;;; you got me, don't understand yet how this works
(vl-sort elst (function (lambda (x y) (< (cdr x) (cdr y)))))
)
(foreach n elst ; step through newly sorted doted pair list, n = (ename . 25)
(ssadd ; add ename to end of new sel set newSs
(car n) ; get ename only from dotted pair
newSs)
) ; end foreach
) ; end of cond 1
) ; end cond
;; "foreach" returns the last value & "ssadd" returns the sel set after each add
;; therfore the sorted sel set is returned when the function is complete
;; EXCEPT if no ss was passed AND no ss was found on the layer
;; THEN nil is returned
); end defun selsort
;; routine to call function
(defun C:srt (/ TextSs)
;; call selsort with layer only so All text on that layer will be analyzed
(setq TextSs (selsort nil "zDtl xLight 3"))
;; call selsort with nil nil and all text on all layers will be analyzed
(setq TextSs (selsort nil nil))
;; call selsort with user picked sel set, allow all layers to be analyzed
(prompt "\nSelect text to be sorted.")
(setq TextSs (selsort (ssget) nil))
(princ)
)
-
CAB, great that you could learn from it. Please grab whatever else you can step through and learn from. Mark posted a nice little mapcar/lambda routine in your thread in Teach Me. That should be worth stepping through to pick up some list logic.
By the way, what is "analized"? It sounds kinky but painfull :)
-
Ooooops,
Spell checker doesn't work if you don't use it.
Mark I thought you were going to add one. :)
That vla- stuff is still kicking my but I'll take a look at Mark's routine.
On second look he only used vl-remove, I should be able to handle that :)
CAB
-
Mark I thought you were going to add one. :)
Way to much coding! Take a look at this though, I use it all the time, it's a great little app. http://www.iespell.com/
That vla- stuff is still kicking my but I'll take a look at Mark's routine.
On second look he only used vl-remove, I should be able to handle that :)
The vl- functions are nothing fancy, just functions. The fun starts with the vlax- stuff. :D
-
Thanks Mark,
I downloaded the spell check.
Yes I meant the vlax stuff.. :)
CAB
-
Spell checker doesn't work if you don't use it.
Mark I thought you were going to add one.
Isn't Se7en the "Spell Checker"?