Author Topic: Lisp to replace Dataextraction  (Read 5599 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: 5247
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: 774
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)
  )
)

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: 5247
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: 5247
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: 5247
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: 5247
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.

ribarm

  • Gator
  • Posts: 2559
  • 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

  • Mesozoic keyThumper
  • SuperMod
  • Swamp Rat
  • Posts: 1387
  • 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

Sometimes the question is more important than the answer.
#ridesober

T.Willey

  • Needs a day job
  • Posts: 5247
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: 2559
  • 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: 2559
  • 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: 12549
  • 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: 12549
  • 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: 12549
  • 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: 12549
  • 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: 12549
  • 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 »

Red Nova

  • Newt
  • Posts: 69
Re: Lisp to replace Dataextraction
« Reply #30 on: October 02, 2016, 01:59:21 PM »
Thanks. It works. Just added list before rtos to eliminate the point in between. :)

Code - Auto/Visual Lisp: [Select]
  1.     (defun f ( a b / c )
  2.         (if a
  3.             (if (setq c (assoc (caar a) b))
  4.                 (cons (cons (caar a) (list (rtos (- (distof (cadar a)) (distof (cadr c))) 2 0))) (f (cdr a) b))
  5.                 (cons (car a) (f (cdr a) b))
  6.             )
  7.         )
  8.     )

Lee Mac

  • Seagull
  • Posts: 12549
  • London, England
Re: Lisp to replace Dataextraction
« Reply #31 on: October 02, 2016, 02:31:10 PM »
Thanks. It works. Just added list before rtos to eliminate the point in between. :)

Sorry, I had overlooked the fact you were not using dotted pairs - I have updated the two posts above (simply change cons to list when constructing the list elements).