Jump to content

Data extraction lisp file needed -2009


kindy52

Recommended Posts

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.

Link to comment
Share on other sites

  • Replies 25
  • Created
  • Last Reply

Top Posters In This Topic

  • SteveK

    11

  • alanjt

    7

  • kindy52

    6

  • danielk

    1

Top Posters In This Topic

Posted Images

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.

Link to comment
Share on other sites

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.

Link to comment
Share on other sites

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.

Link to comment
Share on other sites

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.

Link to comment
Share on other sites

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).

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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!

Link to comment
Share on other sites

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) :roll:

Link to comment
Share on other sites

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!

Link to comment
Share on other sites

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) :roll:

 

LoL

Nicely done. :)

Link to comment
Share on other sites

:) 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)
Link to comment
Share on other sites

:) 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.gif

 

;;; 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

 

excel.jpg

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.


×
×
  • Create New...