Jump to content

Extracting data to excel from selected objects on different layers


Recommended Posts

Posted (edited)

Hi, 

Im trying to use Lisp to extract certain data from a bunch of  selected objects (lines / polylines / points) into a excel file. 

Ive tried to bastardize a program by SteveK found on this forum, 

 

 

but since ive never extracted data out to excel, i'm messing it up.

Basically, from a bunch of layers, i'm trying to extract 

Count,Name,Layer,Color,Length,Linetype,Lineweight,Thickness,Area,Closed,DeltaZ of each entity.

Plus the extracted file needs to have an option of where to save it.... 

 

attaching my Bastardized version ...... do suggest where im going wrong.... (furthermore, i still havent been able to figure out how to extract individual entity polyline length and area)

 

ssaextract.lsp

Edited by Hsanon
Posted

My suggestion is start to use VL lisp, functions like Length are supported. Here is dumpit.lsp a great tool exposes lots of stuff.

 

;;;===================================================================; 
;;; DumpIt                                                            ; 
;;;-------------------------------------------------------------------; 
;;; Dump all methods and properties for selected objects              ; 
;;;===================================================================; 
(defun C:Dumpit ( / ent) 
  (while (setq ent (entsel)) 
    (vlax-Dump-Object 
      (vlax-Ename->Vla-Object (car ent)) 
    ) 
  ) 
  (princ) 
)

 

 

a couple of sample lines relevant to your request

