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

0 Members and 1 Guest are viewing this topic.

Red Nova

  • Newt
  • Posts: 69
Lisp to replace Dataextraction
« on: September 21, 2016, 10:53:04 PM »
Hello,

I am searching for a lisp code to replace the standard Data Extraction, which I find too glitchy and slow.
I found a few codes similar in the network, 2 of them by Lee Mac (CountAttributeValues and SumAttributeValues).
However, none of the codes I found is capable to fit my needs.
I am attaching samples of tables I have created with dataextraction (exploded afterwards). My blocks have many attributes and CountAttributeValues does not let me filter out ones I don't need. Also I need more columns to display other attributes.

First I need to select all blocks with name "Slab" in the drawing. Since I have many floors, and then floors are divided by Bays, I have tags FLOOR and BAY in each "Slab" block to use as a filter.
From all the blocks named "Slab" I filter blocks that have FLOOR attribute set to the floor I am preparing the table for (1,2,3,R,B, ... etc.).
After this rows are grouped by BAY attribute (1a, 1b, 1c, 2a, 2b, 2c ... etc.)
Then I list values for a few other attributes, that are constant for each bay (GAUGE, LENGTH, REBAR).
Similar calculation is done for each floor.
After this I prepare two other tables which are also presented in the attached file.
All the tables are inserted as AutoCAD tables in the drawing (usually 1:1 scale, on the layout).
Would much appreciate any feedback.

T.Willey

  • Needs a day job
  • Posts: 5251
Re: Lisp to replace Dataextraction
« Reply #1 on: September 22, 2016, 01:15:26 AM »
Are you looking to hire someone to do the code for you?
or
Are you looking to start the program (yourself) and only came here for help with certain parts of the code you are having trouble with?

Welcome to theSwamp.
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 #2 on: September 22, 2016, 08:56:51 AM »
I am looking for a program that is a bit more similar to what I need than ones I found from Lee Mac. I am capable to do some very basic programming with Lisp, so I would be able to modify one that is close enough. If I will not find anything closer than CountAttributeValues I will try to start with it. There will be a few difficulties for me on the way for sure. So if someone could share something more similar that would be a lot of help.

Grrr1337

  • Swamp Rat
  • Posts: 812
