TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: daron on March 21, 2008, 10:13:26 AM
-
I'm trying to figure out how to write a function recursively. What I'd like it to do is:
Take a string and verify it's a string and strcase it
Check the string for comma separation
If there are commas in the string, recursively run through the string and create a list of the different strings without the commas.
If there are no commas, simply make it a list
Example: "huron,ontario,michigan,erie,superior" -> ("HURON" "ONTARIO" "MICHIGAN" "ERIE" SUPERIOR")
Here is an example of what I've got so far.
(defun
str->lst (string)
(cond ((= (type string) 'str) ;is it a string
(setq string (strcase string))
(cond ((= (type (setq comma (vl-string-position 44 string))) 'int)
;has commas
(while comma
(str->lst (setq str (substr string 1 comma)))
(setq string
(vl-string-left-trim
(strcat str ",")
string
)
comma (vl-string-position 44 string))
)
)
(t (setq string (list string)))
)
)
(t
(princ "\nArgument required is not a text string. Exiting.")
(exit)
)
)
str->lst
)What am I not doing right, here?
-
Why Recursion?
; parser by CAB single character delim, match ","
(defun sparser (str delim / ptr lst)
(while (setq ptr (vl-string-search delim str))
(setq lst (cons (substr str 1 ptr) lst))
(setq str (substr str (+ ptr 2)))
)
(reverse(cons str lst))
)
-
I think i agree with CAB; i think recursion isnt as straight forward as you want it to be in this instance and might cause a performance hit.
CAB try `repeat'; i think that could speed it up a bit.
EDIT: stupid keyboards; they hinder my expressive powers.
-
Because I want it.
Nice routine by the way.
Without recursion here's what I came up with:
wildcard is a string: "*LINE,ARC,CIRC*"
the return would be: ("*LINE" "ARC" "CIRC*")
(while (setq comma (vl-string-position 44 ;|","|; wildcard))
(setq selset (append
selset
(list (setq str (substr wildcard 1 comma))
)
)
wildcard (vl-string-left-trim
(strcat str ",")
wildcard
)
)
)
(setq selset (append selset (list wildcard)))Not the entire code, but I'm sure you get the gist. Also, the way this is working it feels like recursion would be cleaner code. I'll expound more later.
-
I think i agree with CAB; i think recursion isnt as straight forward as you want it to be in this instance and might cause a performance hit.
CAB try `repeat'; i think that could speed it up a bit.
EDIT: stupid keyboards; they hinder my expressive powers.
Bet you a beer it won't. :-)
-
CAB,
Wait, what am i talking about? I was thinking; i cant think of a good way to use repeat...so scratch that thought. Your good.
Darron, I will take a quick look at your code in a second.
-
I think i agree with CAB; i think recursion isnt as straight forward as you want it to be in this instance and might cause a performance hit.
CAB try `repeat'; i think that could speed it up a bit.
EDIT: stupid keyboards; they hinder my expressive powers.
Bet you a beer it won't. :-)
Ah!? ...You beet me to it.
No i wont bet you a beer cause i was being stupid.
-
BTW, Did you write that code? I got one i use, almost exactly the same, but i dont know where it came from (usually i document who i got code from).
(defun strParse (aStr delim / strList pos)
;;===================================================================;
;; StrParse ;
;;-------------------------------------------------------------------;
;; This function will take a string and parse it out into a list of ;
;; of strings. ;
;; ;
;; Arguments: aStr - A string to parse ;
;; delim - A string of the delimiter ;
;; ;
;; Example: (StrParse "This is a test string" " ") ;
;; Returns -> ("This" "is" "a" "test" "string") ;
;; ;
;; History: Unknown ;
;;===================================================================;
(while
(setq pos (vl-string-search delim aStr 0))
(setq strList (cons (substr aStr 1 POS) strList)
aStr (substr aStr (+ pos 2)))
)
(reverse (cons aStr strList))
)
-
Hi,
Here's mine (I think I posted it yet), it's recursive.
;; STR2LST
;; Transforms a string with separator into a list of strings
;;
;; Arguments
;; str = the string
;; sep = the separator pattern
(defun str2lst (str sep / pos)
(if (setq pos (vl-string-search sep str))
(cons (substr str 1 pos)
(str2lst (substr str (+ (strlen sep) pos 1)) sep)
)
(list str)
)
)
And the reverse function
;; LST2STR
;; Returns a string which is the concatenation of a list and a separator
;;
;; Arguments
;; str = the string
;; sep = the separator pattern
(defun lst2str (lst sep)
(if (cadr lst)
(strcat (vl-princ-to-string (car lst))
sep
(lst2str (cdr lst) sep)
)
(vl-princ-to-string (car lst))
)
)
Why Recursion?
Because it's often the first thing comming to my mind (may be a way of thinking) and because I found it quite elegant.
-
Thanks gile. I'll look at that.
-
That rules gile. Thanks a lot.
-
BTW, Did you write that code? I got one i use, almost exactly the same, but i dont know where it came from (usually i document who i got code from).
(defun strParse (aStr delim / strList pos)
;;===================================================================;
;; StrParse ;
;;-------------------------------------------------------------------;
;; This function will take a string and parse it out into a list of ;
;; of strings. ;
;; ;
;; Arguments: aStr - A string to parse ;
;; delim - A string of the delimiter ;
;; ;
;; Example: (StrParse "This is a test string" " ") ;
;; Returns -> ("This" "is" "a" "test" "string") ;
;; ;
;; History: Unknown ;
;;===================================================================;
(while
(setq pos (vl-string-search delim aStr 0))
(setq strList (cons (substr aStr 1 POS) strList)
aStr (substr aStr (+ pos 2)))
)
(reverse (cons aStr strList))
)
Yes I did along with this one:
; parser by CAB multi char delim, match "xyz"
(defun sparser (str delim / dlen ptr lst)
(setq dlen (1+ (strlen delim)))
(while (setq ptr (vl-string-search delim str))
(setq lst (cons (substr str 1 ptr) lst))
(setq str (substr str (+ ptr dlen)))
)
(reverse(cons str lst))
)Here is the link to our last discussion:
http://www.theswamp.org/index.php?topic=12985.0
-
*click*
I will have to chew on that code later today.
-
Nice one gile.
Here is my reverse.
(defun lst2str (lst sep / str)
(setq str (apply 'strcat (mapcar '(lambda (x) (strcat x sep)) lst)))
(substr str 1 (1- (strlen str)))
)
-
Speaking of chewing, here I go making things more difficult than they absolutely need to be again. What I was ultimately trying to do besides understand recursion was to take the idea of filtering entsel that Chuck Gabriel started a topic on. I remembered 7's little gem (http://www.theswamp.org/index.php?topic=21655.msg262155#msg262155) and thought it would be cool to make that more robust. I was thinking of using mapcar lambda functions to parse through each item of the string argument and compare it with the selected result. Funny thing is, I was planning on using wcmatch, but since I haven't done much with wcmatch in a long while, I forgot that it can take a comma delimited string and use it to compare the selected item. While this was a good learning experience, it was obviously unnecessary for what I really needed. However, here is the code with 7's original name intact so we know where it started.
(defun entse7 (wildcard / ent)
(cond ((setq ent (entsel (strcat "Get any " wildcard " type of object: ")))
(if (not (wcmatch (cdr (assoc 0 (entget (car ent)))) wildcard))
(entse7 wildcard)
)
)
(t (entse7 wildcard))
)
ent
)To really tighten it up, I suppose it would be a good idea to gather a list of possible named items and compare the list with it, but I won't.
Now, you might still be asking, why do I need a filtered list of objects for a function that can only return one object? The intent here is to use entse7 in a loop to gather objects in a list, then manipulate that list according to order of selection. Ssget is just too loose for what I'm looking at. 'zat make sense?
-
my try
char by char recursion, no vl-
(defun test (str dlm /)
(if (= str "")
(list "")
((lambda (fchar rslt)
(cond ((= fchar dlm) (cons "" rslt))
(t (cons (strcat (strcase fchar) (car rslt)) (cdr rslt)))
)
)
(substr str 1 1)
(test (substr str 2) dlm)
)
)
)
;;;(test "huron,ontario,michigan,erie,superior" ",")
yes, it's slow :)
-
It's slow because it's an algorithmic (parallel) way of working. If you used a heuristic way it would find the delimiters quicker and be able to parse faster like the vl-.
Nice code though.
-
Although you can use wild cards in ssget like this:
(setq ss (ssget "_+.:E:S" '((1 . "*ABC*"))))
it is case sensitive. So by modifying 7's code you can match without case being a factor.
-
What in the world? I've never seen "_+.:E:S". What does this do? I understand :E:S but where did you come up with +.? The problem I see with :E:S is if there are multiple objects under the cursor wouldn't you end up with both of them?
On another note, here's entse7 with a few bugs worked out.
(defun entse7 (wildcard / ent)
(setq pmpt (strcat "Get any " wildcard " type of object: ")
greed (grread nil 4 2)
)
(cond ((or (= (car greed) 25) ;right-click
(and (= (car greed) 2) ;keyboard entry
(or (= (cadr greed) 13) ;enter
(= (cadr greed) 32) ;spacebar
)
)
)
(setq ent nil)
)
((and (= (car greed) 3);ensures left-click
(setq ent (nentselp pmpt (cadr greed)))
)
(if (not (wcmatch (cdr (assoc 0 (entget (car ent)))) wildcard))
(entse7 wildcard)
ent
)
)
(t (entse7 wildcard))
)
)
-
Here is my "Over The top" version. 8-)
Will get text from attributes dims, etc.
;; CAB 03.21.08
;; get string from any entity that has a string that matches the
;; wild card pattern & with case flag
;; case = t honor the case in the pattern
;; Catch escape, allow enter, entity filter or not, wcmatch on type filter
;; Returns list (string ename) or nil
(defun StringSel (pattern ; string Wild Card pattern
case ; t = honor case in string else match any case
nentOK ; t = allow entities within blocks
msg ; string - select message
etypes ; list pf types '("TEXT" "MTEXT") or pattern "*TEXT"
;; nil for any object type
/
ent elst txt_str
)
(or
(null eTypes)
(listp eTypes)
(setq eTypes (list eTypes)) ; make into a list if patterns string
)
(setvar "ERRNO" 0)
(if
(vl-catch-all-error-p
(vl-catch-all-apply
'(lambda ()
(while
(cond
;; user to select the object
((and (null (or (and nentOK (setq ent (nentsel msg)))
(and (not nentOK) (setq ent (entsel msg)))))
(/= 52 (getvar "ERRNO"))
)
(princ "\n*-> Missed, Try Again.")
)
;; check for user ENTER key
((= 52 (getvar "ERRNO"))
(prompt "\n*-> User Quit.")
)
;; got an object, see if it is the correct object type
((and
etypes ; null = no test for types of objects
(not (vl-some
'(lambda(x)
(wcmatch (cdr (assoc 0 (entget (car ent)))) x))
(mapcar 'strcase etypes)))
)
(princ "\n*-> Wrong entity type, Try Again.")
)
;; object type is OK, see if it has a string
((and (setq elst (entget (car ent)))
(/= (type (setq txt_str (cdr (assoc 1 elst)))) 'STR))
(princ "\n*-> No String Found, Try Again.")
)
;; got a string, check if pattern matches
((not (or (and case (wcmatch txt_str pattern))
(and (not case) (wcmatch (strcase txt_str) (strcase pattern)))))
(princ "\nNo string pattern match. Try again.")
)
(t nil) ; exit loop
) ; cond
) ; while
)
)
)
nil ; error so return nil
(list txt_str (car ent))
)
)(defun c:test (/ wc msg ret)
(setq wc "*ABC*")
(setq msg (strcat "\nGet any string which matches "
wc
" wild card pattern: "
)
)
(setq ret (StringSel wc ; string Wild Card pattern
t ; t = honor case in string else match any case
t ; t = allow entities within blocks
msg ; string - select message
nil ; list pf types '("TEXT" "MTEXT") or pattern "*TEXT"
))
ret
)
<edit: changed return value>
-
Doesn't is suck when you do something over the top and nobody replies? Nice one... :kewl:
-
my last version, for Challenge in France forum :-)
(defun str->list (s)
;|
by ElpanovEvgeniy
(13/10/2007 a 11:42)
for forum Challenge
http://www.cadxp.com/XForum+viewthread-fid-101-tid-16943-page-2.html
Example:
(str->list "point.25.4cm.");=> ("point." 25.4 "cm.")
(str->list "point.25,4cm.");=> ("point." 25.4 "cm.")
(str->list "point.3/8cm.");=> ("point." 0.375 "cm.")
(str->list "qvf12qsdf125 5sf 56dfv2");=> ("qvf" 12 "qsdf" 125 " " 5 "sf " 56 "dfv" 2)
|;
(defun str->list1 (a b f)
(cond
((null b)
(list (if f
(cond ((vl-position 46 a) (atof (vl-list->string (reverse a))))
((vl-position 47 a) (distof (vl-list->string (reverse a))))
((vl-position 44 a) (atof (vl-list->string (subst 46 44 (reverse a)))))
(t (atoi (vl-list->string (reverse a))))
) ;_ cond
(vl-list->string (reverse a))
) ;_ if
) ;_ list
)
(f
(if (or (= (car b) 44) (< 45 (car b) 58))
(str->list1 (cons (car b) a) (cdr b) f)
(cons (cond ((vl-position 46 a) (atof (vl-list->string (reverse a))))
((vl-position 47 a) (distof (vl-list->string (reverse a))))
((vl-position 44 a) (atof (vl-list->string (subst 46 44 (reverse a)))))
(t (atoi (vl-list->string (reverse a))))
) ;_ cond
(str->list1 (list (car b)) (cdr b) nil)
) ;_ cons
) ;_ if
)
(t
(if (< 47 (car b) 58)
(cons (vl-list->string (reverse a)) (str->list1 (list (car b)) (cdr b) t))
(str->list1 (cons (car b) a) (cdr b) nil)
) ;_ if
)
) ;_ cond
) ;_ defun
(setq s (vl-string->list s))
(str->list1 (list (car s))
(cdr s)
(if (or (= (car s) 44) (< 45 (car s) 58))
t
) ;_ if
)
)
-
Doesn't is suck when you do something over the top and nobody replies? Nice one... :kewl:
Thanks Ron :-)
-
Nice code Evgeniy 8-)