Topic: Recursion help string->list

[VovKa]

my try
char by char recursion, no vl-

Code: [Select]

(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

[daron]

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.

[CAB]

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.

[daron]

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.

Code: [Select]

(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))
   )
)

[CAB]

Here is my "Over The top" version.
Will get text from attributes dims, etc.

Code: [Select]

;;  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))
  )
)

Code: [Select]

(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>

[ronjonp]

Doesn't is suck when you do something over the top and nobody replies? Nice one... :kewl:

[ElpanovEvgeniy]

my last version, for Challenge in France forum 

Code: [Select]

(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
 )
)

[CAB]

Doesn't is suck when you do something over the top and nobody replies? Nice one... :kewl:

Thanks Ron

[CAB]

Nice code Evgeniy