Re: Lisp to replace Dataextraction
« Reply #3 on: September 22, 2016, 01:48:07 PM »
I'm sure you'd recieve alot more help if you just write down the steps for the program to operate.
(apply ''((a b c)(a b c))
  '(
    (( f L ) (apply 'strcat (f L)))
    (( L ) (if L (cons (chr (car L)) (f (cdr L)))))
    (72 101 108 108 111 32 87 111 114 108 100)
  )
)
vevo.bg

Red Nova

  • Newt
  • Posts: 69
Re: Lisp to replace Dataextraction
« Reply #4 on: September 22, 2016, 03:55:11 PM »
You mean to describe program's logic as I imagine it? If the first post was not clear I will try once again.
I am using naming of blocks and attributes as in my file, though they are not important of coarse.
Ideally after running the command it should request user to input the FLOOR, for which the slab table will be created.
After this it should grab from the drawing only blocks called "SLAB" which have attribute "FLOOR" set to defined value.
Then it should search in the selected blocks for an attribute called "BAY", and count quantity of each "BAY" (Bays can be named as: 1a, 1b,1c ... 2a, 2b, 2c ... etc).
Then, for each BAY, it should get attributes called "LENGTH","REBAR","GAUGE" and simply add them to the list. After all information is collected a table is inserted in the drawing.
Sample content of the table is below

      Slab Table, Floor 1      
Floor    Bay   Qty Length Rebar Gauge
    1     1a     5   12' 3"    #5       19
    1     1b     3   10' 0"    #5       19
    1     1c     7   15' 5"    #5       19
    1     2a     5   12' 3"    #5       19
    1     2b     2   10' 0"    #5       19



T.Willey

  • Needs a day job
  • Posts: 5251
Re: Lisp to replace Dataextraction
« Reply #5 on: September 23, 2016, 02:30:16 AM »
I don't deal with attribute extraction in the CAD work, so I don't have anything to share in that regard.  But, when you shows us where you are stuck in your code then maybe I could help.
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 #6 on: September 23, 2016, 09:24:13 AM »
OK, thanks.
In fact I found one more interesting code called LSTATT by Patrick_35. And now I have it and ones from Lee Mac to start with. Will try it.

Red Nova

  • Newt
  • Posts: 69
Re: Lisp to replace Dataextraction
« Reply #7 on: September 23, 2016, 11:34:12 PM »
I finally stuck so I am back :). Though, considering my amateur level in programming I am surprised that I made it that far.
I reworked lisp from Patrick_35 and now I almost have what I need for first table. At the moment I decided to prepare one table for all floors, later one I might divide it and add a filter for floor.
Below is my code. And attached is the file I test with and an output table that I managed to create.
In fact this is a table that I need, the only issue is that elements in it are not sorted.
Now it looks like this:
Comslab Table                   
Floor    Bay   Quantity   Length   Rebar   Gauge
3   2e   11   20'-1 1/4"   #5   19
3   2d   5   9'-9"   #5   19
3   2c   2   9'-5 3/4"   #5   19
3   1f   3   22'-0 1/2"   #5   19
3   1e   11   20'-10 1/4"   #5   19
3   1d   4   9'-4 1/2"   #5   19
3   1d   1   9'-4 3/4"   #5   19
3   1c   2   9'-1 1/4"   #5   19
2   2e   11   20'-1 1/4"   #5   19
2   2d   5   9'-9"   #5   19
2   2c   2   9'-5 3/4"   #5   19
2   1f   3   22'-0 1/2"   #5   19
2   1e   11   20'-10 1/4"   #5   19
2   1d   4   9'-4 1/2"   #5   19
2   1d   1   9'-4 3/4"   #5   19
2   1c   2   9'-1 1/4"   #5   19
2   2b   4   18'-4"   #5   19
2   1b   4   14'-2 1/4"   #5   19
2   2a   11   20'-1 1/4"   #5   19
2   1a   11   20'-10 1/4"   #5   19
1   1d   4   4'-8 1/4"   #5   19
1   1c   4   9'-7 3/4"   #5   19
1   1b   3   32'-4 1/4"   #5   19
1   1a   4   18'-2 3/4"   #5   19

But I need it to be sorted first by Floor (1,2,3...) and then in each flor by bay (1a,1b,1c,2a,2b,2c...)
Any idea?


