Jump to content

Extracting data to excel from selected objects on different layers

Hsanon

By Hsanon
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

exceed Proficient

exceed

Posted
Posted (edited)
14 hours ago, Hsanon said:

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

 

  

(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 (vlax-get ent 'Lineweight)
                   P7 (rtos(vlax-get ent 'thickness)2)
                   P8 "0"
                   P9 "VOID"
                   P10 (rtos(caddr (vlax-get ent 'Startpoint))2)  ;assumes flat line
             )  ; setq
             (cond ((= P6 -1) (setq P6 "ByLayer"))
                     ((= P6 -2) (setq P6 "ByBlock"))
                     ((= P6 -3) (setq P6 "Default"))
                     ((< P6 10) (setq P6 (strcat "0.0" (vl-princ-to-string P6) "mm") ))
                     ((< P6 100) (setq P6 (strcat "0." (vl-princ-to-string P6) "mm") ))
                     ((>= P6 100) (setq P6 (strcat (substr (vl-princ-to-string P6) 1 1) "." (substr (vl-princ-to-string P6) 2 2) "mm") )) 
             )
             (setq output (list P1 P2 P3 P4 P5 P6 P7 P8 P9 P10))

        )       ; 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 (vlax-get ent 'Lineweight)
                   P7 (rtos(vlax-get ent 'thickness)2)
                   P8 (rtos(/ (vlax-get ent 'area) 1000000)2)
                   P9 (vlax-get ent 'closed)
                   P10 (rtos(vlax-get ent 'Elevation)2)
             )  ;setq
             (cond ((= P9 -1) (setq P9 "Closed"))
                     ((= P9 0) (setq P9 "Opened"))
             )
             (cond ((= P6 -1) (setq P6 "ByLayer"))
                     ((= P6 -2) (setq P6 "ByBlock"))
                     ((= P6 -3) (setq P6 "Default"))                    
                     ((< P6 10) (setq P6 (strcat "0.0" (vl-princ-to-string P6) "mm") ))
                     ((< P6 100) (setq P6 (strcat "0." (vl-princ-to-string P6) "mm") ))
                     ((>= P6 100) (setq P6 (strcat (substr (vl-princ-to-string P6) 1 1) "." (substr (vl-princ-to-string P6) 2 2) "mm") )) 
             )
             (setq output (list P1 P2 P3 P4 P5 P6 P7 P8 P9 P10))
        )       ; 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
)

 

I just add small Duct Tapes fix to mhupp's code.

for polyline "opened" and "closed"

for line & polyline "lineweight" - ByLayer ByBlock Default and numbers.

 

I can't solve lineweight decimal point problem, I try to (rtos (/ P6 100) 2 2)

it deletes under decimal points values. MEASUREMENT system variable control that? I don't know.

so duct taping to that like this

 

((< P6 10) (setq P6 (strcat "0.0" (vl-princ-to-string P6) "mm") ))
((< P6 100) (setq P6 (strcat "0." (vl-princ-to-string P6) "mm") ))
((>= P6 100) (setq P6 (strcat (substr (vl-princ-to-string P6) 1 1) "." (substr (vl-princ-to-string P6) 2 2) "mm") )) 

 

it works anyway

Edited by exceed
  • Like 2
  • Replies 37
  • Created
  • Last Reply

Top Posters In This Topic

  • BIGAL

    10

  • Hsanon

    8

  • kidznok

    7

  • Steven P

    5

Popular Days

Top Posters In This Topic

Popular Days

Popular Posts

exceed
exceed

(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-remov

mhupp
mhupp

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 P

Steven P
Steven P

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 g

Posted Images

Hsanon Collaborator

Hsanon

Posted
  • Author
Posted (edited)

Hey Exceed & Mhupp  !!!!

The routine is great and the duct tape works !!!! am going to test in "real life" conditions !!!!

May get back on the topic if some issue rises......

 

im finally starting to understand vlisp.... (a bit) 

all help much appreciated....all of you are inspirational.!!!

Edited by Hsanon
  • Like 1
  • 3 years later...
kidznok Rookie

kidznok

Posted
Posted

Hi,
Could someone add coordinates to this lisp please ?

BIGAL Grand Master

BIGAL

Posted
Posted

Ok 1st thing you can write direct to Excel no need for a csv. Rather than pick a lisp from this post, can you explain what it is you want in Excel, best way is a dwg and a Excel matching file posted here.

kidznok Rookie

kidznok

Posted
Posted

Hi, thanks for answer.
I would like to add corrdinates, X,Y, maybe Z, like this one below:

image.thumb.png.8265620277123c0bc933aea156010ebc.png

BIGAL Grand Master

BIGAL

Posted
Posted
13 hours ago, kidznok said:

Hi, thanks for answer.
I would like to add corrdinates, X,Y, maybe Z, like this one below:

image.thumb.png.8265620277123c0bc933aea156010ebc.png

 

BIGAL Grand Master

BIGAL

Posted
Posted

Give this a try. If you want more objects or other properties it should be obvious how to add. Note Circle uses 'circumference for length.

  

;https://www.cadtutor.net/forum/topic/74256-extracting-data-to-excel-from-selected-objects-on-different-layers/page/2/
; pick object and send result to Excel.
; BY AlanH March 2025

(defun c:obs2XL ( / dopline doline plent myxl typ ent)

(defun dopline (plent / start closed XY  )
  (setq row (1+ row))
  (xlsetcelltext row 1 (vlax-get plent 'Objectname))
  (xlsetcelltext row 2 (vlax-get plent 'Layer))
  (xlsetcelltext row 3 (vlax-get plent 'Color))
  (setq start (vlax-curve-getstartPoint plent))
  (setq XY (strcat (rtos (car start) 2 2) "," (rtos (cadr start) 2 2) "," (rtos (caddr start) 2 2)))
  (xlsetcelltext row 4 xy)
  (xlsetcelltext row 5 (vlax-get plent 'length))
  (xlsetcelltext row 6 (vlax-get plent 'Linetype))
  (xlsetcelltext row 7 (vlax-get plent 'area))
  (setq closed (vlax-get plent 'closed))
  (if (= closed -1)
  (xlsetcelltext row 8 "Yes")
  (xlsetcelltext row 8 "No")
  )
  (princ)
)

(defun doline (plent / startpt xy)
  (setq row (1+ row))
  (xlsetcelltext row 1 (vlax-get plent 'Objectname))
  (xlsetcelltext row 2 (vlax-get plent 'Layer))
  (xlsetcelltext row 3 (vlax-get plent 'Color))
  (setq startpt (vlax-curve-getstartPoint plent))
  (setq XY (strcat (rtos (car startpt) 2 2) "," (rtos (cadr startpt) 2 2) "," (rtos (cadr startpt) 2 2)))
  (xlsetcelltext row 4 xy)
  (xlsetcelltext row 5 (rtos (vlax-get plent 'length) 2 2))
  (xlsetcelltext row 6 (vlax-get plent 'Linetype))
)

; starts here
(setq myxl1 (vlax-get-object "Excel.Application"))
(if (= myxl1 nil)
    (setq myxl (vlax-get-or-create-object "excel.Application"))
	(setq myxl myxl1)
)
(vla-put-visible myXL :vlax-true)
(vlax-put-property myxl 'ScreenUpdating :vlax-true)
(vlax-put-property myXL 'DisplayAlerts :vlax-true)
(vlax-invoke-method (vlax-get-property myXL 'WorkBooks) 'Add)

;;	Thanks to fixo
;;   = Set Excel cell text = 
;;
(defun xlsetcelltext ( row column text)
(setq cells (vlax-get-property  (vlax-get-property myxl "ActiveSheet") "Cells"))
(vl-catch-all-apply
    'vlax-put-property
    (list cells 'Item row column
	(vlax-make-variant (vl-princ-to-string text) vlax-vbstring)))
)

(setq row 1 col 0)

(foreach val (list "Name" "Layer" "Color" "X,Y,Z" "Length" "Linetype" "Area" "Closed")
  (xlsetcelltext row (setq col (1+ col)) val)
)
(foreach val (list (list "A1" 15) (list "B1" 15) (list "D1" 27))
(vlax-put-property (vlax-get-property  (vlax-get-property myxl "ActiveSheet") "Range" (car val)) 'columnwidth (cadr val))
)

(while (setq ent (car (entsel "Pick Object press Enter to exit ")))
  (setq obj (vlax-ename->vla-object ent))
  (setq typ (vlax-get obj 'ObjectName))
  (cond
   ((= typ "AcDbPolyline")(dopline obj))
   ((= typ "AcDbLine")(doline obj))
  )
)

(if (not (vlax-object-released-p myXL))(progn(vlax-release-object myXL)(setq myXL nil)))
(princ)
)

 

  • 3 weeks later...
kidznok Rookie

kidznok

Posted
Posted

Thank U very much.
It's works. Is it chance to add few objects at one click? Not to adding one by one. 

BIGAL Grand Master

BIGAL

Posted
Posted

You just need to replace the while line with 2 lines a SSGET so pick your objects and a repeat to loop through the objects. 

(while (setq ent (car (entsel "Pick Object press Enter to exit ")))

(setq ss (ssget '(("*line"))))
(repeat (setq x (sslength ss))
(setq ent (ssname ss (setq x (1- x))))

 

kidznok Rookie

kidznok

Posted
Posted

Thank U. I changed sth but it doesn't work. I'm sorry I don't know.
This one?
(while (setq ent (car (entsel "Pick Object press Enter to exit ")))
  (setq obj (vlax-ename->vla-object ent))
  (setq typ (vlax-get obj 'ObjectName))
  (cond
   ((= typ "AcDbPolyline")(dopline obj))
   ((= typ "AcDbLine")(doline obj))
  )

  • 3 weeks later...
kidznok Rookie

kidznok

Posted
Posted

Hi,
I replace but probably sth wrong. Could U send me a full code?
Thank U very much.

BIGAL Grand Master

BIGAL

Posted
Posted

Try this 

;https://www.cadtutor.net/forum/topic/74256-extracting-data-to-excel-from-selected-objects-on-different-layers/page/2/
; pick object and send result to Excel.
; BY AlanH March 2025

(defun c:obs2XL ( / dopline doline plent myxl typ ent)

(defun dopline (plent / start closed XY  )
  (setq row (1+ row))
  (xlsetcelltext row 1 (vlax-get plent 'Objectname))
  (xlsetcelltext row 2 (vlax-get plent 'Layer))
  (xlsetcelltext row 3 (vlax-get plent 'Color))
  (setq start (vlax-curve-getstartPoint plent))
  (setq XY (strcat (rtos (car start) 2 2) "," (rtos (cadr start) 2 2) "," (rtos (caddr start) 2 2)))
  (xlsetcelltext row 4 xy)
  (xlsetcelltext row 5 (vlax-get plent 'length))
  (xlsetcelltext row 6 (vlax-get plent 'Linetype))
  (xlsetcelltext row 7 (vlax-get plent 'area))
  (setq closed (vlax-get plent 'closed))
  (if (= closed -1)
  (xlsetcelltext row 8 "Yes")
  (xlsetcelltext row 8 "No")
  )
  (princ)
)

(defun doline (plent / startpt xy)
  (setq row (1+ row))
  (xlsetcelltext row 1 (vlax-get plent 'Objectname))
  (xlsetcelltext row 2 (vlax-get plent 'Layer))
  (xlsetcelltext row 3 (vlax-get plent 'Color))
  (setq startpt (vlax-curve-getstartPoint plent))
  (setq XY (strcat (rtos (car startpt) 2 2) "," (rtos (cadr startpt) 2 2) "," (rtos (cadr startpt) 2 2)))
  (xlsetcelltext row 4 xy)
  (xlsetcelltext row 5 (rtos (vlax-get plent 'length) 2 2))
  (xlsetcelltext row 6 (vlax-get plent 'Linetype))
)

; starts here
(setq myxl1 (vlax-get-object "Excel.Application"))
(if (= myxl1 nil)
    (setq myxl (vlax-get-or-create-object "excel.Application"))
	(setq myxl myxl1)
)
(vla-put-visible myXL :vlax-true)
(vlax-put-property myxl 'ScreenUpdating :vlax-true)
(vlax-put-property myXL 'DisplayAlerts :vlax-true)
(vlax-invoke-method (vlax-get-property myXL 'WorkBooks) 'Add)

;;	Thanks to fixo
;;   = Set Excel cell text = 
;;
(defun xlsetcelltext ( row column text)
(setq cells (vlax-get-property  (vlax-get-property myxl "ActiveSheet") "Cells"))
(vl-catch-all-apply
    'vlax-put-property
    (list cells 'Item row column
	(vlax-make-variant (vl-princ-to-string text) vlax-vbstring)))
)

(setq row 1 col 0)

(foreach val (list "Name" "Layer" "Color" "X,Y,Z" "Length" "Linetype" "Area" "Closed")
  (xlsetcelltext row (setq col (1+ col)) val)
)
(foreach val (list (list "A1" 15) (list "B1" 15) (list "D1" 27))
(vlax-put-property (vlax-get-property  (vlax-get-property myxl "ActiveSheet") "Range" (car val)) 'columnwidth (cadr val))
)

(setq ss (SSget (list (cons 0 "*line"))))
(if (= ss nil)
(progn (alert "you have no lines or plines selected will exit ")(exit))
)

(repeat (setq x (sslength ss))
  (setq obj (vlax-ename->vla-object (ssname ss (setq x (1- x)))))
  (setq typ (vlax-get obj 'ObjectName))
  (cond
   ((= typ "AcDbPolyline")(dopline obj))
   ((= typ "AcDbLine")(doline obj))
  )
)

(if (not (vlax-object-released-p myXL))(progn(vlax-release-object myXL)(setq myXL nil)))
(princ)
)

 

  • 2 weeks later...
kidznok Rookie

kidznok

Posted
Posted (edited)

Hi, thank You very much.
It's works.
Is it possible to add texts, hatchs and block with attributes?

Edited by kidznok
Saxlle Collaborator

Saxlle

Posted
Posted

Hey @kidznok, 

 

Why you don't use the DATAEXTRACTION command? 

BIGAL Grand Master

BIGAL

Posted
Posted

Yes is answer but you need to add object type into the cond which at moment only looks at line and pline. You need more defund dohatch., doblock.

 

in some other code I make a big list of all objects and values, then look at how many items in each value of the list find maximum and that is used for number of columns.

 

Yes do have something for blocks, any blocks and a table is made, data is sorted and common items counted. Small fee is applicable, would need more code for hatches, lines & plines.

  • 1 month later...
BIGAL Grand Master

BIGAL

Posted
Posted

You need to provide a sample dwg and a matching Excel, it should have lines, plines blocks with or without attributes hatches etc so can see everything yo want rather than repeatedly asking for an extra object. Then some one may answer.

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.

×
 Share
Go to topic listing
×
×
  • Create New...