Export information to Excel

Anonymous · ‎10-26-2020

Hello Fellows.

I am willing to get a lisp routine to export some information to either a notepad or a excel sheet which includes:

object -color - text inside

On sample attached, if I run the lisp routine, the outcome would look like:

BLOCK MAGENTA 07-A

CIRCLE MAGENTA 07-B

CIRCLE GRAY 07-C

If anyone has something like this will be much appreciate it.

thanks a lot!

hak_vz · ‎10-26-2020

@Anonymous

I've tried to write it down. This suppose to be a simple task, but your sample is so .....

Why text inside block is not simple text or an attribute inside block. So many blocks...... extracting info from blocks becomes too complicated.

This code doesn't work but if someone is willing to continue...

It is supposed to collect all blocks, create selection from its bounding box, extract text info from text object (but this is also block) , extract color from block layer , output all to. csv and open in excel or some spreadsheet

(defun c:getout ()
(setq i -1)
(setq d "d:\\out.csv")
(setq file1 (open d "w") tt d)
(repeat (sslength(setq ss (ssget "x" '((0 . "INSERT")))))
(setq
    i (+ i 1)
	eo (vlax-ename->vla-object (ssname ss i))
	bb (vla-getboundingbox eo 'p1 'p2))
	p1  (vlax-safearray->list p1)
	p2  (vlax-safearray->list p2)
	to (vlax-ename->vla-object(ssname (ssget "w" p1 p2) 0))
	clr (itoa (cdr (assoc 62 (tblsearch "layer" (vla-get-layer eo)))))
	...

)
(write-line rec file1)
)
(close file1)
(startapp "explorer" tt)
(princ)
)

Miljenko Hatlak

Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.

dmfrazier · ‎10-26-2020

Have you looked into the DataExtraction command?

Anonymous · ‎10-26-2020

Hello there.

I tried this one, and for some reason is not working on my machine... I deleted the ( ... ) and I get a message saying "Command: GETOUT
; error: bad argument type: stringp nil"

ronjonp · ‎10-26-2020

Try this .. you will need to figure out how to format your colors to names though.

(defun c:foo (/ _writefile a b c el o r s)
  ;; RJP » 2020-10-26
  (defun _writefile (fn l del / f)
    (cond ((and (eq 'str (type fn)) (setq f (open fn "w")))
	   (foreach x l
	     (write-line
	       (cond ((eq (type x) 'list)
		      (apply 'strcat (mapcar '(lambda (y) (strcat (vl-princ-to-string y) del)) x))
		     )
		     ((vl-princ-to-string x))
	       )
	       f
	     )
	   )
	   (close f)
	   fn
	  )
    )
  )
  (if (setq s (ssget "_X"
		     '((-4 . "<OR")
		       (-4 . "<AND")
		       (0 . "INSERT")
		       (2 . "~FMS4RM")
		       (-4 . "AND>")
		       (0 . "CIRCLE")
		       (-4 . "OR>")
		      )
	      )
      )
    (progn
      (foreach e (mapcar 'cadr (ssnamex s))
	(if (vl-catch-all-error-p
	      (vl-catch-all-apply
		'vla-getboundingbox
		(list (setq o (vlax-ename->vla-object e)) 'a 'b)
	      )
	    )
	  (print "NULL EXTENTS")
	  (progn (if (setq c (ssget "_W"
				    (vlax-safearray->list a)
				    (vlax-safearray->list b)
				    '((0 . "INSERT") (2 . "FMS4RM"))
			     )
		     )
		   (setq r (cons (list (cdr (assoc 0 (setq el (entget e))))
				       ;; COLOR INDEX NUMBER .. SEE IF YOU CAN FIGURE OUT HOW TO MAP A NAME TO IT ;)
				       (cond ((cdr (assoc 62 el)))
					     ((cdr (assoc 62 (tblsearch "layer" (cdr (assoc 8 el))))))
				       )
				       (getpropertyvalue (ssname c 0) "FMS:RMID")
				 )
				 r
			   )
		   )
		 )
		 (_writefile
		   (strcat (getvar 'dwgprefix) (vl-filename-base (getvar 'dwgname)) ".txt")
		   (reverse r)
		   " "
		 )
		 (mapcar 'print r)
	  )
	)
      )
    )
  )
  (princ)
)

Anonymous · ‎10-26-2020

Thanks friend.

with this one, I'm getting a message saying "; error: Automation Error. Null extents"

ronjonp · ‎10-26-2020

Try the code above again.

Anonymous · ‎10-26-2020

I'm sorry fiend, is not working either.

It starts running, then reads the numbers (more than once), and then it gave me the same error

ronjonp · ‎10-26-2020

Did you open the text file in the same directory ? The null extents is just an alert . 😉

pbejse · ‎10-27-2020

@ronjonp wrote:

Did you open the text file in the same directory ? The null extents is just an alert . 😉

That is the first thing i would be looking for :

BTW: Small thing to watch out for.

(ssget "W"...

From a recent topic to which i participated ".... it applies only to objects appearing in front of the screen.."

...

devitg · ‎10-27-2020

@Anonymous

so you have to add ,

(vla-ZoomWindow acadObj point1 point2)

Previous the SSGET

ronjonp · ‎10-27-2020

@pbejse wrote:
@ronjonp wrote:
Did you open the text file in the same directory ? The null extents is just an alert . 😉
That is the first thing i would be looking for :
BTW: Small thing to watch out for.

(ssget "W"...

From a recent topic to which i participated ".... it applies only to objects appearing in front of the screen.."

...

That depends on what version of CAD you're running that limitation does not exist in newer versions ( not sure what version it starts though ).

ronjonp · ‎10-27-2020

Here is a version that will zoom to each object just in case you're running an older version of AutoCAD. 🍻

(defun c:foo (/ _writefile a ao b c el o r s)
  ;; RJP » 2020-10-26
  (defun _writefile (fn l del / f)
    (cond ((and (eq 'str (type fn)) (setq f (open fn "w")))
	   (foreach x l
	     (write-line
	       (cond ((eq (type x) 'list)
		      (apply 'strcat (mapcar '(lambda (y) (strcat (vl-princ-to-string y) del)) x))
		     )
		     ((vl-princ-to-string x))
	       )
	       f
	     )
	   )
	   (close f)
	   fn
	  )
    )
  )
  (if (setq s (ssget "_X"
		     '((-4 . "<OR")
		       (-4 . "<AND")
		       (0 . "INSERT")
		       (2 . "~FMS4RM")
		       (-4 . "AND>")
		       (0 . "CIRCLE")
		       (-4 . "OR>")
		      )
	      )
      )
    (progn
      (setq ao (vlax-get-acad-object))
      (foreach e (mapcar 'cadr (ssnamex s))
	(if (vl-catch-all-error-p
	      (vl-catch-all-apply
		'vla-getboundingbox
		(list (setq o (vlax-ename->vla-object e)) 'a 'b)
	      )
	    )
	  (print "NULL EXTENTS")
	  (progn (vla-zoomwindow ao a b)
		 (if (setq c (ssget "_W"
				    (vlax-safearray->list a)
				    (vlax-safearray->list b)
				    '((0 . "INSERT") (2 . "FMS4RM"))
			     )
		     )
		   (setq r (cons (list (cdr (assoc 0 (setq el (entget e))))
				       ;; COLOR INDEX NUMBER .. SEE IF YOU CAN FIGURE OUT HOW TO MAP A NAME TO IT ;)
				       (cond ((cdr (assoc 62 el)))
					     ((cdr (assoc 62 (tblsearch "layer" (cdr (assoc 8 el))))))
				       )
				       (getpropertyvalue (ssname c 0) "FMS:RMID")
				 )
				 r
			   )
		   )
		 )
		 (_writefile
		   (strcat (getvar 'dwgprefix) (vl-filename-base (getvar 'dwgname)) ".txt")
		   (reverse r)
		   " "
		 )
		 (mapcar 'print r)
	  )
	)
      )
    )
  )
  (princ)
)

Anonymous · ‎10-27-2020

Hello @ronjonp ,

This one is getting closer of what I need, thanks a lot.

Is there anyway to make Autocad read only these layers?:

- A-AREA-IDEN

- A-SOCL-DIS1-E

- A-SOCL-DIS2-E

- A-SOCL-DMTG-E

And also, when I run the script, looks like it adds the item one by one, and runs the scrip again. Let me give you a sample. For a drawing with 5 of these items to read, the programs starts reading one, then runs again and reads two, and this way till reach the total. Please se attach

ronjonp · ‎10-27-2020

@Anonymous wrote:
Hello @ronjonp ,

This one is getting closer of what I need, thanks a lot.

Is there anyway to make Autocad read only these layers?:

- A-AREA-IDEN
- A-SOCL-DIS1-E
- A-SOCL-DIS2-E
- A-SOCL-DMTG-E

And also, when I run the script, looks like it adds the item one by one, and runs the scrip again. Let me give you a sample. For a drawing with 5 of these items to read, the programs starts reading one, then runs again and reads two, and this way till reach the total. Please se attach

To filter those layers try the code below. I don't understand the rest of your message sorry ;\

(defun c:foo (/ _writefile a b c el o r s)
  ;; RJP » 2020-10-26
  (defun _writefile (fn l del / f)
    (cond ((and (eq 'str (type fn)) (setq f (open fn "w")))
	   (foreach x l
	     (write-line
	       (cond ((eq (type x) 'list)
		      (apply 'strcat (mapcar '(lambda (y) (strcat (vl-princ-to-string y) del)) x))
		     )
		     ((vl-princ-to-string x))
	       )
	       f
	     )
	   )
	   (close f)
	   fn
	  )
    )
  )
  (if (setq s (ssget "_X"
		     '((-4 . "<OR")
		       (-4 . "<AND")
		       (0 . "INSERT")
		       (2 . "~FMS4RM")
		       (8 . "- A-AREA-IDEN,- A-SOCL-DIS1-E,- A-SOCL-DIS2-E,- A-SOCL-DMTG-E")
		       (-4 . "AND>")
		       (-4 . "<AND")
		       (0 . "CIRCLE")
		       (8 . "- A-AREA-IDEN,- A-SOCL-DIS1-E,- A-SOCL-DIS2-E,- A-SOCL-DMTG-E")
		       (-4 . "AND>")
		       (-4 . "OR>")
		      )
	      )
      )
    (progn
      (foreach e (mapcar 'cadr (ssnamex s))
	(if (vl-catch-all-error-p
	      (vl-catch-all-apply
		'vla-getboundingbox
		(list (setq o (vlax-ename->vla-object e)) 'a 'b)
	      )
	    )
	  (print "NULL EXTENTS")
	  (progn (if (setq c (ssget "_W"
				    (vlax-safearray->list a)
				    (vlax-safearray->list b)
				    '((0 . "INSERT") (2 . "FMS4RM"))
			     )
		     )
		   (setq r (cons (list (cdr (assoc 0 (setq el (entget e))))
				       ;; COLOR INDEX NUMBER .. SEE IF YOU CAN FIGURE OUT HOW TO MAP A NAME TO IT ;)
				       (cond ((cdr (assoc 62 el)))
					     ((cdr (assoc 62 (tblsearch "layer" (cdr (assoc 8 el))))))
				       )
				       (getpropertyvalue (ssname c 0) "FMS:RMID")
				 )
				 r
			   )
		   )
		 )
		 (_writefile
		   (strcat (getvar 'dwgprefix) (vl-filename-base (getvar 'dwgname)) ".txt")
		   (reverse r)
		   " "
		 )
		 ;; Is this command line print confusing you?
		 ;; (mapcar 'print r)
	  )
	)
      )
    )
  )
  (princ)
)

pbejse · ‎10-27-2020

@ronjonp wrote:
That depends on what version of CAD you're running that limitation does not exist in newer versions ( not sure what version it starts though ).

Strange, it still behaves the same in 2021 and 2020 , guess i need to update and look for the latest hotfix 😀

ronjonp · ‎10-28-2020

@Anonymous Did you get what you needed?

pbejse · ‎10-28-2020

@Anonymous wrote:

Is there anyway to make Autocad read only these layers?:

- A-AREA-IDEN

- A-SOCL-DIS1-E

- A-SOCL-DIS2-E

- A-SOCL-DMTG-E

I'm guessing the "-" prefix is not really part of the layer name? And is this limite to Blocks and Circles? and you wnt the file to open so you visually see the result on screen right after the routine has done its task?

Command: BAC

Results saved as CSV:

INSERT,110,07-A
CIRCLE,230,07-B
CIRCLE,251,07-C

HTH

Anonymous · ‎11-09-2020

Hello friend.

is there any way to read the text there, whether is an attribute, or a simple text?

コミュニティ

Export information to Excel

Export information to Excel

Export information to Excel