Quote
(defun c:rn_lstatt (/ choix doc i js ent fic fil lab lst mrc trc n nb nm nombl InputBox liste_att mrech rechercher_nom s sel tbl trier txt *errlst*)

  (defun *errlst* (msg)
    (or (member (strcase msg) '("FUNCTION CANCELLED" ""QUIT / EXIT ABORT"" "FONCTION ANNULEE" "QUITTER / SORTIR ABANDON"))
      (princ (strcat "\nErreur : " msg))
    )
    (setq *error* s)
    (princ)
  )

  (defun nombl(bl)
    (if (vlax-property-available-p bl 'effectivename)
      (vla-get-effectivename bl)
      (vla-get-name bl)
    )
  )

;  (defun choix(/ bl js lst nom sel)
;    (princ "\nSйlectionnez le(s) bloc(s) а dйnombrer : ")
;    (and (ssget (list (cons 0 "insert")))
;      (progn
;   (vlax-for bl (setq sel (vla-get-activeselectionset doc))
;     (or (member (setq nom (nombl bl)) lst)
;       (setq lst (cons nom lst))
;     )
;     (redraw (vlax-vla-object->ename bl) 4)
;   )
;   (foreach nom lst
;     (if js
;       (setq js (strcat js "," nom))
;       (setq js nom)
;     )
;   )
;   (vla-delete sel)
;      )
;    )
;    js
;  )

  (defun InputBox (Titre js / ch dcl fil res tmp txt)
;    (setq tmp (vl-filename-mktemp "lstatt" nil ".dcl")
;     fil (open tmp "w")
;    )
;    (foreach txt '(   "lstatt : dialog {"
;         "  key = \"titre\";"
;         "  alignment = centered;"
;         "  is_cancel = true;"
;         "  allow_accept = true;"
;         "  width = 30;"
;         "  : boxed_column {"
;         "    label = \"Veuillez donner un nom de bloc ou * pour tous\";"
;         "    : row {"
;         "      : edit_box {key = \"filtre\";width = 45;}"
;         "      : button {key = \"choix\"; label = \">>\";}"
;         "    }"
;         "    spacer;"
;         "  }"
;         "  : boxed_column {"
;         "    label = \"Nombre d'attributs а prendre en compte\"; "
;         "    : edit_box {key= \"att\";}"
;         "    spacer;"
;         "  }"
;         "  spacer;"
;         "  : toggle {key = \"fic\"; label = \"Ecrire les rйsultats dans un fichier\";}"
;         "  : toggle {key = \"lab\"; label = \"Ajouter le nom des йtiquettes dans les rйsultats\";}"
;         "  spacer;"
;         "  ok_cancel;"
;         "}"
;       )
;      (write-line txt fil)
;    )
;    (close fil)
;    (setq dcl (load_dialog tmp))
;    (while (not (member res '(0 1)))
;      (new_dialog "lstatt" dcl "")
;      (set_tile "titre" titre)
;      (set_tile "filtre" js)
;      (set_tile "att" nb)
;      (set_tile "fic" fic)
;      (set_tile "lab" lab)
;      (action_tile "filtre" "(setq js $value)")
;      (action_tile "choix"  "(done_dialog 2)")
;      (action_tile "att"    "(setq nb $value)")
;      (action_tile "fic"    "(setq fic $value)")
;      (action_tile "lab"    "(setq lab $value)")
;      (action_tile "accept" "(done_dialog 1)")
;      (action_tile "cancel" "(done_dialog 0)")
;      (setq res (start_dialog))
;      (and (eq res 2)
      (setq ch "Plan Slab")
      (setq js ch)
;      )
;    )
;    (unload_dialog dcl)
;    (vl-file-delete tmp)
;    (if (member res '(1 2))
;      js
;      ""
;    )
  )

  (defun liste_att(att / n lst val)
 ;   (if (< (atoi nb) (length att))
      (progn
   (setq n 0)
   (while (and (< n (atoi nb)) (setq val (nth n att)))
     (setq lst (cons (if (eq lab "0")
             (vla-get-textstring (nth n att))
             (strcat (vla-get-tagstring (nth n att)) ":" (vla-get-textstring (nth n att)))
           )
           lst
          )
      n (1+ n)
     )
   )
   (setq lst (reverse lst))

   (setq lst (remove-i 11 lst))
   (setq lst (remove-i 10 lst))
   (setq lst (remove-i 9 lst))
   (setq lst (remove-i 8 lst))
   (setq lst (remove-i 7 lst))
   (setq lst (remove-i 6 lst))
   (setq lst (remove-i 5 lst))
   (setq lst (remove-i 4 lst))
   (setq lst (remove-i 3 lst))
      )
;      (if (eq lab "0")
;        (mapcar 'vla-get-textstring att)
;   (mapcar '(lambda(x)(strcat (vla-get-tagstring x) ":" (vla-get-textstring x))) att)
;      )
;    )
  )

  (defun rechercher_nom(val / att nom tbl)
    (setq nom (nombl val))
    (if (eq (vla-get-hasattributes val) :vlax-true)
      (if (member (setq att (vlax-invoke val 'getattributes)) '(nil))
   (list nom)
   (cons nom (liste_att att))
      )
      (list nom)
    )
  )

;  (defun trier(a b / c n s)
;    (setq c 0)
;    (while (and (not s) (nth c a))
;      (if (eq (nth c a) (nth c b))
;   (setq c (1+ c))
;   (setq s T)
;      )
;    )
;    (or (nth c a) (setq c 0))
;    (< (strcase (nth c a)) (strcase (nth c b)))
;  )

  (defun mrech(bl / ent lst recu)
    (defun recu(bl)
      (vlax-for ent (vla-item (vla-get-blocks doc) (nombl bl))
   (and (eq (vla-get-objectname ent) "AcDbBlockReference")
     (if (eq (substr (nombl ent) 1 1) "*")
       (recu ent)
       (setq lst (cons ent lst))
     )
   )
      )
    )
    (and (eq (substr (nombl bl) 1 1) "*")
      (recu bl)
    )
    lst
  )
 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
  (vl-load-com)
  (setq s *error*
   *error* *errlst*
   doc (vla-get-activedocument (vlax-get-acad-object))
  )
  (setq nb "14"); set the limit of attributes needed to be collected from the block
  (setq lab "0"); set lab
  (setq fic "0")
  (if (not (eq (setq nm (InputBox "Dйcompte de blocs V4.21" "*")) ""))
    (progn
      (setq js (strcat "`**," nm))
      (if (ssget (list (cons 0 "INSERT") (cons 2 js)))
   (progn
     ;(setenv "Patrick_35_nb_att" nb)
     ;(setenv "Patrick_35_nb_lab" lab)
     (vlax-map-collection   (setq sel (vla-get-activeselectionset doc))
            '(lambda (x)
              (if (setq trc (mrech x))
                (foreach mrc trc
                  (if (wcmatch (strcase (car (setq js (rechercher_nom mrc)))) (strcase nm))
               (setq tbl (cons js tbl))
                  )
                )
                (if (wcmatch (strcase (car (setq js (rechercher_nom x)))) (strcase nm))
                  (if (eq (vla-get-objectname x) "AcDbMInsertBlock")
               (repeat (* (vla-get-columns x) (vla-get-rows x))
                 (setq tbl (cons js tbl))
               )
               (setq tbl (cons js tbl))
                  )
                )
              )
            )
     )
     (vla-delete sel)
     (while tbl   
       (setq n   (length tbl)
        js  (car tbl); js = ("Plan Slab" "2" "2d")
        tbl (vl-remove js tbl)
        lst (cons
         (rearragneslablist (remove-i 1 (cons (itoa (- n (length tbl))) js))) lst
         ); lst =(("1" "Plan Slab" "2" "2d"))
       )
     )

;printing into command line
;     (if lst
;       (progn
;         (and (eq fic "1")
;      (setq fil (open (setq txt (strcat (getvar "dwgprefix") (vl-filename-base (getvar "dwgname")) ".txt")) "w"))
;         )
;         (foreach n (vl-sort lst '(lambda (a b) (trier (cdr a) (cdr b))))
;      (if (eq fic "1")
;        (princ (strcat (car n) (chr 9) (cadr n)) fil)
;        (princ (strcat "\n"
;             (substr "     " 1 (- 5 (strlen (car n))))
;             (car n)
;             " "
;             (cadr n)
;          )
;        )
;      )
;      (setq i 2)
;      (while (setq val (nth i n))
;        (if (eq fic "1")
;          (princ (strcat (chr 9) val) fil)
;          (princ (strcat " " val));...
;        )
;        (setq i (1+ i))
;      )
;      (and (eq fic "1")
;        (write-line "" fil)
;      )
;         )
;         (and (eq fic "1")
;      (princ (strcat "\nFichier \"" txt "\" crйй."))
;      (close fil)
;         )
;       )
;       (princ "\nPas de bloc а dйnombrer.")
;     )
   )
      )
    )
  )
  (setq *error* s)
  (princ)

(setq space
            (vlax-get-property
              (setq doc
                (vla-get-ActiveDocument (vlax-get-acad-object))
              )
              (if (= 1 (getvar 'CVPORT)) 'Paperspace 'Modelspace)
            )
          )
 
(setq pt (getpoint "\nPick Point for Table: "))

(LM:AddTable space (trans pt 1 0) "Comslab Table"
        (cons '("Floor" "Bay" "Quantity" "Length" "Rebar" "Gauge") lst)

      )

 
)


;(setq nom_lisp "LSTATT")
;(if (/= app nil)
;  (if (= (strcase (substr app (1+ (- (strlen app) (strlen nom_lisp))) (strlen nom_lisp))) nom_lisp)
;    (princ (strcat "..." nom_lisp " chargй."))
;    (princ (strcat "\n" nom_lisp ".LSP Chargй.....Tapez " nom_lisp " pour l'йxecuter.")))
;  (princ (strcat "\n" nom_lisp ".LSP Chargй......Tapez " nom_lisp " pour l'йxecuter.")))
;(setq nom_lisp nil)
;(princ)



;;---------------------=={ Add Table }==----------------------;;
;;                                                            ;;
;;  Creates a VLA Table Object at the specified point,        ;;
;;  populated with title and data                             ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  space - VLA Block Object                                  ;;
;;  pt    - Insertion Point for Table                         ;;
;;  title - Table title                                       ;;
;;  data  - List of data to populate the table                ;;
;;------------------------------------------------------------;;
;;  Returns:  VLA Table Object                                ;;
;;------------------------------------------------------------;;

(defun LM:AddTable ( space pt title data / _itemp ) (vl-load-com)

  (defun _itemp ( collection item )
    (if
      (not
        (vl-catch-all-error-p
          (setq item
            (vl-catch-all-apply 'vla-item (list collection item))
          )
        )
      )
      item
    )
  )

  (
    (lambda ( table ) (vla-put-StyleName table (getvar 'CTABLESTYLE)) (vla-SetText table 0 0 title)
      (
        (lambda ( row )
          (mapcar
            (function
              (lambda ( rowitem ) (setq row (1+ row))
                (
                  (lambda ( column )
                    (mapcar
                      (function
                        (lambda ( item )
                          (vla-SetText table row
                            (setq column (1+ column)) item
                          )
                        )
                      )
                      rowitem
                    )
                  )
                  -1
                )
              )
            )
            data
          )
        )
        0
      )
      table
    )
    (
      (lambda ( textheight )
        (vla-AddTable space (vlax-3D-point pt) (1+ (length data)) (length (car data)) (* 1.8 textheight)
          (* textheight
            (apply 'max
              (cons (/ (strlen title) (length (car data)))
                (mapcar 'strlen (apply 'append data))
              )
            )
          )
        )
      )
      (vla-getTextHeight
        (_itemp
          (_itemp
            (vla-get-Dictionaries
              (vla-get-ActiveDocument (vlax-get-acad-object))
            )
            "ACAD_TABLESTYLE"
          )
          (getvar 'CTABLESTYLE)
        )
        acDataRow
      )
    )
  )
)

;;;

    (defun remove-i (i lst)
;;; i - index (fom 0)
;;;lst- list of elemets

      (setq i (1+ i))
      (vl-remove-if '(lambda (x) (zerop (setq i (1- i)))) lst)
    ) ;_ end of defun


    (defun rearragneslablist (lst / first thelast lst2 lst3)
      (setq
             first (nth 0 lst)
             thelast (nth 5 lst)   
             lst2 (remove-i 0 lst)
             lst2 (remove-i 2 lst2)
        lst2 (remove-i 2 lst2)   
        lst2 (remove-i 2 lst2)
        lst (remove-i 0 lst)
        lst (remove-i 0 lst)
        lst (remove-i 0 lst)
             lst (cons first lst)
             lst (append lst2 lst)
   
             lst (remove-i 5 lst)
        lst3 (remove-i 3 lst)
        lst3 (remove-i 3 lst3)
             lst (remove-i 0 lst)
             lst (remove-i 0 lst)
             lst (remove-i 0 lst)
             lst (cons thelast lst)
             lst (append lst3 lst)   
   )
      )

Red Nova

  • Newt
  • Posts: 69
Re: Lisp to replace Dataextraction
« Reply #8 on: September 24, 2016, 12:55:30 AM »
Don't worry, I got it, just had to use vl-sort 2 times.  :-D


Quote
(setq lst  (vl-sort lst   
             (function (lambda (A B)
                         (< (cadr A) (cadr B)))))
      lst  (vl-sort lst
             (function (lambda (A B)
                         (< (car A) (car B)))))
)

Red Nova

  • Newt
  • Posts: 69
Re: Lisp to replace Dataextraction
« Reply #9 on: September 24, 2016, 01:40:02 AM »
Now another question.

If I want to filter from the resulting list only elements relating to certain FLOOR and then record it into the table. How can I create such a filter?
My current list looks similar to this:
(("1" "1a" "4" "18'-2 3/4"" "#5" "19") ("1" "1b" "3" "32'-4 1/4"" "#5" "19") ("2" "1a" "11" "20'-10 1/4"" "#5" "19") ("2" "1b" "4" "14'-2 1/4"" "#5" "19") ("2" "1c" "2" "9'-1 1/4"" "#5" "19") ("3" "1c" "2" "9'-1 1/4"" "#5" "19") ("3" "1d" "4" "9'-4 1/2"" "#5" "19") ("3" "1d" "1" "9'-4 3/4"" "#5" "19"))

In I need to filter out everything but FLOOR 2, then the result should be following:
(("2" "1a" "11" "20'-10 1/4"" "#5" "19") ("2" "1b" "4" "14'-2 1/4"" "#5" "19") ("2" "1c" "2" "9'-1 1/4"" "#5" "19"))
 

T.Willey

  • Needs a day job
  • Posts: 5251
Re: Lisp to replace Dataextraction
« Reply #10 on: September 24, 2016, 02:35:11 AM »
You can step through with a 'foreach' call, and looking at the first element of the list, 'car', and see if it matches your criteria.
Code: [Select]
(foreach i lst
    (if (= (car i) <floor string>)
        (setq tlist (cons i tlist))
    )
)
Then you could use the variable 'tlist', as that is now the list of only the floor you wanted.

This thread might be of interest regarding your sorting requirements.
https://www.theswamp.org/index.php?topic=51970.0

I have not looked at your code, so these are just suggestions based on your questions.
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 #11 on: September 24, 2016, 08:56:16 AM »
Thank you.
Now I already finished with my first task, which was to create a table with bill of materials for slab. :)
My next one is for total length of slabs per floor. I got stuck on a part when I need to multiply each second element of sub-list with each third element and add resulting value to the list.
My initial list is something like this.

Quote
(("1" "4" "18'-2 3/4\"" "#5" "19") ("2" "11" "20'-10 1/4\"" "#5" "19") ("3" "2" "9'-1 1/4\"" "#5" "19"))


The processed list should look like this:
Quote
(("1" "4" "18'-2 3/4\"" "#5" "19" "72' 11\"") ("2" "11" "20'-10 1/4\"" "#5" "19" "229' 43/4\"") ("3" "2" "9'-1 1/4\"" "#5" "19" "18' 21/2\""))


Any idea?

T.Willey

  • Needs a day job
  • Posts: 5251
Re: Lisp to replace Dataextraction
« Reply #12 on: September 24, 2016, 03:56:50 PM »
Look at the built in lisp function 'distof', and then to do math, just use the operation signs like they are functions.
(+ 1 2)
(* 2 3)

The gotcha with math, is know which type you want returned: integer or real, and then pass values accordingly.  The two functions above will return integers, but if you call them like
(+ 1. 2)
(* 2. 3)

you will get reals.  This really pops its head up when dealing with division.
(/ 1 2)
is not the same as
(/ 1. 2)

Glad you are getting on with your lisp.  Congratulations.
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 #13 on: September 24, 2016, 10:18:56 PM »
Well. I managed to overcome my last issues.  :idea: To solve my recent issue I used following code:
Quote
(defun testit()
(mapcar '(lambda (n) (reverse (cons (rtos (* (read (cadr n)) (read (caddr n))) 2 2) (reverse n))))
         '(("1" "4" "18.50" "#5" "19") ("2" "11" "20.25" "#5" "19") ("3" "2" "9.50" "#5" "19"))))

However. I am again stuck   :-D
Now I need to match first elements of a nested lists, and if a match is found sum last elements of the list.
So having an input list like this:
Quote
(("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"))

I need to receive this։
Quote
(("1" "#5" "19" "1852.75") ("2" "#5" "19" "3238,75") ("3" "#5" "19" "3466.25"))

Please share your ideas if any ։)

T.Willey

  • Needs a day job
  • Posts: 5251
Re: Lisp to replace Dataextraction
« Reply #14 on: September 25, 2016, 03:16:35 AM »
This will create the list desired, but the variable will be 'tlist'
Code: [Select]
(setq lst '(("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")))
(foreach i lst
    (if (setq item (assoc (car i) tlist))
        (setq tlist
            (subst
                (subst (rtos (+ (distof (cadddr i)) (distof (cadddr item)))) (cadddr item) item)
                item
                tlist
            )
        )
        (setq tlist (cons i tlist))
    )
)

I would not sort the list until you are about to use the list, or else you might have to sort it multiple times.

Even though 'read' works in your instance, I would still use 'distof' as that is the correct function to turn a string into a real number.  Since you are learning, it is better to start with good habits, so you don't have to relearn it later.
Code: [Select]
Command: (rtos 18.5 5 2)
"18 1/2"

Command: (read (rtos 18.5 5 2))
18

Command: (distof (rtos 18.5 5 2))
18.5
Tim

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

Please think about donating if this post helped you.