Topic: adding an item to lists w/in a list

[daron]

If you were to work through each function  below, you'd be able to take a selection set of text objects, create a list containing lists with vla-objects and their insertionPoints. Then, sortXvalueRight would take that list and sort them by their x value from left to right / top to bottom. Something like that. Anyway, all that works right now. The next step is where I'm pulling out my hair. The codedlists procedure in theory (mine anyway), should attach a value to each of these lists once again, so one item in the list should look something like this: ((10384.7 6901.37 0.0) #<VLA-OBJECT IAcadText 04bf2fb4> 1). What I get is 10384.7. A whole list of the caar of each item. I've tried list, append, cons, vl-list*. I get a neat array of lists when testing it manually, but the same list of single coordinates when executing the code. Please, will someone shed some light on what I'm not doing right? Thank you.

Code: [Select]


(defun c:createnewlist (/ seltext)
     (setq seltext   (ss-vla-list (ssget '((0 . "TEXT"))))
 ;select block of text objects to sort that are aligned in x and y coords
  codelists (codedlists
 (sortXvalueRight (Coord-obj-list seltext))
    )
     )
)

(defun coord-obj-list (selectionset)
 (mapcar '(lambda
(x)
   (setq
inspt
    (vlax-safearray->list
 (vlax-variant-value
      (vla-get-InsertionPoint
   x
      )
 )
    )
   )
   (list inspt x)
  )
 selectionset
 ) ;appends insertion points to each vla-object
     )

(defun sortXvalueRight (obj-list)
 (vl-sort
obj-list
(function
     (lambda (e1 e2) (<= (caar e1) (caar e2)))
)
   )
     )
     

     (defun codedlists (xsortedlist)
 (mapcar '(lambda (x)
 (cond ((eq x (nth 0 xsortedlist))
(append (list 1) x)
(setq int 1)
)
((= (caar x) preval)
(append (list int) x)
)
(t
(princ (vla-get-textstring
 (cadr x)
)
)
(initget 6)
(setq int (getint
"\nSelect integer 2-x for item represented: "
  )
)
(append (list int) x)
)
 )
 (setq preval (caar x))
    )
   xsortedlist
   
     )


(defun ss-vla-list (selset / ename ax-list)
 ;define function (arguments / local vars)
     (cond
 ((= (type selset) 'PICKSET)
 ;ensures the argument selset is usable by the ssname function
  (while (setq ename (ssname selset 0))
 ;while there are entity names in selset
(setq ax-list
 (append
      ax-list
 ;append each item in the list to each other
      (list (vlax-ename->vla-object ename))
 ;after converting them to ActiveX objects
 )
)
(ssdel (ssname selset 0) selset)
 ;ssdel will take selset and remove the first item in the list
  )
 )
 (t
  (princ
"\nArgument passed to this function was not of TYPE, PICKSET.\nResetting variables."
  )
  (setq ax-list nil)
 )
     )
 ;while continues until ename variable equals nil
     ax-list
 ;ax-list is the return value. If it weren't there ss-v
la-list would
 ;return nil and any program accessing it would error out.
)



*edited. Found extra closing parens after each append. Fixed. Problem still exists, though.

[daron]

Figured it out. Here's a snippet for the solution:
(setq nextlist (append nextlist (list (cons x int))))

[CAB]

You had a couple of extra parentheses in the codedlists function and
although i don't understand what it does but the last return value is what
Mapcar is collecting to be returned. So you can't put (setq preval (caar x))
at the end.

Code: [Select]

(defun c:createnewlist (/ seltext)
  (setq seltext   (ss-vla-list (ssget '((0 . "TEXT"))))
 ;select block of text objects to sort that are aligned in x and y coords
        codelists (codedlists
                    (sortxvalueright (coord-obj-list seltext))
                  )
  )
)

(defun coord-obj-list (selectionset)
  (mapcar '(lambda
             (x)
              (setq
                inspt
                 (vlax-safearray->list
                   (vlax-variant-value
                     (vla-get-insertionpoint
                       x
                     )
                   )
                 )
              )
              (list inspt x)
           )
          selectionset
  ) ;appends insertion points to each vla-object
)

(defun sortxvalueright (obj-list)
  (vl-sort
    obj-list
    (function
      (lambda (e1 e2) (<= (caar e1) (caar e2)))
    )
  )
)

;;;=========================================================
(defun codedlists (xsortedlist)
  (mapcar '(lambda (x)
             (cond
               ((eq x (nth 0 xsortedlist))
                (setq int 1)
                (setq preval (caar x))
                (append x (list 1)) ; ) <=============<<<
               )
               ((= (caar x) preval)
                (setq preval (caar x))
                (append x (list int)) ; ) <==============<<<
               )
               (t
                (setq preval (caar x))
                (princ (vla-get-textstring (cadr x)))
                (initget 6)
                (setq int (getint "\nSelect integer 2-x for item represented: "))
                (append x (list int)) ; ) <==============<<<
               )
             )
           ) ; lambda
          xsortedlist
  ) ; mapcar
)

