Author Topic: Lisp to replace Dataextraction  (Read 9164 times)

0 Members and 1 Guest are viewing this topic.

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: Lisp to replace Dataextraction
« Reply #15 on: September 25, 2016, 03:44:14 AM »
I think OP wants single item from every group of massoc of initial list with last number summed and converted into string...

My suggestion :
Code: [Select]
(defun summassoclasts ( l / removenth massoc groupbycar i ll )

  (defun removenth ( n l / k ll )
    (setq k -1)
    (foreach i l
      (setq k (1+ k))
      (if (/= k n)
        (setq ll (cons i ll))
      )
    )
    (reverse ll)
  )

  (defun massoc ( key lst / i nlst )
    (while (setq i (assoc key lst))
      (setq nlst (cons i nlst))
      (setq lst (removenth (vl-position i lst) lst))
    )
    (reverse nlst)
  )

  (defun groupbycar ( l / i ll lll )
    (while (setq i (car l))
      (setq ll (massoc (car i) l))
      (foreach ii ll
        (setq l (removenth (vl-position ii l) l))
      )
      (setq lll (cons ll lll))
    )
    (reverse lll)
  )

  (foreach g (groupbycar l)
    (setq i (car g))
    (setq i (reverse (cons (rtos (apply '+ (mapcar 'atof (mapcar 'last g)))) (cdr (reverse i)))))
    (setq ll (cons i ll))
  )
  (reverse ll)
)

Of course not tested...
M.R.
« Last Edit: September 25, 2016, 07:55:43 AM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

kdub_nz

  • Mesozoic keyThumper
  • SuperMod
  • Water Moccasin
  • Posts: 2121
  • class keyThumper<T>:ILazy<T>
Re: Lisp to replace Dataextraction
« Reply #16 on: September 25, 2016, 03:46:08 AM »
Thanks Tim,
I see what he wants now :)
Called Kerry in my other life
Retired; but they dragged me back in !

I live at UTC + 13.00

---
some people complain about loading the dishwasher.
Sometimes the question is more important than the answer.

T.Willey

  • Needs a day job
  • Posts: 5251
Re: Lisp to replace Dataextraction
« Reply #17 on: September 25, 2016, 03:56:43 AM »
Thanks Tim,
I see what he wants now :)

My pleasure, Kerry.
Tim

I don't want to ' end-up ', I want to ' become '. - Me

Please think about donating if this post helped you.

Red Nova

  • Newt
  • Posts: 69
Re: Lisp to replace Dataextraction
« Reply #18 on: September 25, 2016, 09:10:33 AM »
Thank you Gens.

Tim, your solution works like magic ։). I only added 2 2 to rtos for decimal. Luckily I learned about it yesterday  ^-^
And thanks for distof. Will note that.

ribarm Your version returned the same initial list.

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: Lisp to replace Dataextraction
« Reply #19 on: September 25, 2016, 09:43:09 AM »
ribarm Your version returned the same initial list.

With all your respect, although I haven't tested it before, now I did... Conclusion : "You are laying..."

Code: [Select]
;;; (setq l '(("1" "#5" "19" "225") ("1" "#5" "19" "463") ("1" "#5" "19" "1164.75") ("2" "#5" "19" "2653.75") ("2" "#5" "19" "585") ("3" "#5" "19" "2653.75") ("3" "#5" "19" "585") ("3" "#5" "19" "227.5")))

;;; (summassoclasts l) => (("1" "#5" "19" "1852.75000000") ("2" "#5" "19" "3238.75000000") ("3" "#5" "19" "3466.25000000"))
« Last Edit: September 25, 2016, 11:10:07 AM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

Red Nova

  • Newt
  • Posts: 69
Re: Lisp to replace Dataextraction
« Reply #20 on: September 25, 2016, 10:15:49 AM »
Your conclusion should be that I am such a dummy with lisp that I was testing it a wrong way. ;-) I can sometimes be frustrated about simplest things with lisp  :grumpy:

In any case I kinda mislead all of you and myself. Since I understood that besides first value of list element I need to compare also second and third values, since some of them might also vary from time to time. So I need to proceed summing last numbers for each first value only in case if I have a match between second and third elements. And if there is a mismatch on the road I need new summing of last numbers to be done and a separate list member to be added in the output.
 
For example for a list like this:

(("1" "#5" "19" "225") ("1" "#7" "19" "560") ("1" "#5" "19" "463") ("1" "#7" "19" "755") ("1" "#5" "19" "1164.75") ("2" "#5" "19" "2653.75") ("2" "#5" "19" "585") ("2" "#5" "16" "153.75") ("3" "#5" "19" "2653.75") ("3" "#5" "19" "585") ("3" "#5" "19" "227.5"))

I need to receive this:
(("1" "#5" "19" "1852.75") ("1" "#7" "19" "1315") ("2" "#5" "19" "3238,75") ("2" "#5" "16" "153.75") ("3" "#5" "19" "3466.25"))

I will try to play with your lisps and will see how long it will take me till I finally realize that I am stuck again  :-)

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: Lisp to replace Dataextraction
« Reply #21 on: September 25, 2016, 10:46:25 AM »
Code: [Select]
(defun summassoclasts ( l / removenth 3keyassoc massoc groupby3keys i ll )

  (defun removenth ( n l / k ll )
    (setq k -1)
    (foreach i l
      (setq k (1+ k))
      (if (/= k n)
        (setq ll (cons i ll))
      )
    )
    (reverse ll)
  )

  (defun 3keyassoc ( 3keylst lst / i )
    (vl-some '(lambda ( x ) (if (and (= (car x) (car 3keylst)) (= (cadr x) (cadr 3keylst)) (= (caddr x) (caddr 3keylst))) (setq i x))) lst)
    i
  )

  (defun massoc ( 3keylst lst / i nlst )
    (while (setq i (3keyassoc 3keylst lst))
      (setq nlst (cons i nlst))
      (setq lst (removenth (vl-position i lst) lst))
    )
    (reverse nlst)
  )

  (defun groupby3keys ( l / i ll lll )
    (while (setq i (car l))
      (setq ll (massoc (list (car i) (cadr i) (caddr i)) l))
      (foreach ii ll
        (setq l (removenth (vl-position ii l) l))
      )
      (setq lll (cons ll lll))
    )
    (reverse lll)
  )

  (foreach g (groupby3keys l)
    (setq i (car g))
    (setq i (reverse (cons (rtos (apply '+ (mapcar 'atof (mapcar 'last g)))) (cdr (reverse i)))))
    (setq ll (cons i ll))
  )
  (reverse ll)
)

Code: [Select]
;;; (setq l '(("1" "#5" "19" "225") ("1" "#7" "19" "560") ("1" "#5" "19" "463") ("1" "#7" "19" "755") ("1" "#5" "19" "1164.75") ("2" "#5" "19" "2653.75") ("2" "#5" "19" "585") ("2" "#5" "16" "153.75") ("3" "#5" "19" "2653.75") ("3" "#5" "19" "585") ("3" "#5" "19" "227.5")))

;;; (summassoclasts l) => (("1" "#5" "19" "1852.75000000") ("1" "#7" "19" "1315.00000000") ("2" "#5" "19"  "3238.75000000") ("2" "#5" "16" "153.75000000") ("3" "#5" "19" "3466.25000000"))
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

Lee Mac

  • Seagull
  • Posts: 12905
  • London, England
Re: Lisp to replace Dataextraction
« Reply #22 on: September 25, 2016, 10:55:05 AM »
Here's another way:
Code - Auto/Visual Lisp: [Select]
  1. (defun mergelist ( l / a r x )
  2.     (foreach x l
  3.         (if (setq x (cons (list (car x) (cadr x) (caddr x)) (distof (last x)))
  4.                   a (vl-some '(lambda ( y ) (if (vl-every '= (car x) (car y)) y)) r)
  5.             )
  6.             (setq r (subst (cons (car a) (+ (cdr a) (cdr x))) a r))
  7.             (setq r (cons x r))
  8.         )
  9.     )
  10.     (reverse (mapcar '(lambda ( x ) (reverse (cons (rtos (cdr x)) (reverse (car x))))) r))
  11. )

Red Nova

  • Newt
  • Posts: 69
Re: Lisp to replace Dataextraction
« Reply #23 on: September 25, 2016, 11:28:41 AM »
Marco and Lee Mac. Thank you so much. You are too generous.
By the way, Lee Mac, I am using your function LM:AddTable to write list into table. It is very useful for amateurs like me. It is aligning width of all the columns to the widest content of any column. Sometimes it is the best, but sometimes, if you have one column with content significantly wider than the others, this is not the best choice and I would rather have them all with a unique width in accordance to the width if it's content. Do you have this kind of modification of LM:AddTable?

Lee Mac

  • Seagull
  • Posts: 12905
  • London, England
Re: Lisp to replace Dataextraction
« Reply #24 on: September 25, 2016, 12:07:36 PM »
By the way, Lee Mac, I am using your function LM:AddTable to write list into table. It is very useful for amateurs like me. It is aligning width of all the columns to the widest content of any column. Sometimes it is the best, but sometimes, if you have one column with content significantly wider than the others, this is not the best choice and I would rather have them all with a unique width in accordance to the width if it's content. Do you have this kind of modification of LM:AddTable?

You may refer to the LM:addtable function as part of my Polyline Information program; call this function with a null last argument for non-equal column widths.

Lee Mac

  • Seagull
  • Posts: 12905
  • London, England
Re: Lisp to replace Dataextraction
« Reply #25 on: September 25, 2016, 12:18:53 PM »
Just for fun, a recursive variation of the mergelist function above:
Code - Auto/Visual Lisp: [Select]
  1. (defun mergelist ( l / k v x )
  2.     (if (setq x (car l))
  3.         (progn
  4.             (setq k (reverse (cdr (reverse x)))
  5.                   v (distof (last x))
  6.                   l (vl-remove-if '(lambda ( y ) (if (vl-every '= k y) (setq v (+ v (distof (last y)))))) (cdr l))
  7.             )
  8.             (cons (append k (list (rtos v))) (mergelist l))
  9.         )
  10.     )
  11. )

Red Nova

  • Newt
  • Posts: 69
Re: Lisp to replace Dataextraction
« Reply #26 on: September 25, 2016, 01:48:28 PM »
Lee Mac, Thanks, but I have an issue with it. As I understood LM:addtable from Polyline Information command is a later version compared to what I was using. Mine was taken from CountAttributeValues.

Code - Auto/Visual Lisp: [Select]
  1. ;;---------------------=={ Add Table }==----------------------;;
  2. ;;                                                            ;;
  3. ;;  Creates a VLA Table Object at the specified point,        ;;
  4. ;;  populated with title and data                             ;;
  5. ;;------------------------------------------------------------;;
  6. ;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
  7. ;;------------------------------------------------------------;;
  8. ;;  Arguments:                                                ;;
  9. ;;  space - VLA Block Object                                  ;;
  10. ;;  pt    - Insertion Point for Table                         ;;
  11. ;;  title - Table title                                       ;;
  12. ;;  data  - List of data to populate the table                ;;
  13. ;;------------------------------------------------------------;;
  14. ;;  Returns:  VLA Table Object                                ;;
  15. ;;------------------------------------------------------------;;
  16.  
  17. (defun LM:AddTable ( space pt title data / _itemp ) (vl-load-com)
  18.  
  19.   (defun _itemp ( collection item )
  20.     (if
  21.       (not
  22.           (setq item
  23.             (vl-catch-all-apply 'vla-item (list collection item))
  24.           )
  25.         )
  26.       )
  27.       item
  28.     )
  29.   )
  30.  
  31.   (
  32.     (lambda ( table ) (vla-put-StyleName table (getvar 'CTABLESTYLE)) (vla-SetText table 0 0 title)
  33.       (
  34.         (lambda ( row )
  35.           (mapcar
  36.             (function
  37.               (lambda ( rowitem ) (setq row (1+ row))
  38.                 (
  39.                   (lambda ( column )
  40.                     (mapcar
  41.                       (function
  42.                         (lambda ( item )
  43.                           (vla-SetText table row
  44.                             (setq column (1+ column)) item
  45.                           )
  46.                         )
  47.                       )
  48.                       rowitem
  49.                     )
  50.                   )
  51.                   -1
  52.                 )
  53.               )
  54.             )
  55.             data
  56.           )
  57.         )
  58.         0
  59.       )
  60.       table
  61.     )
  62.     (
  63.       (lambda ( textheight )
  64.         (vla-AddTable space (vlax-3D-point pt) (1+ (length data)) (length (car data)) (* 1.8 textheight)
  65.           (* textheight
  66.             (apply 'max
  67.               (cons (/ (strlen title) (length (car data)))
  68.                 (mapcar 'strlen (apply 'append data))
  69.               )
  70.             )
  71.           )
  72.         )
  73.       )
  74.       (vla-getTextHeight
  75.         (_itemp
  76.           (_itemp
  77.             (vla-get-Dictionaries
  78.             )
  79.             "ACAD_TABLESTYLE"
  80.           )
  81.           (getvar 'CTABLESTYLE)
  82.         )
  83.         acDataRow
  84.       )
  85.     )
  86.   )
  87. )

As I work with annotative scales I added a small and simple modification to your code, so the table would be scaled after it's insertion in accordance to the current annotative scale of the space.
In fact I added only two lines
  (setq tablescale (/ 1 (getvar 'CANNOSCALEVALUE)))
  (command "_scale" "L" "" pt tablescale)

My version was:

Code - Auto/Visual Lisp: [Select]
  1. (defun LM:AddTable ( space pt title data / _itemp tablescale) (vl-load-com)
  2.  
  3.   (defun _itemp ( collection item )
  4.     (if
  5.       (not
  6.           (setq item
  7.             (vl-catch-all-apply 'vla-item (list collection item))
  8.           )
  9.         )
  10.       )
  11.       item
  12.     )
  13.   )
  14.    
  15.   (
  16.     (lambda ( table ) (vla-put-StyleName table (getvar 'CTABLESTYLE)) (vla-SetText table 0 0 title)
  17.       (
  18.         (lambda ( row )
  19.           (mapcar
  20.             (function
  21.               (lambda ( rowitem ) (setq row (1+ row))
  22.                 (
  23.                   (lambda ( column )
  24.                     (mapcar
  25.                       (function
  26.                         (lambda ( item )
  27.                           (vla-SetText table row
  28.                             (setq column (1+ column)) item
  29.                           )
  30.                         )
  31.                       )
  32.                       rowitem
  33.                     )
  34.                   )
  35.                   -1
  36.                 )
  37.               )
  38.             )
  39.             data
  40.           )
  41.         )
  42.         0
  43.       )
  44.       table
  45.     )
  46.     (
  47.       (lambda ( textheight )
  48.         (vla-AddTable space (vlax-3D-point pt) (1+ (length data)) (length (car data)) (* 1.8 textheight)
  49.           (* textheight
  50.             (apply 'max
  51.               (cons (/ (strlen title) (length (car data)))
  52.                 (mapcar 'strlen (apply 'append data))
  53.               )
  54.             )
  55.           )
  56.         )
  57.       )
  58.       (vla-getTextHeight
  59.         (_itemp
  60.           (_itemp
  61.             (vla-get-Dictionaries
  62.             )
  63.             "ACAD_TABLESTYLE"
  64.           )
  65.           (getvar 'CTABLESTYLE)
  66.         )
  67.         acDataRow
  68.       )
  69.     )
  70.   )
  71.   (setq tablescale (/ 1 (getvar 'CANNOSCALEVALUE))) ; adding ability to scale the inserted object based on annotative scale
  72.   (command "_scale" "L" "" pt tablescale)           ; scaling
  73. )

As I see you added some support for annotative scale. But when I insert a table in a scale different from 1:1, I have a situation, when the table itself is scaled, but text remains small as it would be for 1:1 scale. Any suggestion?

Red Nova

  • Newt
  • Posts: 69
Re: Lisp to replace Dataextraction
« Reply #27 on: October 02, 2016, 11:38:15 AM »
Hello. I am stuck and back again. :)

Could you help me to subtract two lists like these:
 
(setq lstA '(("1" "57") ("2" "69") ("3" "89") ("4" "95") ("5" "89") ("6" "82") ("B" "49")))
(setq lstB '(("1" "53") ("3" "42") ("B" "22")))

Need to subtract  each second element of sublists, if first elements are matching.

Expected sample result:
'(("1" "4") ("2" "69") ("3" "47") ("4" "95") ("5" "89") ("6" "82") ("B" "27")


Lee Mac

  • Seagull
  • Posts: 12905
  • London, England
Re: Lisp to replace Dataextraction
« Reply #28 on: October 02, 2016, 01:02:13 PM »
Assuming unique keys in lstB:
Code - Auto/Visual Lisp: [Select]
  1. (defun f ( a b / c )
  2.     (if a
  3.         (if (setq c (assoc (caar a) b))
  4.             (cons (list (caar a) (rtos (- (distof (cadar a)) (distof (cadr c))))) (f (cdr a) b))
  5.             (cons (car a) (f (cdr a) b))
  6.         )
  7.     )
  8. )
Code - Auto/Visual Lisp: [Select]
  1. (f lsta lstb)
« Last Edit: October 02, 2016, 02:29:28 PM by Lee Mac »

Lee Mac

  • Seagull
  • Posts: 12905
  • London, England
Re: Lisp to replace Dataextraction
« Reply #29 on: October 02, 2016, 01:04:13 PM »
Or alternatively, assuming unique keys in lstA:
Code - Auto/Visual Lisp: [Select]
  1. (defun g ( a b / y )
  2.     (foreach x b
  3.         (if (setq y (assoc (car x) a))
  4.             (setq a (subst (list (car x) (rtos (- (distof (cadr y)) (distof (cadr x))))) y a))
  5.         )
  6.     )
  7.     a
  8. )
Code - Auto/Visual Lisp: [Select]
  1. (g lsta lstb)
« Last Edit: October 02, 2016, 02:30:03 PM by Lee Mac »