Export to excel table all objects from specific layer

mihai_bantas · ‎10-16-2018

Hi all,
Someone can help me with a code (lsp, vba, etc.) .

I want to export into excel table (in acad or file xls or csv) Total Lengths of specific Line Types, Cumulative Areas from specific hatch (by color or pattern) and Total Number of blocks (by name)...all objects are in a single layer (My Layer).

I attach a autocad file for example

Thank you for your time

Luís Augusto · ‎11-23-2018

I hope it helps.
Let us know if it worked.

Best Regards, Luís Augusto

(defun C:TEST ()

  ;; Write CSV  -  Lee Mac
  ;; Writes a matrix list of cell values to a CSV file.
  ;; lst - [lst] list of lists, sublist is row of cell values
  ;; csv - [str] filename of CSV file to write
  ;; Returns T if successful, else nil

  (defun LM:writecsv (lst csv / des sep)
    (if	(setq des (open csv "w"))
      (progn
	(setq sep
	       (cond ((vl-registry-read
			"HKEY_CURRENT_USER\\Control Panel\\International"
			"sList"
		      )
		     )
		     (",")
	       )
	)
	(foreach row lst (write-line (LM:lst->csv row sep) des))
	(close des)
	t
      )
    )
  )

  ;; List -> CSV  -  Lee Mac
  ;; Concatenates a row of cell values to be written to a CSV file.
  ;; lst - [lst] list containing row of CSV cell values
  ;; sep - [str] CSV separator token

  (defun LM:lst->csv (lst sep)
    (if	(cdr lst)
      (strcat (LM:csv-addquotes (car lst) sep)
	      sep
	      (LM:lst->csv (cdr lst) sep)
      )
      (LM:csv-addquotes (car lst) sep)
    )
  )

  (defun LM:csv-addquotes (str sep / pos)
    (cond
      ((wcmatch str (strcat "*[`" sep "\"]*"))
       (setq pos 0)
       (while (setq pos (vl-string-position 34 str pos))
	 (setq str (vl-string-subst "\"\"" "\"" str pos)
	       pos (+ pos 2)
	 )
       )
       (strcat "\"" str "\"")
      )
      (str)
    )
  )

  ;; Insert Nth  -  Lee Mac
  ;; Inserts an item at the nth position in a list.
  ;; x - [any] Item to be inserted
  ;; n - [int] Zero-based index at which to insert item
  ;; l - [lst] List in which item is to be inserted

  (defun LM:insertnth (x n l)
    (cond
      ((null l) nil)
      ((< 0 n) (cons (car l) (LM:insertnth x (1- n) (cdr l))))
      ((cons x l))
    )
  )

  	(defun openfile (file / sh)
    (setq sh (vla-getinterfaceobject
	       (vlax-get-acad-object)
	       "Shell.Application"
	     )
    )
    (vlax-invoke-method sh 'open (findfile file))
    (vlax-release-object sh)
  )


  (defun GetCurveLength	(ent /)
    (setq ent (vlax-ename->vla-object ent))
    (vlax-curve-getDistAtParam
      ent
      (vlax-curve-getEndParam ent)
    )
  )

  (setq	lineList '(
		   "FENCELINE1"
		   "FENCELINE2"
		   "GAS_LINE"
		   "HOT_WATER_SUPPLY"
		  )
  )

  (setq	lineList
	 (mapcar
	   '(lambda (lineStyle)
	      (if (setq
		    ss (ssget "_X"
			      (list '(0 . "*LINE") (cons 6 lineStyle))
		       )
		  )
		(progn
		  (setq	index 0
			totalObj 0
		  )
		  (repeat (sslength ss)
		    (setq totalObj
			   (+ totalObj (GetCurveLength (ssname ss index)))
		    )
		    (setq index (1+ index))
		  )
		  (list lineStyle (rtos totalObj 2))
		)
	      )
	    )
	   lineList
	 )
  )

  (setq	lineList (LM:insertnth
		   (list "Line List" "------------------")
		   0
		   lineList
		 )
  )

  (setq bom lineList)

  ;-----------------------------------------

  (setq	blockList '(
		    "oooo"
		    "bbbb"
		   )
  )

  (setq	blockList
	 (mapcar
	   '(lambda (blkName)
	      (if (setq
		    ss (ssget "_X"
			      (list '(0 . "INSERT") (cons 2 blkName))
		       )
		  )
		(progn
		  (setq	index	 0
			totalObj (sslength ss)
		  )
		  (list blkName (rtos totalObj 2))
		)
	      )
	    )
	   blockList
	 )
  )

  (setq	blockList (LM:insertnth
		    (list "Block List" "------------------")
		    0
		    blockList
		  )
  )

  (setq bom (append bom blockList))

  ;-----------------------------------------

  (setq	hatchColorList
	 '(
	   30
	   152
	  )
  )

  (setq	hatchColorList
	 (mapcar
	   '(lambda (color)
	      (if (setq
		    ss (ssget "_X"
			      (list '(0 . "HATCH") (cons 62 color))
		       )
		  )
		(progn
		  (setq	index 0
			totalObj 0
		  )
		  (repeat (sslength ss)
		    (setq ent (vlax-ename->vla-object
				(cdr (assoc -1 (entget (ssname ss index))))
			      )
		    )
		    (setq totalObj
			   (+ totalObj (vla-get-area ent))
		    )
		    (setq index (1+ index))
		  )
		  (list	(strcat "HatchColor_" (rtos color 2 00))
			(strcat
			  "Area = "
			  (if (or (= (getvar "lunits") 3)
				  (= (getvar "lunits") 4)
			      )
			    (strcat
			      (rtos totalObj 2)
			      " sq. in. ("
			      (rtos (/ totalObj 144) 2)
			      " sq. ft.)"
			    )
			    (rtos totalObj)
			  )
			)
		  )
		)
	      )
	    )
	   hatchColorList
	 )
  )

  (setq	hatchColorList
	 (LM:insertnth
	   (list "Hatch List" "------------------")
	   0
	   hatchColorList
	 )
  )

  (setq bom (append bom hatchColorList))

  ;-----------------------------------------

  (LM:writecsv bom (strcat (getvar 'DWGPREFIX) "BOM.csv"))
  (openfile  (strcat (getvar 'DWGPREFIX) "BOM.csv"))

)
(vl-load-com) (princ "TEST")

mihai_bantas · ‎11-25-2018

C

@Luís Augusto wrote:

I hope it helps.
Let us know if it worked.

Best Regards, Luís Augusto

(defun C:TEST ()

  ;; Write CSV  -  Lee Mac
  ;; Writes a matrix list of cell values to a CSV file.
  ;; lst - [lst] list of lists, sublist is row of cell values
  ;; csv - [str] filename of CSV file to write
  ;; Returns T if successful, else nil

  (defun LM:writecsv (lst csv / des sep)
    (if	(setq des (open csv "w"))
      (progn
	(setq sep
	       (cond ((vl-registry-read
			"HKEY_CURRENT_USER\\Control Panel\\International"
			"sList"
		      )
		     )
		     (",")
	       )
	)
	(foreach row lst (write-line (LM:lst->csv row sep) des))
	(close des)
	t
      )
    )
  )

  ;; List -> CSV  -  Lee Mac
  ;; Concatenates a row of cell values to be written to a CSV file.
  ;; lst - [lst] list containing row of CSV cell values
  ;; sep - [str] CSV separator token

  (defun LM:lst->csv (lst sep)
    (if	(cdr lst)
      (strcat (LM:csv-addquotes (car lst) sep)
	      sep
	      (LM:lst->csv (cdr lst) sep)
      )
      (LM:csv-addquotes (car lst) sep)
    )
  )

  (defun LM:csv-addquotes (str sep / pos)
    (cond
      ((wcmatch str (strcat "*[`" sep "\"]*"))
       (setq pos 0)
       (while (setq pos (vl-string-position 34 str pos))
	 (setq str (vl-string-subst "\"\"" "\"" str pos)
	       pos (+ pos 2)
	 )
       )
       (strcat "\"" str "\"")
      )
      (str)
    )
  )

  ;; Insert Nth  -  Lee Mac
  ;; Inserts an item at the nth position in a list.
  ;; x - [any] Item to be inserted
  ;; n - [int] Zero-based index at which to insert item
  ;; l - [lst] List in which item is to be inserted

  (defun LM:insertnth (x n l)
    (cond
      ((null l) nil)
      ((< 0 n) (cons (car l) (LM:insertnth x (1- n) (cdr l))))
      ((cons x l))
    )
  )

  	(defun openfile (file / sh)
    (setq sh (vla-getinterfaceobject
	       (vlax-get-acad-object)
	       "Shell.Application"
	     )
    )
    (vlax-invoke-method sh 'open (findfile file))
    (vlax-release-object sh)
  )


  (defun GetCurveLength	(ent /)
    (setq ent (vlax-ename->vla-object ent))
    (vlax-curve-getDistAtParam
      ent
      (vlax-curve-getEndParam ent)
    )
  )

  (setq	lineList '(
		   "FENCELINE1"
		   "FENCELINE2"
		   "GAS_LINE"
		   "HOT_WATER_SUPPLY"
		  )
  )

  (setq	lineList
	 (mapcar
	   '(lambda (lineStyle)
	      (if (setq
		    ss (ssget "_X"
			      (list '(0 . "*LINE") (cons 6 lineStyle))
		       )
		  )
		(progn
		  (setq	index 0
			totalObj 0
		  )
		  (repeat (sslength ss)
		    (setq totalObj
			   (+ totalObj (GetCurveLength (ssname ss index)))
		    )
		    (setq index (1+ index))
		  )
		  (list lineStyle (rtos totalObj 2))
		)
	      )
	    )
	   lineList
	 )
  )

  (setq	lineList (LM:insertnth
		   (list "Line List" "------------------")
		   0
		   lineList
		 )
  )

  (setq bom lineList)

  ;-----------------------------------------

  (setq	blockList '(
		    "oooo"
		    "bbbb"
		   )
  )

  (setq	blockList
	 (mapcar
	   '(lambda (blkName)
	      (if (setq
		    ss (ssget "_X"
			      (list '(0 . "INSERT") (cons 2 blkName))
		       )
		  )
		(progn
		  (setq	index	 0
			totalObj (sslength ss)
		  )
		  (list blkName (rtos totalObj 2))
		)
	      )
	    )
	   blockList
	 )
  )

  (setq	blockList (LM:insertnth
		    (list "Block List" "------------------")
		    0
		    blockList
		  )
  )

  (setq bom (append bom blockList))

  ;-----------------------------------------

  (setq	hatchColorList
	 '(
	   30
	   152
	  )
  )

  (setq	hatchColorList
	 (mapcar
	   '(lambda (color)
	      (if (setq
		    ss (ssget "_X"
			      (list '(0 . "HATCH") (cons 62 color))
		       )
		  )
		(progn
		  (setq	index 0
			totalObj 0
		  )
		  (repeat (sslength ss)
		    (setq ent (vlax-ename->vla-object
				(cdr (assoc -1 (entget (ssname ss index))))
			      )
		    )
		    (setq totalObj
			   (+ totalObj (vla-get-area ent))
		    )
		    (setq index (1+ index))
		  )
		  (list	(strcat "HatchColor_" (rtos color 2 00))
			(strcat
			  "Area = "
			  (if (or (= (getvar "lunits") 3)
				  (= (getvar "lunits") 4)
			      )
			    (strcat
			      (rtos totalObj 2)
			      " sq. in. ("
			      (rtos (/ totalObj 144) 2)
			      " sq. ft.)"
			    )
			    (rtos totalObj)
			  )
			)
		  )
		)
	      )
	    )
	   hatchColorList
	 )
  )

  (setq	hatchColorList
	 (LM:insertnth
	   (list "Hatch List" "------------------")
	   0
	   hatchColorList
	 )
  )

  (setq bom (append bom hatchColorList))

  ;-----------------------------------------

  (LM:writecsv bom (strcat (getvar 'DWGPREFIX) "BOM.csv"))
  (openfile  (strcat (getvar 'DWGPREFIX) "BOM.csv"))

)
(vl-load-com) (princ "TEST")

ode goes perfect ... Luís Augusto thank you

I wish you a beautiful day

Community

Export to excel table all objects from specific layer

Export to excel table all objects from specific layer

Export to excel table all objects from specific layer