;;;=========================================================

(defun ss-vla-list (selset / ename ax-list)
 ;define function (arguments / local vars)
  (cond
    ((= (type selset) 'pickset)
 ;ensures the argument selset is usable by the ssname function
     (while (setq ename (ssname selset 0))
 ;while there are entity names in selset
       (setq ax-list
              (append
                ax-list
 ;append each item in the list to each other
                (list (vlax-ename->vla-object ename))
 ;after converting them to ActiveX objects
              )
       )
       (ssdel (ssname selset 0) selset)
 ;ssdel will take selset and remove the first item in the list
     )
    )
    (t
     (princ
       "\nArgument passed to this function was not of TYPE, PICKSET.\nResetting variables."
     )
     (setq ax-list nil)
    )
  )
 ;while continues until ename variable equals nil
  ax-list
 ;ax-list is the return value. If it weren't there ss-v la-list would
 ;return nil and any program accessing it would error out.
)

[daron]

What it's doing is this:

Code: [Select]

((5 . "last text here") (3 . "this item here") (2 . "another item here") (1 . "remaining item") (5 . "another list and more text") (3 . "last element in this list of five, but not entire block"))
Now, I've an idea and I'd love some collaborative help. Shouldn't be too difficult, but my brain is fried from all the above today.

Using the above list and setting it to a variable, I've pulled out all car values and sorted them >, like so:

Code: [Select]

(setq sortlist (vl-sort (mapcar 'car format) '>))

What I want to now achieve is this:
convert the main list, using sortlist as a compare test, place each element in a list from (in this case) 5-1. Where there are no elements that match, i.e. 4, leave it blank and prepend it with a comma, so it looks something like:

(("remaining item,another item here,this item here,,last text here")
(",,,last element in this list of five but not entire block,,another list and more text"))

Notice, the number 5 element is last and number 1 is first and each block of 5-1 is placed in its own list within the list.

Anybody interested in throwing something together for me, or if you have any other ways to achieve the same results, would you mind putting something together and posting it? Much appreciated. Thanks.

[CAB]

This does not consider more that 2 matching prefixes, i.e.  (2 . "A") (2 . "B") (2 ."C")

Code: [Select]

(defun c:sortlst (/ lst1)
  (setq lst1 '((5 . "A")
               (3 . "B")
               (2 . "C")
               (1 . "D")
               (5 . "*E")
               (3 . "*F")
              )
  )

  (defun mysort (lst func)
    (mapcar '(lambda (x) (nth x lst)) (vl-sort-i lst func))
  )

  (setq lst2 (mysort lst1  (function (lambda (e1 e2)
                         (< (car e1) (car e2)) ) )))
  (setq idx 0
        str1 ""
        str2 "")
  (while (and idx (< idx (length lst2)))
    (IF (/= idx 0)
      (setq str1 (strcat str1 ",")
            str2 (strcat str2 ",")
            )
      )
    (cond
      ((= idx (1- (length lst2))); last item in list
       (setq str1 (strcat str1 (cadr (nth idx lst2)))
             str2 (strcat str2 "X")
             idx nil)
       )
      ;; does item match next item
      ((= (car (nth idx lst2))(car (nth (1+ idx) lst2)))
       (setq str1 (strcat str1 "," (cdr (nth (1+ idx) lst2))))
       (setq str2 (strcat str2 (cdr (nth idx lst2))","))
       (setq idx (+ idx 2)); skip
       )
      (T ; no match so add item to string
       (setq str1 (strcat str1 (cdr (nth idx lst2)) ))
       ;;(setq str2 (strcat str2 "X"))
       (setq idx (1+ idx)); next
      )
    )
  )
 
(list (list str1)(list str2))
)