Data extraction lisp file needed -2009

I'm looking for code that runs data extraction to predetermined selections without all of the prompting windows.

The procedure would be as follows:

1. prompt user for selection of objects

2. run data extraction for just the lines getting the info of count, name, layer, length

3. save as an xls file only (no table in drawing) named "takeoff" in the current folder of course

I'm new to lisp and am experimenting with the action recorder. What I am trying to get past in all applications are pauses in macros or lisp files due to prompting windows in the commands when I already know what these selections are to be.

Any insight or advice would be greatly appreciated.

If you are learning lisp the action recorder won't by much help.

Why don't you post your attempts and we can help you...

So, you are wanting to create a selection set (ssget I assume), then iterate through the selection, sorting by layer and exporting to an .xls document the layer name, quantity, length, etc. Is this correct?

The vlax-curve functions can give you a lot of your total lengths information. Quantity is easy, you just separate out objects by layer and get a length. As Steve said, post your attempts and we can make something work.

And quickly before Alan gets bored and writes it all.

And quickly before Alan gets bored and writes it all.

LoL

I'm keeping busy hanging out with my little girl. My wife has a huge class load this semester, so she's glued to grading and preparing lectures.

I like to help out when I can; it's really good exercise.

LoL

I'm keeping busy hanging out with my little girl. My wife has a huge class load this semester, so she's glued to grading and preparing lectures.

 

I like to help out when I can; it's really good exercise.

I'm glad you do. Always plenty to learn.

I'm glad you do. Always plenty to learn.

That's the truth. I wish I could just get paid to program all day.

What I am doing is making a 2d roof plan (above view) of lines all in one layer (0). Then I assign new layers to all of the lines using names such as "eave", "ridge", "hip", etc. This I have covered.

After assigning all the new layer names, I run the dx command: data extraction. Which is an 8 page window of prompts:

1-Q: Choice of to use a previous dxe template or start a new one

A: Start a new one save as "takeoff" in default file location

2-Q: Drawings Sheet source

A: Select Objects

3-Q: Objects

A: Line (only)

4-Q:Properties

A: Layer & Length Only

5-Q: Refine Data

A: No change, next,

6-Q:Choose Output

A: Output to external File "takeoff.xls" in file location