(repeat (setq x (sslength ss))
(setq obj (vlax-ename->vla-object (ssname ss (setq x (- x 1))))) ; use with selection set

(setq len (vla-get-length obj)) ; note a circle is Circumference

(setq col (vla-get-color obj)) 
(setq lay (vla-get-layer obj))

 

Ask if stuck for more properties such as  (vlax-curve-

Posted
(defun C:DE (/ ss tpt)
     ;(setq ss (ssget)) ;export all
     (setq ss (ssget (list (cons -4 "<OR") (cons 0 "*LINE") (cons 0 "POINT") (cons -4 "OR>")) ) )  ; export lines, plines and points
     (setq tpt (getpoint "\n Pick Point for table"))
     (command "undo" "be")
     (command "-DATAEXTRACTION" "" ss "" " " "y" tpt "n" "n")
     (setq tab (entlast))
     (command "tableexport" tab)
     (princ)
     (command "undo" "e")
)

;If overload warning appears when doing dataexport
(defun C:DE2 (/ ss tpt)
     ;(setq ss (ssget)) ;export all
     (setq ss (ssget (list (cons -4 "<OR") (cons 0 "*LINE") (cons 0 "POINT") (cons -4 "OR>")) ) )  ; export lines, plines and points
     (setq tpt (getpoint "\n Pick Point for table"))
     (command "undo" "be")
     (command "-DATAEXTRACTION" "" ss "" " " "y" "y" tpt "n" "n")
     (setq tab (entlast))
     (command "tableexport" tab)
     (princ)
     (command "undo" "e")
)

 

 

how about this

Posted

Hi Exeed,

Im still struggling to figure out the template path for extraction. 

Furthermore i dont see a table forming on the point chosen......

 

But the program looks really concise.... can it take out pline lengths and areas too  and the other stuff required ????

 

BigAl,

youve inspired me to move on from simple autolisp to Visual lisp..... will read up.....

The vlax dump is great..lot of info on screen.... . now i need to figure out how to extract the relevant info from there... and get it out to excel

 

Posted
14 hours ago, BIGAL said:

Ask if stuck for more properties such as  (vlax-curve-

Hey BigAl, 

Its a start, after going through some tutorials on afralisp, and analyzing the stuff you wrote above, i tried writing a code.... which of course doesnt work . its also the first time ive tried Visual Lisp and VLIDE... 

my program keeps calling up another program which i had written...... LV.lsp  ... dunno why...... 

basically im trying to extract the details i want from every entity in the selection,

and next update some entities like

object name to be written as "Line" or Polyline" or "Point"

convert area from square millimeters to square metres,   length to metres

closed entity to be written as "closed" (not -1)

bylayer lineweight to be written as "bylayer" (not -1)

 

and then eventually write them into an excel file .....

 

also suggest some  Visual Lisp websites/ tutorials which i can go to....

thanks for all the help !!!

 

(defun c:ssaext ()
  (setq allobjects (ssget (list (cons -4 "<OR") (cons 0 "*LINE") (cons 0 "POINT") (cons -4 "OR>")) ) )
 
  (setq index 0)
  (repeat (sslength allobjects)
       (setq ent1 (ssname allobjects index))
    ;(setq name (vlax-ename->vla-object (ssname allobjects (setq objnos (- objnos 1)))))
     (setq 	name (vla-get-Objectname ent1)
           	layer (vla-get-layer ent1)
           	col (vla-get-color ent1)
        	objlength (vla-get-length ent1)
        	linetype (vla-get-linetype ent1)
            lineweight (vla-get-lineweight ent1)
            thickness (vla-get-Constantwidth ent1)
            area (vla-get-area ent1)
            closed (vla-get-closed ent1)
         deltaZ (vla-get-elevation ent1)
        index (1+ index)); end setq

      
    ); end repeat
    ); end defun

 

Posted (edited)

This will step thought each selection you make and get the relative information but it needs to be outputted to excel before the next one is processed.

 

(defun C:SSAEXT (/ SS P1 P2 P3 P4 P5 P6 P7 P8 output Main_output) 
  (vl-load-com)
  (setq SS (ssget '((0 . "LWPOLYLINE,LINE,POINT"))))
  (foreach obj (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS)))
    (setq ent (vlax-ename->vla-object obj)
          P1 (vla-get-Objectname ent)
    )
    (cond
      ((eq "AcDbPoint" P1)
           (setq P2 (vlax-get ent 'layer)
                 P3 (vlax-get ent 'color)
                 P8 (caddr (vlax-get ent 'Coordinates)) 
                 output (list P1 P2 P3 P8)
           )
      )
      ((eq "AcDbLine" P1)
           (setq P2 (vlax-get ent 'layer)
                 P3 (vlax-get ent 'color)
                 P4 (vlax-get ent 'length)  
                 P5 (vlax-get ent 'linetype)
                 P6 (vlax-get ent 'Lineweight) 
                 P7 (vlax-get ent 'thickness)   
                 P8 (caddr (vlax-get ent 'Startpoint)) ;assumes flat line
                 output (list P1 P2 P3 P4 P5 P6 P7 P8)
           )
      )
      ((eq "AcDbPolyline" P1)
           (setq P2 (vlax-get ent 'layer)
                 P3 (vlax-get ent 'color)
                 P4 (vlax-get ent 'length)  
                 P5 (vlax-get ent 'linetype)
                 P6 (vlax-get ent 'Lineweight) 
                 P7 (vlax-get ent 'thickness)   
                 P8 (vlax-get ent 'Elevation)
                 output (list P1 P2 P3 P4 P5 P6 P7 P8)
           )
      )
    )
    (setq Main_output (cons output Main_output))
  )
  ;Send Main_Output to excel
  (princ)
)

 

Edited by mhupp
Updated code from Steven P
  • Like 1
Posted
11 hours ago, mhupp said:

This will step thought each selection you make and get the relative information but it needs to be outputted to excel before the next one is processed.

 

 

add (setq myoutput (list P2 P3 P8)) and (setq myoutput (list P2 P3 P4 P5 P6 P7 P8)) to your point or line setq lists, append these to another list where your comment is, then after your foreach loop go through this appended list and export to excel all in one go at the end?

  • Like 1
Posted
3 minutes ago, mhupp said:

Don't forget about P1!

 

I just didn't like P1! ..... but suppose it should be there too - nice update to your code

Posted

Steven P,  mhupp

 

Thanks guys,..... appreciate the help,

can you help me out in extracting the Main_output to a csv file....

;Send Main_output to excel

    	  (setq start (getvar "DWGPREFIX") ;;this defaults to the file location dialog to where the DWG is stored
		
		file (open (getfiled "Name output file" (getvar "DWGPREFIX") "CSV" 1) "w")
		l 0
	  )
	  (write-line "Name,Layer,Color,Length-mm,Linetype,Lineweight,Thickness,Area-sqm,Closed,DeltaZ" file) ;;writes the headers to the .CSV
; till here its fine.....

	  (write-line Main_output file) ; this doesnt work.....
	  (close file)

 

Posted

BigAl

 

had tried writing out the program as you had suggested too.....   but again, there are issues regarding the object area & "object closed" if its a line, and it still doesnt write the csv correctly..... it crashes with "AcDbLine" and all entities are not listed.....

 

Do help with the writing out of the csv.....

 

(defun c:ssaext ()
  (vl-load-com)


  (setq start (getvar "DWGPREFIX") ;;this defaults to the file location dialog to where the DWG is stored
		
	file (open (getfiled "Name output file" (getvar "DWGPREFIX") "CSV" 1) "w")
	l 0 ;??
	)
  

	(write-line "Name,Layer,Color,Length-mm,Linetype,Lineweight,Thickness,Area-sqm,Closed,DeltaZ" file) ;;writes the headers to the .CSV

  (setq allobjects (ssget (list (cons -4 "<OR") (cons 0 "*LINE") (cons -4 "OR>")) ) )
 
  (repeat (setq objnos (sslength allobjects))
	(setq ent (vlax-ename->vla-object (ssname allobjects (setq objnos (- objnos 1)))))

      (setq objname (vla-get-Objectname ent))
      (setq objlayer (vla-get-layer ent))
      (setq objcol (vla-get-color ent))
      (setq objlength (vla-get-length ent))
      (setq objlinetype (vla-get-linetype ent))
      (setq objlineweight (/ (float (vla-get-lineweight ent)) 100 ))  
      (setq objthickness (vla-get-constantwidth ent))
    ; check if it has area, elevation, and closed property.... ie. closed polyline
      (if ( eq "AcDbPolyline" objname) (setq  objarea (vla-get-area ent)) (setq objarea 0))
      (setq  objclosed (vla-get-closed ent))
      (if ( eq objclosed :vlax-true) (setq  objclosed "CLOSED") (setq objclosed "OPEN"))
      (if ( eq "AcDbPolyline" objname) (setq  objdeltaZ (vla-get-elevation ent))  (setq objdeltaZ 0))

    ; now write this info to file
      (setq data (strcat objname "," objlayer "," (itoa objcol) "," (rtos objlength) "," objlinetype "," (rtos objlineweight) "," (rtos objthickness) "," (rtos (/ objarea 1000000)) "," objclosed "," (rtos objdeltaZ) ))
      (write-line data file)
      (setq objnos (1+ objnos ))
    
    
    ); end repeat
	(close file)
    ); end defun

 

Posted
40 minutes ago, Hsanon said:

can you help me out in extracting the Main_output to a csv file....

 

Without checking, you will probably need to loop through each list item in Main_output and have write-line to be (write-line (strcat with each of these to create a comma separated list.

You might also need to add P's in MHUPPs points to be blank (P4 to P7 to be "") just to give you the spacing you will need ( output (list P1 P2 P3 "" "" "" "" P8) )

 

Something like this replacing (write-line Main_output file) ; this doesnt work..... might work, untested....

 

  (setq acount 0)
  (while (< acount (length Main_output))
    (setq MyOutput (nth acount Main_output))
    (write-line (strcat (nth 0 MyOutput) "," (nth 1 MyOutput) "," (nth 2 MyOutput) "," (nth 3 MyOutput) "," .... (nth 7 MyOutput) ) file)
    (setq (+ acount 1))
  ) ;end while

 

Posted

thanks.Steven P..... shall try it out on Monday....

much appreciated !!!! It's the first time I'm using vlisp, and my first extraction attempt. 

Posted

Hi,

there still seems some sort of an issue....   

do we need to convert all the numbers in the list to string for strcat ???? colours may range from "bylayer" to integers... how do i differentiate between them ??? i can use itoa for the integers, by what do i do about the bylayer ??? similar issues with the others for strcat... - length, area ,linetype , linethickness - should i go with rtos ??

how do i output "open" or "closed" for ploylines (its showing -1 and 0 )

im not sure if (length Mainoutput) has a problem.... as its crashing there too..... (i dont know why....)

and, in the csv, the main title header does come, but nothing else does....

 

do suggest.... thanks

 

 

(defun C:SSAEXT4 () 
  (vl-load-com)
  (setq output 0 Mainoutput 0)
  (setq SS (ssget '((0 . "LWPOLYLINE,LINE,POINT"))))
  (foreach obj (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS)))
    (setq ent (vlax-ename->vla-object obj)
          P1 (vla-get-Objectname ent)
    )
    (cond
      ((eq "AcDbPoint" P1)
           (setq P2 (vlax-get ent 'layer)
                 P3 (vlax-get ent 'color)
                 P10 (caddr (vlax-get ent 'Coordinates)) 
                 output (list P1 P2 P3 "" "" "" "" "" "" P10)
           )  ;setq
      )  ;eq
      ((eq "AcDbLine" P1)
           (setq P2 (vlax-get ent 'layer)
                 P3 (vlax-get ent 'color)
                 P4 (vlax-get ent 'length)  
                 P5 (vlax-get ent 'linetype)
                 P6 (vlax-get ent 'Lineweight) 
                 P7 (vlax-get ent 'thickness)   
		 P8 "0"
		 P9 "VOID"
                 P10 (caddr (vlax-get ent 'Startpoint)) ;assumes flat line
                 output (list P1 P2 P3 P4 P5 P6 P7 P8 P9 P10)
           ) ; setq
      )  ; eq
      ((eq "AcDbPolyline" P1)
           (setq P2 (vlax-get ent 'layer)
                 P3 (vlax-get ent 'color)
                 P4 (vlax-get ent 'length)  
                 P5 (vlax-get ent 'linetype)
                 P6 (vlax-get ent 'Lineweight) 
                 P7 (vlax-get ent 'thickness)  
		 P8 (/ (vlax-get ent 'area) 1000000 ) 
		 P9 (rtos (vlax-get ent 'closed))
                 P10 (vlax-get ent 'Elevation)
                 output (list P1 P2 P3 P4 P5 P6 P7 P8 P9 P10)
           )  ;setq
      )  ; eq
    )  ; cond
    (setq Mainoutput (cons output Mainoutput))
  )  ; foreach
  ;Send Mainoutput to excel

    	  (setq start (getvar "DWGPREFIX") ;;this defaults to the file location dialog to where the DWG is stored
		
		file (open (getfiled "Name output file" (getvar "DWGPREFIX") "CSV" 1) "w")
		l 0
	  )
	  (write-line "Name,Layer,Color,Length-mm,Linetype,Lineweight,Thickness,Area-sqm,Closed,DeltaZ" file) ;;writes the headers to the .CSV

  (setq acount 0)
  (while (< acount (length Mainoutput ))
    (setq MyOutput (nth acount Mainoutput ))
    (write-line (strcat (nth 0 MyOutput) "," (nth 1 MyOutput) "," (nth 2 MyOutput) "," (nth 3 MyOutput) "," (nth 4 MyOutput) "," (nth 5 MyOutput) "," (nth 6 MyOutput) "," (nth 7 MyOutput) "," (nth 8 MyOutput) "," (nth 9 MyOutput) ) file)
    (setq acount  (+ acount 1))
  ) ;end while
	  (close file)

  (princ)
)  ;defun

 

Posted

Yes you need to convert variables into strings to use them with strcat function.

Colour "ByLayer" = 256 as an integer value.

Use itoa function to convert from integer to string and 

use rtos function to convert from real ( decimal ) to string. 

 

As soon as you know the type return of your function then it would be very easy to you to know how to deal with it.

  • Like 1
Posted (edited)

You could try adding this little routine,  calling it with for example (txt2string (nth 0 MyOutput) )

 

(defun LM:lst->str ( lst del )
  (if (cdr lst)
    (strcat (car lst) del (LM:lst->str (cdr lst) del))
    (car lst)
  )
)
(defun txt2string ( mytext / mystring )
  (if (= (type mytext) 'STR)(setq mystring mytext)())
  (if (= (type mytext) 'INT)(setq mystring (itoa mytext))())
  (if (= (type mytext) 'REAL)(setq mystring (rtos mytext))())
  (if (= (type mytext) 'LIST)(setq mystring (LM:lst->str mytext ","))())
  mystring
)

 

Edited by Steven P
Posted

@Steven P You can either use condition to avoid evaluating each line of your IFs statements or just use vl-princ-to-string function and this should be enough since you are not controlling the decimals with rtos function within your last reply.

  • Like 1
Posted (edited)

Just convert them to strings before adding to the list

(itoa (for whole numbers)

(rtos (for other numbers) 2)

 

(defun C:SSAEXT4 (/ output Mainoutput SS ent P1 P2 P3 P4 P5 P6 P7 P8 P9 P10) ;best to name variables
  (vl-load-com)
  (if (setq SS (ssget '((0 . "LWPOLYLINE,LINE,POINT"))))
    (foreach obj (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS)))
      (setq ent (vlax-ename->vla-object obj)
            P1 (vla-get-Objectname ent)
      )
      (cond
        ((eq "AcDbPoint" P1)
             (setq P2 (vlax-get ent 'layer)
                   P3 (itoa(vlax-get ent 'color))
                   P10 (rtos(caddr (vlax-get ent 'Coordinates))2)
                   output (list P1 P2 P3 "-" "-" "-" "-" "-" "-" P10)
             )  ;setq
        )       ;eq
        ((eq "AcDbLine" P1)
             (setq P2 (vlax-get ent 'layer)
                   P3 (itoa(vlax-get ent 'color))
                   P4 (rtos(vlax-get ent 'length)2)
                   P5 (vlax-get ent 'linetype)
                   P6 (rtos(vlax-get ent 'Lineweight)2)
                   P7 (rtos(vlax-get ent 'thickness)2)
                   P8 "0"
                   P9 "VOID"
                   P10 (rtos(caddr (vlax-get ent 'Startpoint))2)  ;assumes flat line
                   output (list P1 P2 P3 P4 P5 P6 P7 P8 P9 P10)
             )  ; setq
        )       ; eq
        ((eq "AcDbPolyline" P1)
             (setq P2 (vlax-get ent 'layer)
                   P3 (itoa(vlax-get ent 'color))
                   P4 (rtos(vlax-get ent 'length)2)
                   P5 (vlax-get ent 'linetype)
                   P6 (rtos(vlax-get ent 'Lineweight)2)
                   P7 (rtos(vlax-get ent 'thickness)2)
                   P8 (rtos(/ (vlax-get ent 'area) 1000000)2)
                   P9 (rtos(vlax-get ent 'closed))
                   P10 (rtos(vlax-get ent 'Elevation)2)
                   output (list P1 P2 P3 P4 P5 P6 P7 P8 P9 P10)
             )  ;setq
        )       ; eq
      )         ; cond
      (setq Mainoutput (cons output Mainoutput))
    )
    (prompt "/nNothing Selected")
  )
  (if ss
    (progn
      (setq file (open (getfiled "Name output file" (getvar "DWGPREFIX") "CSV" 1) "w"))
      (write-line "Name,Layer,Color,Length-mm,Linetype,Lineweight,Thickness,Area-sqm,Closed,DeltaZ" file)  ;;writes the headers to the .CSV
      (foreach row Mainoutput
        (write-line (lst2str "," row) file)
      )
      (close file)
    )
  )
  (princ)
)
;;----------------------------------------------------------------------------;;
;; Function to convert list to string 
;; (lst2str "," lst)
(defun lst2str (dlim lst / rtn)
  (setq rtn (car lst) lst (cdr lst))
  (repeat (length lst)
    (setq rtn (strcat rtn dlim (car lst))
          lst (cdr lst)
    )
  )
  rtn
)

 

Edited by mhupp
  • Like 1
Posted
57 minutes ago, Tharwat said:

@Steven P You can either use condition to avoid evaluating each line of your IFs statements or just use vl-princ-to-string function and this should be enough since you are not controlling the decimals with rtos function within your last reply.

 

Thanks. Just being lazy here, IF commands being quick and easy in this case, copied it from my stuff (which is why it has lists in there too) but you are right, I should to do something to control the RTOS decimals - next time i look at it maybe.

Posted (edited)

Writing direct to excel is advanced but it is also simple if you break it down into a simple steps, ie the simplest is to not have excel open let Autocad open it, step 1. Then you would replace  (setq Mainoutput (cons output Mainoutput)) with a new defun that writes the data to excel.(mainoutput output)

 

I just did a write Table to excel so should be able to edit that to be a write to excel a list as it will just write what ever is in the "output" list. It would be a library function so work with any code.

 

Just need a day a little busy.

Edited by BIGAL

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