7-(skipped because "table insertion" in 6 wasn't chosen")

8- Finish

What I want to accomplish (with the same result) is running a command (lets call it "takeoff") and it only prompt the following:

2-"Select Objects"

User select objects, enter.

6-"save as:"

User saves xls file in proper location.

and your done without all of the other promptings.

This is for coworkers who are not normal cad users. I think I may have taken on something I can't accomplish as easily as I thought.

Whoa I didn't even know of that command.

Anyways, are you trying to learn lisp or are you just wanting someone to write it? I only ask because it's probably be a good program to learn from.

You'd start with an ssget function which selects objects. If you are just wanting lines it'd be:

(setq ss (ssget '((0 . "LINE"))))

Then it's just two more steps: extracting the data (easy) and exporting it (which is the difficult bit).

Thank you for your interest.

I guess my answer is both. If someone would like to write it, that would be great. I am learning lisp on my own now and I am just getting to the command stage. I don't have a lot of time or I'd have learned it by now.

I know that you set ss to a variable. Is ssget of all the lines selected?

Do you know if lisp could run the dx command for you with only 2 of the prompts as I stated before? Would this possibly be a VBA problem?

You know the funny thing is I discovered dx when I miss typed dc trying to open up design center or I would never have known about it either!

P.S. I have no idea how that emocon ended up in my post on #4! lol

From my knowledge (someone confirm) if you could use the dx command without the dialog boxes you'd type something like (command "-DX" etc..") like you do with (command "-INSERT" etc); thatis, the "-" before the command suppresses the dialogs. But this doesn't work so I'd say you can't.

Well if you don't have time you won't learn lisp cause it's easy it just takes time!

Here's the first part. This will output a list of all the lines with the layer and the distance. Is that all the data you want?

(defun c:lndet (/ ss i en lst)
 ; Selection Set
 (if (setq ss (ssget '((0 . "LINE"))))
   (progn
     
     ; Loop to get each bit of data from each line
     (setq i -1)
     (while (setq en (ssname ss (setq i (1+ i))))
   ; Add details of each line to a list
   (setq lst (cons
           (cons
             ; Get the Layer of the Line
             (cdr (assoc 8 (entget en)))
             ; Get the distance of the Line
             (distance
           (cdr (assoc 10 (entget en)))
           (cdr (assoc 11 (entget en)))
           )
             )
           lst)
         );_ end setq
   );_ end while
     )(princ "\nNo Lines Found.")
   );_ end if

 ; Output List or Nil
 lst
 )
 

All that's left is to put that into excel. I can put it into a csv file for you, but I'd have to dig around to put it into excel for you. Maybe someone else will chip in...

Steve a csv file would be awesome! I can use that just as well!

That is exactly what I need!

I'd be more than happy to help you with dynamic blocks as a thank you, but you're probably light years ahead of me on those, too!

How's this?

(princ "\nLisp Loaded. Type \"LNS2CSV\" to run..")
(defun c:LNS2CSV (/ fl lst)
 (vl-load-com)
 (if (and (setq lst (lndet))
      (setq fl (strcat (getvar "DWGPREFIX") "TakeOff.csv"))
      (setq fl (open fl "w")))
   (progn
     (write-line "Layer,Line Length" fl)
     (foreach ln lst
   (ListToCSV
     fl ; Will erase existing file if exists
     ln
     nil ; Individual Header Line
     );_ ListToCSV
   );_ foreach
     (close fl)
     (princ (strcat "\nAll Done. " (itoa (length lst)) " Lines processed."))
     );_ progn
   (princ "\nNo Peg Block found or File selected/opened")
   );_ if
 (princ)
 )

(defun lndet (/ ss i en lst)
 ; Selection Set
 (if (setq ss (ssget '((0 . "LINE"))))
   (progn
     
     ; Loop to get each bit of data from each line
     (setq i -1)
     (while (setq en (ssname ss (setq i (1+ i))))
   ; Add details of each line to a list
   (setq lst (cons
           (list
             ; Get the Layer of the Line
             (cdr (assoc 8 (entget en)))
             ; Get the distance of the Line
             (distance
           (cdr (assoc 10 (entget en)))
           (cdr (assoc 11 (entget en)))
           )
             )
           lst)
         );_ end setq
   );_ end while
     )(princ "\nNo Lines Found.")
   );_ end if

 ; Output List or Nil
 lst
 )

;;; By Mark - http://www.theswamp.org/index.php?topic=6356.msg77762#msg77762
(defun ListToCSV (fo lst header / cnt)
 ;;; takes a list [lst], open file handle [fo] and header [header] 
 ;;; (optional) a string and writes the list to the file in comma
 ;;; delimited format.

 ;;; example
 ;;; (setq fo (open "c:/cd_file.csv" "w"))
 ;;; (setq pt_list (list "23" 100.25 200.2))
 ;;; (ListToCSV fo pt_list "Point,Northing,Easting")
 ;;; (close fo)

 (defun Item2Str (lst)
   ;;; convert INT or REAL to string
   (mapcar
     '(lambda (item)
    (cond
      ((= (type item) 'INT)
       (itoa item))
      ((= (type item) 'REAL)
       (rtos item 2 4)); you will probably want to change this
      (T
       ;Check for comma's in string - SK added
       (vl-string-subst "." "," item))
      )
    )
     lst
     )
   )

 (if header 
   (write-line header fo)
   )

 ;; make sure we have nothing but strings in the list
 (setq lst (Item2Str lst)
   cnt 1)

 ;; write it!!
 (write-line
   (apply 'strcat
      (mapcar
        '(lambda (item)
       (if (= (length lst) cnt)
         (strcat item)
         (progn
           (setq cnt (1+ cnt))
           (strcat item ",")
           )
         )
       )
        lst
        )
      )
   fo
   )
 (princ)
 )

ps. Sorry Alan (pot calling the kettle black)

Man, I gotta learn this stuff!

Thanks a million. Nothing like going half way around the world to get help in a matter of minutes!

You're welcome

I'm guessing you're not in the US because most people are asleep when I'm up.

I'm actually in Ohio, US and it's almost 9 P.M. here. My girlfriend and I are planning a trip to Australia and New Zealand (she has friends there) in a few years. I'm looking forward to it!

in a few years? why wait! lol

anyways, hope you get some time to learn lisp. If you use cad heaps it saves time in the long run.

How's this?

(princ "\nLisp Loaded. Type \"LNS2CSV\" to run..")
(defun c:LNS2CSV (/ fl lst)
 (vl-load-com)
 (if (and (setq lst (lndet))
      (setq fl (strcat (getvar "DWGPREFIX") "TakeOff.csv"))
      (setq fl (open fl "w")))
   (progn
     (write-line "Layer,Line Length" fl)
     (foreach ln lst
   (ListToCSV
     fl ; Will erase existing file if exists
     ln
     nil ; Individual Header Line
     );_ ListToCSV
   );_ foreach
     (close fl)
     (princ (strcat "\nAll Done. " (itoa (length lst)) " Lines processed."))
     );_ progn
   (princ "\nNo Peg Block found or File selected/opened")
   );_ if
 (princ)
 )

(defun lndet (/ ss i en lst)
 ; Selection Set
 (if (setq ss (ssget '((0 . "LINE"))))
   (progn
     
     ; Loop to get each bit of data from each line
     (setq i -1)
     (while (setq en (ssname ss (setq i (1+ i))))
   ; Add details of each line to a list
   (setq lst (cons
           (list
             ; Get the Layer of the Line
             (cdr (assoc 8 (entget en)))
             ; Get the distance of the Line
             (distance
           (cdr (assoc 10 (entget en)))
           (cdr (assoc 11 (entget en)))
           )
             )
           lst)
         );_ end setq
   );_ end while
     )(princ "\nNo Lines Found.")
   );_ end if

 ; Output List or Nil
 lst
 )

;;; By Mark - http://www.theswamp.org/index.php?topic=6356.msg77762#msg77762
(defun ListToCSV (fo lst header / cnt)
 ;;; takes a list [lst], open file handle [fo] and header [header] 
 ;;; (optional) a string and writes the list to the file in comma
 ;;; delimited format.

 ;;; example
 ;;; (setq fo (open "c:/cd_file.csv" "w"))
 ;;; (setq pt_list (list "23" 100.25 200.2))
 ;;; (ListToCSV fo pt_list "Point,Northing,Easting")
 ;;; (close fo)

 (defun Item2Str (lst)
   ;;; convert INT or REAL to string
   (mapcar
     '(lambda (item)
    (cond
      ((= (type item) 'INT)
       (itoa item))
      ((= (type item) 'REAL)
       (rtos item 2 4)); you will probably want to change this
      (T
       ;Check for comma's in string - SK added
       (vl-string-subst "." "," item))
      )
    )
     lst
     )
   )

 (if header 
   (write-line header fo)
   )

 ;; make sure we have nothing but strings in the list
 (setq lst (Item2Str lst)
   cnt 1)

 ;; write it!!
 (write-line
   (apply 'strcat
      (mapcar
        '(lambda (item)
       (if (= (length lst) cnt)
         (strcat item)
         (progn
           (setq cnt (1+ cnt))
           (strcat item ",")
           )
         )
       )
        lst
        )
      )
   fo
   )
 (princ)
 )

ps. Sorry Alan (pot calling the kettle black)

LoL

Nicely done.

Thanks Alan, I tried to keep it general but it got a bit specific/amateurish towards the end. (eg (write-line "Layer,Line Length" fl) is out of place)

Don't sweat it dude. I did notice that you didn't combine lengths if more than one line existed on a layer. I hope you don't mind, I gave it a shot myself.

;;; TakeOff (Export Line lengths to csv based on layer)
;;; Alan J. Thompson, 11.05.09
(defun c:TakeOff (/ *error* #SS #Item #List #Open #File)
 (vl-load-com)
 (defun *error* (#Message)
   (and #Open (close #Open))
   (and #File (startapp "Notepad" #File))
   (and #Message
        (not (wcmatch (strcase #Message) "*BREAK*,*CANCEL*,*QUIT*"))
        (princ (strcat "\nError: " #Message))
   ) ;_ and
 ) ;_ defun
 (cond
   ((setq #SS (ssget '((0 . "LINE"))))
    (or *AcadDoc* (setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object))))
    (vlax-for x (setq #SS (vla-get-activeselectionset *AcadDoc*))
      (setq #Item (cons (vla-get-layer x) (vla-get-length x)))
      (if (assoc (car #Item) #List)
        (setq #List (subst (cons (car #Item) (+ (cdr (assoc (car #Item) #List)) (cdr #Item)))
                           (assoc (car #Item) #List)
                           #List
                    ) ;_ subst
        ) ;_ setq
        (setq #List (cons #Item #List))
      ) ;_ if
    ) ;_ vlax-for
    (vl-catch-all-apply 'vla-delete (list #SS))
    (setq #Open (open (setq #File (strcat (getvar 'dwgprefix) "TakeOff.csv")) "W"))
    (foreach x (cons "Layer,Length"
                     (mapcar '(lambda (i) (strcat (car i) "," (vl-princ-to-string (cdr i))))
                             (vl-sort #List '(lambda (x y) (< (car x) (car y))))
                     ) ;_ mapcar
               ) ;_ cons
      (write-line x #Open)
    ) ;_ foreach
   )
 ) ;_ cond
 (*error* nil)
 (princ)
) ;_ defun